- 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 Feb 19, 2025@00:06:05 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