source: WorldVistAEHR/trunk/r/ENGINEERING-EN/ENXOIPS1.m@ 862

Last change on this file since 862 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.9 KB
RevLine 
[613]1ENXOIPS1 ;WIRMFO/DH-POST INIT (continued) ;8.14.96
2 ;;7.0;ENGINEERING;**33**;AUG 17, 1993
3AOCHK ;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))
30MSG ;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
41PS ;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
Note: See TracBrowser for help on using the repository browser.