source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DG53P733.m@ 836

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

initial load of WorldVistAEHR

File size: 3.6 KB
RevLine 
[613]1DG53P733 ;ALB/AMA,GTS - PATCH DG*5.3*733 POST-INSTALL ROUTINE
2 ;;5.3;Registration;**733**;Aug 13, 1993;Build 15
3 ;
4EN ;
5 N ZTDTH,ZTIO,ZTDESC,ZTRTN,ZTSAVE,ZTSK
6 S ZTDTH=$H
7 S ZTIO=""
8 S ZTDESC="DG*5.3*733 Post-Install message"
9 S ZTRTN="CLEANUP^DG53P733"
10 S ZTSAVE("DUZ")=""
11 S ZTSAVE("JVAL")=$J
12 D ^%ZTLOAD
13 I $G(ZTSK) DO
14 . D BMES^XPDUTL("POST-INSTALL CLEANUP MESSAGE QUEUED TO SEND")
15 . D BMES^XPDUTL("Means Test database cleanup has been completed. Check your VA Mailman")
16 . D MES^XPDUTL("mailbox for the ""DG*5.3*733 External value cleanup"" message.")
17 . D BMES^XPDUTL("Only if you do not receive the e-mail, check the following global:")
18 . D MES^XPDUTL(" ^XTMP(""DG"","_$J_",""PATCH 733 CLEANUP BULLETIN"")")
19 I '$G(ZTSK) D BMES^XPDUTL("PROBLEM: POST-INSTALL CLEANUP MESSAGE NOT SENT")
20 Q
21CLEANUP ;
22 N JVAL,DGMMLNE,DFN,FIRST,RECCNT
23 S JVAL=$J
24 ;*Create bulletin head to identify cleanup records
25 K ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN")
26 S ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",1)="This message indicates the patients in the PATIENT file (2)"
27 S ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",2)="that have had the COMBAT INDICATED ON 1010EZ field (1010.157)"
28 S ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",3)="populated to the correct YES, NO or NULL value."
29 S ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",4)=" "
30 ;
31 S DGMMLNE=4
32 ;
33 ;*Set up message text
34 S DGMMLNE=DGMMLNE+1
35 S ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",DGMMLNE)="Checking COMBAT INDICATED ON 1010EZ field (1010.157) in PATIENT file (2)..."
36 S DGMMLNE=DGMMLNE+1
37 S ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",DGMMLNE)=" "
38 ;
39 ;Execute COMBAT INDICATED ON 1010EZ field conversion
40 S FIRST=1,RECCNT=0
41 S DFN=0 F S DFN=$O(^DPT(DFN)) Q:'DFN D
42 . Q:'$D(^DPT(DFN,.52))
43 . N NODE52,NODE1010 S NODE52=$G(^DPT(DFN,.52)),NODE1010=$G(^DPT(DFN,1010.15))
44 . I ($P(NODE52,U,11)=""),($P(NODE1010,U,7)'="") D Q
45 . . S $P(^DPT(DFN,1010.15),U,7)=""
46 . . D ADDLINE("NULL")
47 . I ($P(NODE52,U,11)="N"),($P(NODE1010,U,7)'=0) D Q
48 . . S $P(^DPT(DFN,1010.15),U,7)=0
49 . . D ADDLINE("NO")
50 . I ($P(NODE52,U,11)="Y"),($P(NODE52,U,14)'>2981111),($P(NODE1010,U,7)'=0) D Q
51 . . S $P(^DPT(DFN,1010.15),U,7)=0
52 . . D ADDLINE("NO")
53 . I ($P(NODE52,U,11)="Y"),($P(NODE52,U,14)>2981111),($P(NODE1010,U,7)'=1) D Q
54 . . S $P(^DPT(DFN,1010.15),U,7)=1
55 . . D ADDLINE("YES")
56 ;
57 S DGMMLNE=DGMMLNE+1
58 S ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",DGMMLNE)=" "
59 S DGMMLNE=DGMMLNE+1
60 S ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",DGMMLNE)="There were "_RECCNT_" records corrected."
61 S DGMMLNE=DGMMLNE+1
62 S ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",DGMMLNE)=" "
63 ;
64 ;* Queue message to be sent
65 D SENDMESS
66 Q
67ADDLINE(MSG) ;
68 I FIRST D FIRST S FIRST=0
69 S DGMMLNE=DGMMLNE+1,RECCNT=RECCNT+1
70 S ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",DGMMLNE)=" IEN: "_DFN_" COMBAT INDICATED ON 1010EZ changed to: "_MSG
71 Q
72FIRST ;
73 S DGMMLNE=DGMMLNE+1
74 S ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",DGMMLNE)="The COMBAT INDICATED ON 1010EZ field (#1010.157) for the following Patient"
75 S DGMMLNE=DGMMLNE+1
76 S ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",DGMMLNE)="file (#2) IENs were modified:"
77 S DGMMLNE=DGMMLNE+1
78 S ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",DGMMLNE)=" "
79 Q
80SENDMESS ;
81 N XMSUB,XMDUZ,XMTEXT,XMY,XMMG
82 S XMSUB="DG*5.3*733 COMBAT INDICATED ON 1010EZ cleanup"
83 S XMDUZ="DG*5.3*733 Install Cleanup"
84 S XMTEXT="^XTMP(""DG"",JVAL,""PATCH 733 CLEANUP BULLETIN"","
85 S XMY(DUZ)=""
86 S XMY(.5)=""
87 D ^XMD
88 S DGMMLNE=$P($$FMADD^XLFDT($$NOW^XLFDT,,,5),".")
89 S ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",0)=DGMMLNE
90 I '$D(XMMG) K ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN")
91 Q
Note: See TracBrowser for help on using the repository browser.