DG53P733 ;ALB/AMA,GTS - PATCH DG*5.3*733 POST-INSTALL ROUTINE
;;5.3;Registration;**733**;Aug 13, 1993;Build 15
;
EN ;
N ZTDTH,ZTIO,ZTDESC,ZTRTN,ZTSAVE,ZTSK
S ZTDTH=$H
S ZTIO=""
S ZTDESC="DG*5.3*733 Post-Install message"
S ZTRTN="CLEANUP^DG53P733"
S ZTSAVE("DUZ")=""
S ZTSAVE("JVAL")=$J
D ^%ZTLOAD
I $G(ZTSK) DO
. D BMES^XPDUTL("POST-INSTALL CLEANUP MESSAGE QUEUED TO SEND")
. D BMES^XPDUTL("Means Test database cleanup has been completed. Check your VA Mailman")
. D MES^XPDUTL("mailbox for the ""DG*5.3*733 External value cleanup"" message.")
. D BMES^XPDUTL("Only if you do not receive the e-mail, check the following global:")
. D MES^XPDUTL(" ^XTMP(""DG"","_$J_",""PATCH 733 CLEANUP BULLETIN"")")
I '$G(ZTSK) D BMES^XPDUTL("PROBLEM: POST-INSTALL CLEANUP MESSAGE NOT SENT")
Q
CLEANUP ;
N JVAL,DGMMLNE,DFN,FIRST,RECCNT
S JVAL=$J
;*Create bulletin head to identify cleanup records
K ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN")
S ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",1)="This message indicates the patients in the PATIENT file (2)"
S ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",2)="that have had the COMBAT INDICATED ON 1010EZ field (1010.157)"
S ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",3)="populated to the correct YES, NO or NULL value."
S ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",4)=" "
;
S DGMMLNE=4
;
;*Set up message text
S DGMMLNE=DGMMLNE+1
S ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",DGMMLNE)="Checking COMBAT INDICATED ON 1010EZ field (1010.157) in PATIENT file (2)..."
S DGMMLNE=DGMMLNE+1
S ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",DGMMLNE)=" "
;
;Execute COMBAT INDICATED ON 1010EZ field conversion
S FIRST=1,RECCNT=0
S DFN=0 F S DFN=$O(^DPT(DFN)) Q:'DFN D
. Q:'$D(^DPT(DFN,.52))
. N NODE52,NODE1010 S NODE52=$G(^DPT(DFN,.52)),NODE1010=$G(^DPT(DFN,1010.15))
. I ($P(NODE52,U,11)=""),($P(NODE1010,U,7)'="") D Q
. . S $P(^DPT(DFN,1010.15),U,7)=""
. . D ADDLINE("NULL")
. I ($P(NODE52,U,11)="N"),($P(NODE1010,U,7)'=0) D Q
. . S $P(^DPT(DFN,1010.15),U,7)=0
. . D ADDLINE("NO")
. I ($P(NODE52,U,11)="Y"),($P(NODE52,U,14)'>2981111),($P(NODE1010,U,7)'=0) D Q
. . S $P(^DPT(DFN,1010.15),U,7)=0
. . D ADDLINE("NO")
. I ($P(NODE52,U,11)="Y"),($P(NODE52,U,14)>2981111),($P(NODE1010,U,7)'=1) D Q
. . S $P(^DPT(DFN,1010.15),U,7)=1
. . D ADDLINE("YES")
;
S DGMMLNE=DGMMLNE+1
S ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",DGMMLNE)=" "
S DGMMLNE=DGMMLNE+1
S ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",DGMMLNE)="There were "_RECCNT_" records corrected."
S DGMMLNE=DGMMLNE+1
S ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",DGMMLNE)=" "
;
;* Queue message to be sent
D SENDMESS
Q
ADDLINE(MSG) ;
I FIRST D FIRST S FIRST=0
S DGMMLNE=DGMMLNE+1,RECCNT=RECCNT+1
S ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",DGMMLNE)=" IEN: "_DFN_" COMBAT INDICATED ON 1010EZ changed to: "_MSG
Q
FIRST ;
S DGMMLNE=DGMMLNE+1
S ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",DGMMLNE)="The COMBAT INDICATED ON 1010EZ field (#1010.157) for the following Patient"
S DGMMLNE=DGMMLNE+1
S ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",DGMMLNE)="file (#2) IENs were modified:"
S DGMMLNE=DGMMLNE+1
S ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",DGMMLNE)=" "
Q
SENDMESS ;
N XMSUB,XMDUZ,XMTEXT,XMY,XMMG
S XMSUB="DG*5.3*733 COMBAT INDICATED ON 1010EZ cleanup"
S XMDUZ="DG*5.3*733 Install Cleanup"
S XMTEXT="^XTMP(""DG"",JVAL,""PATCH 733 CLEANUP BULLETIN"","
S XMY(DUZ)=""
S XMY(.5)=""
D ^XMD
S DGMMLNE=$P($$FMADD^XLFDT($$NOW^XLFDT,,,5),".")
S ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",0)=DGMMLNE
I '$D(XMMG) K ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53P733 3735 printed Sep 23, 2025@20:15:53 Page 2
DG53P733 ;ALB/AMA,GTS - PATCH DG*5.3*733 POST-INSTALL ROUTINE
+1 ;;5.3;Registration;**733**;Aug 13, 1993;Build 15
+2 ;
EN ;
+1 NEW ZTDTH,ZTIO,ZTDESC,ZTRTN,ZTSAVE,ZTSK
+2 SET ZTDTH=$HOROLOG
+3 SET ZTIO=""
+4 SET ZTDESC="DG*5.3*733 Post-Install message"
+5 SET ZTRTN="CLEANUP^DG53P733"
+6 SET ZTSAVE("DUZ")=""
+7 SET ZTSAVE("JVAL")=$JOB
+8 DO ^%ZTLOAD
+9 IF $GET(ZTSK)
Begin DoDot:1
+10 DO BMES^XPDUTL("POST-INSTALL CLEANUP MESSAGE QUEUED TO SEND")
+11 DO BMES^XPDUTL("Means Test database cleanup has been completed. Check your VA Mailman")
+12 DO MES^XPDUTL("mailbox for the ""DG*5.3*733 External value cleanup"" message.")
+13 DO BMES^XPDUTL("Only if you do not receive the e-mail, check the following global:")
+14 DO MES^XPDUTL(" ^XTMP(""DG"","_$JOB_",""PATCH 733 CLEANUP BULLETIN"")")
End DoDot:1
+15 IF '$GET(ZTSK)
DO BMES^XPDUTL("PROBLEM: POST-INSTALL CLEANUP MESSAGE NOT SENT")
+16 QUIT
CLEANUP ;
+1 NEW JVAL,DGMMLNE,DFN,FIRST,RECCNT
+2 SET JVAL=$JOB
+3 ;*Create bulletin head to identify cleanup records
+4 KILL ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN")
+5 SET ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",1)="This message indicates the patients in the PATIENT file (2)"
+6 SET ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",2)="that have had the COMBAT INDICATED ON 1010EZ field (1010.157)"
+7 SET ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",3)="populated to the correct YES, NO or NULL value."
+8 SET ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",4)=" "
+9 ;
+10 SET DGMMLNE=4
+11 ;
+12 ;*Set up message text
+13 SET DGMMLNE=DGMMLNE+1
+14 SET ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",DGMMLNE)="Checking COMBAT INDICATED ON 1010EZ field (1010.157) in PATIENT file (2)..."
+15 SET DGMMLNE=DGMMLNE+1
+16 SET ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",DGMMLNE)=" "
+17 ;
+18 ;Execute COMBAT INDICATED ON 1010EZ field conversion
+19 SET FIRST=1
SET RECCNT=0
+20 SET DFN=0
FOR
SET DFN=$ORDER(^DPT(DFN))
if 'DFN
QUIT
Begin DoDot:1
+21 if '$DATA(^DPT(DFN,.52))
QUIT
+22 NEW NODE52,NODE1010
SET NODE52=$GET(^DPT(DFN,.52))
SET NODE1010=$GET(^DPT(DFN,1010.15))
+23 IF ($PIECE(NODE52,U,11)="")
IF ($PIECE(NODE1010,U,7)'="")
Begin DoDot:2
+24 SET $PIECE(^DPT(DFN,1010.15),U,7)=""
+25 DO ADDLINE("NULL")
End DoDot:2
QUIT
+26 IF ($PIECE(NODE52,U,11)="N")
IF ($PIECE(NODE1010,U,7)'=0)
Begin DoDot:2
+27 SET $PIECE(^DPT(DFN,1010.15),U,7)=0
+28 DO ADDLINE("NO")
End DoDot:2
QUIT
+29 IF ($PIECE(NODE52,U,11)="Y")
IF ($PIECE(NODE52,U,14)'>2981111)
IF ($PIECE(NODE1010,U,7)'=0)
Begin DoDot:2
+30 SET $PIECE(^DPT(DFN,1010.15),U,7)=0
+31 DO ADDLINE("NO")
End DoDot:2
QUIT
+32 IF ($PIECE(NODE52,U,11)="Y")
IF ($PIECE(NODE52,U,14)>2981111)
IF ($PIECE(NODE1010,U,7)'=1)
Begin DoDot:2
+33 SET $PIECE(^DPT(DFN,1010.15),U,7)=1
+34 DO ADDLINE("YES")
End DoDot:2
QUIT
End DoDot:1
+35 ;
+36 SET DGMMLNE=DGMMLNE+1
+37 SET ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",DGMMLNE)=" "
+38 SET DGMMLNE=DGMMLNE+1
+39 SET ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",DGMMLNE)="There were "_RECCNT_" records corrected."
+40 SET DGMMLNE=DGMMLNE+1
+41 SET ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",DGMMLNE)=" "
+42 ;
+43 ;* Queue message to be sent
+44 DO SENDMESS
+45 QUIT
ADDLINE(MSG) ;
+1 IF FIRST
DO FIRST
SET FIRST=0
+2 SET DGMMLNE=DGMMLNE+1
SET RECCNT=RECCNT+1
+3 SET ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",DGMMLNE)=" IEN: "_DFN_" COMBAT INDICATED ON 1010EZ changed to: "_MSG
+4 QUIT
FIRST ;
+1 SET DGMMLNE=DGMMLNE+1
+2 SET ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",DGMMLNE)="The COMBAT INDICATED ON 1010EZ field (#1010.157) for the following Patient"
+3 SET DGMMLNE=DGMMLNE+1
+4 SET ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",DGMMLNE)="file (#2) IENs were modified:"
+5 SET DGMMLNE=DGMMLNE+1
+6 SET ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",DGMMLNE)=" "
+7 QUIT
SENDMESS ;
+1 NEW XMSUB,XMDUZ,XMTEXT,XMY,XMMG
+2 SET XMSUB="DG*5.3*733 COMBAT INDICATED ON 1010EZ cleanup"
+3 SET XMDUZ="DG*5.3*733 Install Cleanup"
+4 SET XMTEXT="^XTMP(""DG"",JVAL,""PATCH 733 CLEANUP BULLETIN"","
+5 SET XMY(DUZ)=""
+6 SET XMY(.5)=""
+7 DO ^XMD
+8 SET DGMMLNE=$PIECE($$FMADD^XLFDT($$NOW^XLFDT,,,5),".")
+9 SET ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN",0)=DGMMLNE
+10 IF '$DATA(XMMG)
KILL ^XTMP("DG",JVAL,"PATCH 733 CLEANUP BULLETIN")
+11 QUIT
