- ENXSIPS ;WIRMFO/DH-Patch Post-init (EN*7*37) ;10.9.96
- ;;7.0;ENGINEERING;**37**;Aug 17, 1993
- AOCHK ;Repeat a check first attempted in EN*7*33
- ;Check for incorrect AO CODES (CMR 69x) - Ambulatory Care
- N AMBC,ENX,ENI,X,ENDA,COUNT,DIFROM
- K ^TMP($J)
- S (COUNT("TOT"),COUNT("FAP"),COUNT("EXP"))=0
- S ENI=0 F S ENI=$O(^ENG(6914.1,ENI)) Q:ENI'>0 I $E($P(^(ENI,0),U),1,2)=69 S AMBC(ENI)=""
- I $D(AMBC) D
- . D BMES^XPDUTL("You may have some Equipment Records with an incorrect AO CODE and") D MES^XPDUTL("incorrect EQUITY ACCOUNT. Checking further...")
- . S ENI=0 F S ENI=$O(AMBC(ENI)) Q:ENI'>0 D
- .. S ENDA=0 F S ENDA=$O(^ENG(6914,"AD",ENI,ENDA)) Q:ENDA'>0 D
- ... I $$GET1^DIQ(6914,ENDA,63,"I")=4 D
- ....S ENX=$$CHKFA^ENFAUTL(ENDA),$P(^ENG(6914,ENDA,9),U,8)=3 S:$P(^(9),U,9)'=3402 $P(^(9),U,9)=3299
- .... S COUNT("TOT")=COUNT("TOT")+1
- .... S:$P(ENX,U) ^TMP($J,"CMR69",ENDA)=$$GET1^DIQ(6915.2,$P(ENX,U,4),24)_U_$E($$GET1^DIQ(6914,ENDA,3),1,30)_U_$$GET1^DIQ(6914,ENDA,12),COUNT("FAP")=COUNT("FAP")+1
- .... I '$P(ENX,U) S COUNT("EXP")=COUNT("EXP")+1
- . I COUNT("TOT")=0 D MES^XPDUTL(" ... no problems found.") Q
- . ;Report the problems
- . D BMES^XPDUTL(COUNT("TOT")_" defective records were found and corrected in AEMS-MERS.") D MES^XPDUTL(COUNT("FAP")_" of these have been reported to the Fixed Assets Package (FAP).")
- . D MES^XPDUTL(COUNT("EXP")_" are not in FAP and are presumably expensed.")
- . D BMES^XPDUTL("The FAP database will be corrected centrally and all AEMS-MERS records have") D MES^XPDUTL("just been fixed. You will now see a list of the defective records that were")
- . D MES^XPDUTL("sent to FAP from Ambulatory Care CMRs, but no corrective action is required") D MES^XPDUTL("of your site.")
- . D BMES^XPDUTL(" FIXED ASSET NUMBER MANUFACTURER EQUIPMENT NAME TOTAL ASSET VALUE")
- . D MES^XPDUTL(" ================== =========================== =================")
- . S ENDA=0 F S ENDA=$O(^TMP($J,"CMR69",ENDA)) Q:ENDA'>0 K X D
- .. S X(1)=$P(^TMP($J,"CMR69",ENDA),U),X(2)=$P(^(ENDA),U,2),X(3)=$P(^(ENDA),U,3)
- .. F Q:$L(X(1))>14 S X(1)=X(1)_" "
- .. F Q:$L(X(2))>29 S X(2)=X(2)_" "
- .. F Q:$L(X(3))>9 S X(3)=" "_X(3)
- .. D MES^XPDUTL(" "_X(1)_" "_X(2)_" "_X(3))
- MSG1 ;Mail message to developers
- ;Data may be made available to FMS
- S (ENX,X)=0 F S X=$O(^TMP($J,"CMR69",X)) Q:X'>0 S ENX=ENX+$P(^(X),U,3)
- I COUNT("FAP")=0 S ^TMP($J,"CMR69",1)="No FAs transmitted.",^TMP($J,"CMR69",2)=^ENG(6914,0) D PS
- E S ENI=$O(^TMP($J,"CMR69",9999999999),-1),^TMP($J,"CMR69",ENI+1)="FAP Records from CMRs 69x Total $"_ENX,^TMP($J,"CMR69",ENI+2)=^ENG(6914,0) D PS
- S XMY("HEIBY,D@DOMAIN.EXT")="",XMY(DUZ)="",XMDUZ=.5
- S XMSUB="FAP Records in EIL 69",XMTEXT="^TMP($J,""CMR69"","
- D ^XMD
- K XMY,XMDUZ,XMSUB,XMTEXT
- ;
- PAT33 ;Clean up EQUITY ACCOUNTS set by 8.16.96 version of ENLIB3
- ;Start with EXPENSED NX
- D BMES^XPDUTL("Looping thru Equipment File to correct AO CODE vs EQUITY mismatches.")
- D MES^XPDUTL("This will take a few minutes.")
- N DA,FADATE,AO,EQUITY,STATION,XMCHAN
- S DA("EQ")=0,XMCHAN=1
- ;Clean errors in entries other than CAPITALIZED NX
- F S DA("EQ")=$O(^ENG(6914,DA("EQ"))) Q:'DA("EQ") D:'(DA("EQ")#500) MES^XPDUTL("ENTRY # "_DA("EQ")) S EQUITY=$P($G(^ENG(6914,DA("EQ"),9)),U,9) I EQUITY]"",EQUITY'=3402 D
- . I $P($G(^ENG(6914,DA("EQ"),8)),U,2),$P($$CHKFA^ENFAUTL(DA("EQ")),U) Q ;Will check these entries in FA segment
- . S AO=$P(^ENG(6914,DA("EQ"),9),U,8) Q:'AO ;Wasn't set via ENLIB3
- . I AO=3,EQUITY=3210 S $P(^ENG(6914,DA("EQ"),9),U,9)=3299
- . I "4^5"[AO,EQUITY=3299 S $P(^ENG(6914,DA("EQ"),9),U,9)=3210
- FA ;Now we'll look at the FAP stuff
- S FADATE=2960801 ;Earlest possible date for install of EN*7*33
- K ^TMP($J) D BMES^XPDUTL("Checking for FAP Equipment Records in need of correction. Corrections (if")
- D MES^XPDUTL("needed) will be made centrally. Site action is not required.")
- F S FADATE=$O(^ENG(6915.2,"D",FADATE)) Q:'FADATE D
- . S DA("FA")=$O(^ENG(6915.2,"D",FADATE,0)) Q:'DA("FA")
- . S DA("EQ")=$P(^ENG(6915.2,DA("FA"),0),U) Q:'DA("EQ")
- . Q:'$D(^ENG(6914,DA("EQ"),9))
- . S PO("E")=$P($G(^ENG(6914,DA("EQ"),2)),U,2) Q:PO("E")']""
- . S PO("I")=$$FIND1^DIC(442,"","X",PO("E"),"C^B") Q:'PO("I")
- . S STATION=$P($$GET1^DIQ(442,PO("I"),.01),"-")
- . I $L(STATION)<5 S STATION=$E(STATION_" ",1,5)
- . I $P(^ENG(6914,DA("EQ"),9),U,8)=3,$P(^(9),U,9)=3210 D
- .. S ^TMP($J,1,DA("EQ"))="FAP Equip Record '"_STATION_DA("EQ")_"' should have EQUITY of 3299 (MEDICAL).",$P(^ENG(6914,DA("EQ"),9),U,9)=3299
- .. D MES^XPDUTL(^TMP($J,1,DA("EQ")))
- . I ($E(STATION)=3!("4^5"[$P(^ENG(6914,DA("EQ"),9),U,8))),$P(^(9),U,9)=3299 D
- .. S ^TMP($J,1,DA("EQ"))="FAP Equip Record '"_STATION_DA("EQ")_"' should have EQUITY of 3210 (NON-MEDICAL).",$P(^ENG(6914,DA("EQ"),9),U,9)=3210
- .. D MES^XPDUTL(^TMP($J,1,DA("EQ")))
- MSG2 ;Feedback to developers
- ;Information may be shared with FMS
- I $D(^TMP($J)) D
- . S ^TMP($J,1,.1)="The following Equipment Records were given an incorrect EQUITY ACCOUNT when"
- . S ^TMP($J,1,.2)="they were added to AEMS/MERS. The AEMS/MERS Equipment Record has been"
- . S ^TMP($J,1,.3)="corrected, and the FAP file in Austin will be corrected centrally."
- . S ^TMP($J,1,.4)=" "
- . S ^TMP($J,1,.5)="NOTE TO INSTALLER OF EN*7.0*37:"
- . S ^TMP($J,1,.6)=" This message is a courtesy copy only. No site action is required."
- . S ^TMP($J,1,.7)=" "
- . S XMY("HEIBY,D@DOMAIN.EXT")="",XMY(DUZ)="",XMDUZ=.5
- . S XMSUB="INCORRECT EQUITY (EN*7*33)",XMTEXT="^TMP($J,1,"
- . D ^XMD
- . K XMY,XMDUZ,XMSUB,XMTXT
- K ^TMP($J)
- Q ;Design EXIT
- ;
- PS ;Note to installer
- S ENI=$O(^TMP($J,"CMR69",9999999999),-1)
- S ^TMP($J,"CMR69",ENI+1)="",^(ENI+2)="NOTE TO INSTALLER OF EN*7.0*37:",^(ENI+3)="This message is a courtesy copy only. No action is required of your site."
- Q
- ;ENXSIPS
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENXSIPS 5839 printed Mar 13, 2025@21:01:45 Page 2
- ENXSIPS ;WIRMFO/DH-Patch Post-init (EN*7*37) ;10.9.96
- +1 ;;7.0;ENGINEERING;**37**;Aug 17, 1993
- AOCHK ;Repeat a check first attempted in EN*7*33
- +1 ;Check for incorrect AO CODES (CMR 69x) - Ambulatory Care
- +2 NEW AMBC,ENX,ENI,X,ENDA,COUNT,DIFROM
- +3 KILL ^TMP($JOB)
- +4 SET (COUNT("TOT"),COUNT("FAP"),COUNT("EXP"))=0
- +5 SET ENI=0
- FOR
- SET ENI=$ORDER(^ENG(6914.1,ENI))
- if ENI'>0
- QUIT
- IF $EXTRACT($PIECE(^(ENI,0),U),1,2)=69
- SET AMBC(ENI)=""
- +6 IF $DATA(AMBC)
- Begin DoDot:1
- +7 DO BMES^XPDUTL("You may have some Equipment Records with an incorrect AO CODE and")
- DO MES^XPDUTL("incorrect EQUITY ACCOUNT. Checking further...")
- +8 SET ENI=0
- FOR
- SET ENI=$ORDER(AMBC(ENI))
- if ENI'>0
- QUIT
- Begin DoDot:2
- +9 SET ENDA=0
- FOR
- SET ENDA=$ORDER(^ENG(6914,"AD",ENI,ENDA))
- if ENDA'>0
- QUIT
- Begin DoDot:3
- +10 IF $$GET1^DIQ(6914,ENDA,63,"I")=4
- Begin DoDot:4
- +11 SET ENX=$$CHKFA^ENFAUTL(ENDA)
- SET $PIECE(^ENG(6914,ENDA,9),U,8)=3
- if $PIECE(^(9),U,9)'=3402
- SET $PIECE(^(9),U,9)=3299
- +12 SET COUNT("TOT")=COUNT("TOT")+1
- +13 if $PIECE(ENX,U)
- SET ^TMP($JOB,"CMR69",ENDA)=$$GET1^DIQ(6915.2,$PIECE(ENX,U,4),24)_U_$EXTRACT($$GET1^DIQ(6914,ENDA,3),1,30)_U_$$GET1^DIQ(6914,ENDA,12)
- SET COUNT("FAP")=COUNT("FAP")+1
- +14 IF '$PIECE(ENX,U)
- SET COUNT("EXP")=COUNT("EXP")+1
- End DoDot:4
- End DoDot:3
- End DoDot:2
- +15 IF COUNT("TOT")=0
- DO MES^XPDUTL(" ... no problems found.")
- QUIT
- +16 ;Report the problems
- +17 DO BMES^XPDUTL(COUNT("TOT")_" defective records were found and corrected in AEMS-MERS.")
- DO MES^XPDUTL(COUNT("FAP")_" of these have been reported to the Fixed Assets Package (FAP).")
- +18 DO MES^XPDUTL(COUNT("EXP")_" are not in FAP and are presumably expensed.")
- +19 DO BMES^XPDUTL("The FAP database will be corrected centrally and all AEMS-MERS records have")
- DO MES^XPDUTL("just been fixed. You will now see a list of the defective records that were")
- +20 DO MES^XPDUTL("sent to FAP from Ambulatory Care CMRs, but no corrective action is required")
- DO MES^XPDUTL("of your site.")
- +21 DO BMES^XPDUTL(" FIXED ASSET NUMBER MANUFACTURER EQUIPMENT NAME TOTAL ASSET VALUE")
- +22 DO MES^XPDUTL(" ================== =========================== =================")
- +23 SET ENDA=0
- FOR
- SET ENDA=$ORDER(^TMP($JOB,"CMR69",ENDA))
- if ENDA'>0
- QUIT
- KILL X
- Begin DoDot:2
- +24 SET X(1)=$PIECE(^TMP($JOB,"CMR69",ENDA),U)
- SET X(2)=$PIECE(^(ENDA),U,2)
- SET X(3)=$PIECE(^(ENDA),U,3)
- +25 FOR
- if $LENGTH(X(1))>14
- QUIT
- SET X(1)=X(1)_" "
- +26 FOR
- if $LENGTH(X(2))>29
- QUIT
- SET X(2)=X(2)_" "
- +27 FOR
- if $LENGTH(X(3))>9
- QUIT
- SET X(3)=" "_X(3)
- +28 DO MES^XPDUTL(" "_X(1)_" "_X(2)_" "_X(3))
- End DoDot:2
- End DoDot:1
- MSG1 ;Mail message to developers
- +1 ;Data may be made available to FMS
- +2 SET (ENX,X)=0
- FOR
- SET X=$ORDER(^TMP($JOB,"CMR69",X))
- if X'>0
- QUIT
- SET ENX=ENX+$PIECE(^(X),U,3)
- +3 IF COUNT("FAP")=0
- SET ^TMP($JOB,"CMR69",1)="No FAs transmitted."
- SET ^TMP($JOB,"CMR69",2)=^ENG(6914,0)
- DO PS
- +4 IF '$TEST
- SET ENI=$ORDER(^TMP($JOB,"CMR69",9999999999),-1)
- SET ^TMP($JOB,"CMR69",ENI+1)="FAP Records from CMRs 69x Total $"_ENX
- SET ^TMP($JOB,"CMR69",ENI+2)=^ENG(6914,0)
- DO PS
- +5 SET XMY("HEIBY,D@DOMAIN.EXT")=""
- SET XMY(DUZ)=""
- SET XMDUZ=.5
- +6 SET XMSUB="FAP Records in EIL 69"
- SET XMTEXT="^TMP($J,""CMR69"","
- +7 DO ^XMD
- +8 KILL XMY,XMDUZ,XMSUB,XMTEXT
- +9 ;
- PAT33 ;Clean up EQUITY ACCOUNTS set by 8.16.96 version of ENLIB3
- +1 ;Start with EXPENSED NX
- +2 DO BMES^XPDUTL("Looping thru Equipment File to correct AO CODE vs EQUITY mismatches.")
- +3 DO MES^XPDUTL("This will take a few minutes.")
- +4 NEW DA,FADATE,AO,EQUITY,STATION,XMCHAN
- +5 SET DA("EQ")=0
- SET XMCHAN=1
- +6 ;Clean errors in entries other than CAPITALIZED NX
- +7 FOR
- SET DA("EQ")=$ORDER(^ENG(6914,DA("EQ")))
- if 'DA("EQ")
- QUIT
- if '(DA("EQ")#500)
- DO MES^XPDUTL("ENTRY # "_DA("EQ"))
- SET EQUITY=$PIECE($GET(^ENG(6914,DA("EQ"),9)),U,9)
- IF EQUITY]""
- IF EQUITY'=3402
- Begin DoDot:1
- +8 ;Will check these entries in FA segment
- IF $PIECE($GET(^ENG(6914,DA("EQ"),8)),U,2)
- IF $PIECE($$CHKFA^ENFAUTL(DA("EQ")),U)
- QUIT
- +9 ;Wasn't set via ENLIB3
- SET AO=$PIECE(^ENG(6914,DA("EQ"),9),U,8)
- if 'AO
- QUIT
- +10 IF AO=3
- IF EQUITY=3210
- SET $PIECE(^ENG(6914,DA("EQ"),9),U,9)=3299
- +11 IF "4^5"[AO
- IF EQUITY=3299
- SET $PIECE(^ENG(6914,DA("EQ"),9),U,9)=3210
- End DoDot:1
- FA ;Now we'll look at the FAP stuff
- +1 ;Earlest possible date for install of EN*7*33
- SET FADATE=2960801
- +2 KILL ^TMP($JOB)
- DO BMES^XPDUTL("Checking for FAP Equipment Records in need of correction. Corrections (if")
- +3 DO MES^XPDUTL("needed) will be made centrally. Site action is not required.")
- +4 FOR
- SET FADATE=$ORDER(^ENG(6915.2,"D",FADATE))
- if 'FADATE
- QUIT
- Begin DoDot:1
- +5 SET DA("FA")=$ORDER(^ENG(6915.2,"D",FADATE,0))
- if 'DA("FA")
- QUIT
- +6 SET DA("EQ")=$PIECE(^ENG(6915.2,DA("FA"),0),U)
- if 'DA("EQ")
- QUIT
- +7 if '$DATA(^ENG(6914,DA("EQ"),9))
- QUIT
- +8 SET PO("E")=$PIECE($GET(^ENG(6914,DA("EQ"),2)),U,2)
- if PO("E")']""
- QUIT
- +9 SET PO("I")=$$FIND1^DIC(442,"","X",PO("E"),"C^B")
- if 'PO("I")
- QUIT
- +10 SET STATION=$PIECE($$GET1^DIQ(442,PO("I"),.01),"-")
- +11 IF $LENGTH(STATION)<5
- SET STATION=$EXTRACT(STATION_" ",1,5)
- +12 IF $PIECE(^ENG(6914,DA("EQ"),9),U,8)=3
- IF $PIECE(^(9),U,9)=3210
- Begin DoDot:2
- +13 SET ^TMP($JOB,1,DA("EQ"))="FAP Equip Record '"_STATION_DA("EQ")_"' should have EQUITY of 3299 (MEDICAL)."
- SET $PIECE(^ENG(6914,DA("EQ"),9),U,9)=3299
- +14 DO MES^XPDUTL(^TMP($JOB,1,DA("EQ")))
- End DoDot:2
- +15 IF ($EXTRACT(STATION)=3!("4^5"[$PIECE(^ENG(6914,DA("EQ"),9),U,8)))
- IF $PIECE(^(9),U,9)=3299
- Begin DoDot:2
- +16 SET ^TMP($JOB,1,DA("EQ"))="FAP Equip Record '"_STATION_DA("EQ")_"' should have EQUITY of 3210 (NON-MEDICAL)."
- SET $PIECE(^ENG(6914,DA("EQ"),9),U,9)=3210
- +17 DO MES^XPDUTL(^TMP($JOB,1,DA("EQ")))
- End DoDot:2
- End DoDot:1
- MSG2 ;Feedback to developers
- +1 ;Information may be shared with FMS
- +2 IF $DATA(^TMP($JOB))
- Begin DoDot:1
- +3 SET ^TMP($JOB,1,.1)="The following Equipment Records were given an incorrect EQUITY ACCOUNT when"
- +4 SET ^TMP($JOB,1,.2)="they were added to AEMS/MERS. The AEMS/MERS Equipment Record has been"
- +5 SET ^TMP($JOB,1,.3)="corrected, and the FAP file in Austin will be corrected centrally."
- +6 SET ^TMP($JOB,1,.4)=" "
- +7 SET ^TMP($JOB,1,.5)="NOTE TO INSTALLER OF EN*7.0*37:"
- +8 SET ^TMP($JOB,1,.6)=" This message is a courtesy copy only. No site action is required."
- +9 SET ^TMP($JOB,1,.7)=" "
- +10 SET XMY("HEIBY,D@DOMAIN.EXT")=""
- SET XMY(DUZ)=""
- SET XMDUZ=.5
- +11 SET XMSUB="INCORRECT EQUITY (EN*7*33)"
- SET XMTEXT="^TMP($J,1,"
- +12 DO ^XMD
- +13 KILL XMY,XMDUZ,XMSUB,XMTXT
- End DoDot:1
- +14 KILL ^TMP($JOB)
- +15 ;Design EXIT
- QUIT
- +16 ;
- PS ;Note to installer
- +1 SET ENI=$ORDER(^TMP($JOB,"CMR69",9999999999),-1)
- +2 SET ^TMP($JOB,"CMR69",ENI+1)=""
- SET ^(ENI+2)="NOTE TO INSTALLER OF EN*7.0*37:"
- SET ^(ENI+3)="This message is a courtesy copy only. No action is required of your site."
- +3 QUIT
- +4 ;ENXSIPS
