ENXOIPS1 ;WIRMFO/DH-POST INIT (continued) ;8.14.96
;;7.0;ENGINEERING;**33**;AUG 17, 1993
AOCHK ;Check for incorrect A.O. Codes (CMR 69x)
N AMBC,ENX,ENI,X,ENDA,COUNT K ^TMP($J,"CMR69")
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 A.O. 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,$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 in FAP and all AEMS-MERS records have") D MES^XPDUTL("just been fixed. You will now see a list of the defective records that")
. D MES^XPDUTL("were sent to FAP from Ambulatory Care CMRs, but no corrective action is") D MES^XPDUTL("required 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))
MSG ;Mail message to developer
;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
K ^TMP($J)
Q
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*33:",^(ENI+3)="This message is a courtesy copy only. No action is required of your site."
Q
;ENXOIPS1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENXOIPS1 2972 printed Dec 13, 2024@01:57:01 Page 2
ENXOIPS1 ;WIRMFO/DH-POST INIT (continued) ;8.14.96
+1 ;;7.0;ENGINEERING;**33**;AUG 17, 1993
AOCHK ;Check for incorrect A.O. Codes (CMR 69x)
+1 NEW AMBC,ENX,ENI,X,ENDA,COUNT
KILL ^TMP($JOB,"CMR69")
+2 SET (COUNT("TOT"),COUNT("FAP"),COUNT("EXP"))=0
+3 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)=""
+4 IF $DATA(AMBC)
Begin DoDot:1
+5 DO BMES^XPDUTL("You may have some Equipment Records with an incorrect A.O. Code and")
DO MES^XPDUTL("incorrect Equity Account. Checking further...")
+6 SET ENI=0
FOR
SET ENI=$ORDER(AMBC(ENI))
if ENI'>0
QUIT
Begin DoDot:2
+7 SET ENDA=0
FOR
SET ENDA=$ORDER(^ENG(6914,"AD",ENI,ENDA))
if ENDA'>0
QUIT
Begin DoDot:3
+8 IF $$GET1^DIQ(6914,ENDA,63,"I")=4
Begin DoDot:4
+9 SET ENX=$$CHKFA^ENFAUTL(ENDA)
SET $PIECE(^ENG(6914,ENDA,9),U,8)=3
SET $PIECE(^(9),U,9)=3299
+10 SET COUNT("TOT")=COUNT("TOT")+1
+11 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
+12 IF '$PIECE(ENX,U)
SET COUNT("EXP")=COUNT("EXP")+1
End DoDot:4
End DoDot:3
End DoDot:2
+13 IF COUNT("TOT")=0
DO MES^XPDUTL(" ... no problems found.")
QUIT
+14 ;Report the problems
+15 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).")
+16 DO MES^XPDUTL(COUNT("EXP")_" are not in FAP and are presumably expensed.")
+17 DO BMES^XPDUTL("The FAP database will be corrected in FAP and all AEMS-MERS records have")
DO MES^XPDUTL("just been fixed. You will now see a list of the defective records that")
+18 DO MES^XPDUTL("were sent to FAP from Ambulatory Care CMRs, but no corrective action is")
DO MES^XPDUTL("required of your site.")
+19 DO BMES^XPDUTL(" FIXED ASSET NUMBER MANUFACTURER EQUIPMENT NAME TOTAL ASSET VALUE")
+20 DO MES^XPDUTL(" ================== =========================== =================")
+21 SET ENDA=0
FOR
SET ENDA=$ORDER(^TMP($JOB,"CMR69",ENDA))
if ENDA'>0
QUIT
KILL X
Begin DoDot:2
+22 SET X(1)=$PIECE(^TMP($JOB,"CMR69",ENDA),U)
SET X(2)=$PIECE(^(ENDA),U,2)
SET X(3)=$PIECE(^(ENDA),U,3)
+23 FOR
if $LENGTH(X(1))>14
QUIT
SET X(1)=X(1)_" "
+24 FOR
if $LENGTH(X(2))>29
QUIT
SET X(2)=X(2)_" "
+25 FOR
if $LENGTH(X(3))>9
QUIT
SET X(3)=" "_X(3)
+26 DO MES^XPDUTL(" "_X(1)_" "_X(2)_" "_X(3))
End DoDot:2
End DoDot:1
MSG ;Mail message to developer
+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 KILL ^TMP($JOB)
+10 QUIT
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*33:"
SET ^(ENI+3)="This message is a courtesy copy only. No action is required of your site."
+3 QUIT
+4 ;ENXOIPS1
