1 | ENXOIPS1 ;WIRMFO/DH-POST INIT (continued) ;8.14.96
|
---|
2 | ;;7.0;ENGINEERING;**33**;AUG 17, 1993
|
---|
3 | AOCHK ;Check for incorrect A.O. Codes (CMR 69x)
|
---|
4 | N AMBC,ENX,ENI,X,ENDA,COUNT K ^TMP($J,"CMR69")
|
---|
5 | S (COUNT("TOT"),COUNT("FAP"),COUNT("EXP"))=0
|
---|
6 | 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)=""
|
---|
7 | I $D(AMBC) D
|
---|
8 | . D BMES^XPDUTL("You may have some Equipment Records with an incorrect A.O. Code and") D MES^XPDUTL("incorrect Equity Account. Checking further...")
|
---|
9 | . S ENI=0 F S ENI=$O(AMBC(ENI)) Q:ENI'>0 D
|
---|
10 | .. S ENDA=0 F S ENDA=$O(^ENG(6914,"AD",ENI,ENDA)) Q:ENDA'>0 D
|
---|
11 | ... I $$GET1^DIQ(6914,ENDA,63,"I")=4 D
|
---|
12 | ....S ENX=$$CHKFA^ENFAUTL(ENDA),$P(^ENG(6914,ENDA,9),U,8)=3,$P(^(9),U,9)=3299
|
---|
13 | .... S COUNT("TOT")=COUNT("TOT")+1
|
---|
14 | .... 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
|
---|
15 | .... I '$P(ENX,U) S COUNT("EXP")=COUNT("EXP")+1
|
---|
16 | . I COUNT("TOT")=0 D MES^XPDUTL(" ... no problems found.") Q
|
---|
17 | . ;Report the problems
|
---|
18 | . 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).")
|
---|
19 | . D MES^XPDUTL(COUNT("EXP")_" are not in FAP and are presumably expensed.")
|
---|
20 | . 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")
|
---|
21 | . D MES^XPDUTL("were sent to FAP from Ambulatory Care CMRs, but no corrective action is") D MES^XPDUTL("required of your site.")
|
---|
22 | . D BMES^XPDUTL(" FIXED ASSET NUMBER MANUFACTURER EQUIPMENT NAME TOTAL ASSET VALUE")
|
---|
23 | . D MES^XPDUTL(" ================== =========================== =================")
|
---|
24 | . S ENDA=0 F S ENDA=$O(^TMP($J,"CMR69",ENDA)) Q:ENDA'>0 K X D
|
---|
25 | .. S X(1)=$P(^TMP($J,"CMR69",ENDA),U),X(2)=$P(^(ENDA),U,2),X(3)=$P(^(ENDA),U,3)
|
---|
26 | .. F Q:$L(X(1))>14 S X(1)=X(1)_" "
|
---|
27 | .. F Q:$L(X(2))>29 S X(2)=X(2)_" "
|
---|
28 | .. F Q:$L(X(3))>9 S X(3)=" "_X(3)
|
---|
29 | .. D MES^XPDUTL(" "_X(1)_" "_X(2)_" "_X(3))
|
---|
30 | MSG ;Mail message to developer
|
---|
31 | ;Data may be made available to FMS
|
---|
32 | S (ENX,X)=0 F S X=$O(^TMP($J,"CMR69",X)) Q:X'>0 S ENX=ENX+$P(^(X),U,3)
|
---|
33 | I COUNT("FAP")=0 S ^TMP($J,"CMR69",1)="No FAs transmitted.",^TMP($J,"CMR69",2)=^ENG(6914,0) D PS
|
---|
34 | 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
|
---|
35 | S XMY("HEIBY,D@FORUM.VA.GOV")="",XMY(DUZ)="",XMDUZ=.5
|
---|
36 | S XMSUB="FAP Records in EIL 69",XMTEXT="^TMP($J,""CMR69"","
|
---|
37 | D ^XMD
|
---|
38 | K XMY,XMDUZ,XMSUB,XMTEXT
|
---|
39 | K ^TMP($J)
|
---|
40 | Q
|
---|
41 | PS ;Note to installer
|
---|
42 | S ENI=$O(^TMP($J,"CMR69",9999999999),-1)
|
---|
43 | 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."
|
---|
44 | Q
|
---|
45 | ;ENXOIPS1
|
---|