DG531012P ;OIT/KCL - POST-INSTALL ROUTINE FOR DG*5.3*1012 ;5/1/2020
;;5.3;Registration;**1012**;Aug 13,1993;Build 5
;
;no direct entry
Q
;
POST ;Main entry point for post-install item(s)
;
D POST1
Q
;
POST1 ;Queue off job to file HISTORIC KATRINA ERI
;
;Queue off a job to file HISTORIC KATRINA ERI for patients(DFNs) temporarily
;stored in the ^XTMP("DG531011P") global by patch DG*5.3*1011.
;
; External References:
; ICR# TYPE DESCRIPTION
; ----- ---- -----------
; 10063 Sup ^%ZTLOAD
; 10141 Sup ^XPDUTL:BMES, MES, PATCH
; 10103 Sup NOW^XLFDT
;
;new ^%ZTLOAD input vars
N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSK,ZTSAVE
;
D BMES^XPDUTL(">>> Patients (DFNs) temporarily stored in ^XTMP(""DG531011P"") global")
D MES^XPDUTL(" by patch DG*5.3*1011 had an Emergency Response Indicator (ERI)")
D MES^XPDUTL(" of 'HURRICANE KATRINA'. For historical purposes, this data will")
D MES^XPDUTL(" now be filed back into the patient's record. It will be stored in")
D MES^XPDUTL(" the HISTORIC KATRINA ERI (#.182) field of the PATIENT (#2) file.")
;
;quit if patch previously installed
I $$PATCH^XPDUTL("DG*5.3*1012") D BMES^XPDUTL(" - Not needed since patch DG*5.3*1012 has been installed previously.") Q
;
;quit if ^xtmp global does not exist
I '$D(^XTMP("DG531011P")) D BMES^XPDUTL(" - Not needed since ^XTMP(""DG531011P"") global does not exist.") Q
;
;queue off job to file HISTORIC KATRINA ERI
S ZTRTN="FILEHERI^DG531012P" ;DO "LABEL^ROUTINE"
S ZTDESC="DG*5.3*1012 Post-Install Process (File HISTORIC KATRINA ERI)" ;task description
S ZTDTH=$$NOW^XLFDT ;start time
S ZTIO="" ;device the task should use, NULL=no device is used
S ZTSAVE=("DUZ")="" ;save installer DUZ for job
D ^%ZTLOAD
;
;if job successfully queued
I $G(ZTSK) D
. D BMES^XPDUTL(" - File HISTORIC KATRINA ERI job has been queued.")
. D MES^XPDUTL(" The task number is: "_$G(ZTSK)_".")
. D BMES^XPDUTL(" - A MailMan message containing job results will be sent")
. D MES^XPDUTL(" to the patch installer.")
;
;if job not successfully queued
I '$G(ZTSK) D
. D BMES^XPDUTL(" *********************************************************")
. D MES^XPDUTL(" * !!!! WARNING !!!! *")
. D MES^XPDUTL(" * *")
. D MES^XPDUTL(" * Job to file HISTORIC KATRINA ERI could not be queued. *")
. D MES^XPDUTL(" * Please log YOUR IT Services ticket for assistance. *")
. D MES^XPDUTL(" * *")
. D MES^XPDUTL(" *********************************************************")
Q
;
FILEHERI ;File Historical Emergency Response Indicator Job
;
;Patients (DFNs) temporarily stored in ^XTMP("DG531011P") global by patch DG*5.3*1011 had
;an Emergency Response Indicator (ERI) of 'HURRICANE KATRINA'. For historical purposes,
;this data will now be filed back into the patient's record. It will be stored in the
;new HISTORIC KATRINA ERI (#.182) field of the PATIENT (#2) file. A MailMan message will
;be sent to the patch installer (DUZ) with the results of the job.
;
; External References:
; ICR# TYPE DESCRIPTION
; ----- ---- -----------
; 2053 Sup FILE^DIE
;
;new vars
N DGCNT1,DGCNT2,DGCNT3,DGERR,DGFDA,DGDFN,DGIENS,DGSUB1,DGSUB2
;
;init vars
S (DGCNT1,DGCNT2,DGCNT3,DGSUB1,DGSUB2)=0
K ^TMP("DG531012P") ;temp global used to store any filing errors
;
;get $j subscript ^xtmp global
S DGSUB1=+$O(^XTMP("DG531011P",DGSUB1))
;
;loop through ^xtmp global to retrieve patients (DFNs) that had a HURRICANE KATRINA indicator
F S DGSUB2=$O(^XTMP("DG531011P",DGSUB1,"DFN",DGSUB2)) Q:'DGSUB2 D
. ;
. ;count records processed
. S DGCNT1=DGCNT1+1
. ;
. ;get DFN of patient record in PATIENT (#2) file
. S DGDFN=+$G(^XTMP("DG531011P",DGSUB1,"DFN",DGSUB2))
. ;
. ;file 'HURRICANE KATRINA' indicator into patient's record - file into
. ;the HISTORIC KATRINA ERI (#.182) field of PATIENT (#2) file
. S DGIENS=DGDFN_"," ;FileMan IENs string
. S DGFDA(2,DGIENS,.182)="K" ;FDA array for FILE^DIE
. D FILE^DIE("","DGFDA","DGERR")
. ;shouldn't happen, but if filing error returned from FILE^DIE call then record it
. I $D(DGERR) D Q
. . S DGCNT3=DGCNT3+1 ;total records not updated
. . ;save DFN & error msg into ^tmp global, 1st piece=DFN & 2nd piece=error msg
. . S ^TMP("DG531012P",$J,"ERRORS",DGCNT3)=DGDFN_"^"_$G(DGERR("DIERR",1,"TEXT",1))
. . K DGERR
. ;otherwise, filing was successful
. S DGCNT2=DGCNT2+1 ;total records successfully updated
. ;
;send msg with results
D SENDMSG($G(DGCNT1),$G(DGCNT2),$G(DGCNT3),$G(DUZ))
Q
;
;
SENDMSG(DGCNT1,DGCNT2,DGCNT3,DGDUZ) ;Send MailMan Message
;
;This procedure will create and send a MailMan message to the patch installer.
;The message will contain results from running the DG*5.3*1012 post-install.
;
; Input:
; DGCNT1 - Total records processed in ^XTMP("DG531011P") global.
; DGCNT2 - Total records successfully updated in PATIENT (#2) file.
; DGCNT3 - Total records not successfully updated in PATIENT (#2) file.
; DGDUZ - Patch installer DUZ.
;
; Output: None
;
; External References:
; ICR# TYPE DESCRIPTION
; ----- ---- -----------
; 10070 Sup ^XMD
;
;new vars
N DIFROM ;when invoking ^XMD in post-init routine of the KIDS build, the calling routine must NEW the DIFROM variable
N XMSUB,XMTEXT,XMY ;input vars for ^XMD call
N DGERROUT,DGI,DGLN,DGTEXT ;local vars
;
;construct mailman msg
S XMSUB="DG*5.3*1012 Post-Install Job Results" ;msg subject
S (XMY(.5),XMY($G(DGDUZ)))="" ;msg addressee array
S XMTEXT="DGTEXT(" ;array containing the text of msg
S DGLN=1 ;msg line #
S DGTEXT(DGLN)="DG*5.3*1012 post-install job results."
S DGLN=DGLN+1,DGTEXT(DGLN)=""
;
;if no filing errors
S DGLN=DGLN+1,DGTEXT(DGLN)="Job was successful and no other action is required."
;
;if filing errors
I $G(DGCNT3)>0 S DGTEXT(DGLN)="WARNING - Job was not successful!"
;
;total records processed and total records updated
S DGLN=DGLN+1,DGTEXT(DGLN)=""
S DGLN=DGLN+1,DGTEXT(DGLN)=" - Total records in ^XTMP(""DG531011P"") global: "_$G(DGCNT1)
S DGLN=DGLN+1,DGTEXT(DGLN)=" - Total records updated in PATIENT (#2) file: "_$G(DGCNT2)
;
;if filing errors occurred, list them
I $G(DGCNT3)>0 D
. S DGLN=DGLN+1,DGTEXT(DGLN)=""
. S DGLN=DGLN+1,DGTEXT(DGLN)="Filing errors were encountered while running DG*5.3*1012 post-install job!"
. S DGLN=DGLN+1,DGTEXT(DGLN)=""
. S DGLN=DGLN+1,DGTEXT(DGLN)="Please log YOUR IT Services ticket for assistance with resolving these errors."
. S DGLN=DGLN+1,DGTEXT(DGLN)=""
. S DGLN=DGLN+1,DGTEXT(DGLN)="Patient DFN Error"
. S DGLN=DGLN+1,DGTEXT(DGLN)="-------------------------------------------------"
. ;loop through errors in ^tmp global and get DFN(s) with error msg
. S DGI=0
. F S DGI=$O(^TMP("DG531012P",$J,"ERRORS",DGI)) Q:'DGI D
. . S DGERROUT=$G(^TMP("DG531012P",$J,"ERRORS",DGI))
. . S DGLN=DGLN+1,DGTEXT(DGLN)=$E($P($G(DGERROUT),U)_" ",1,20)_$P($G(DGERROUT),U,2)
. ;
. ;cleanup ^temp error global
. K ^TMP("DG531012P")
;
;send mailman msg
D ^XMD
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG531012P 7365 printed Sep 23, 2025@20:11:24 Page 2
DG531012P ;OIT/KCL - POST-INSTALL ROUTINE FOR DG*5.3*1012 ;5/1/2020
+1 ;;5.3;Registration;**1012**;Aug 13,1993;Build 5
+2 ;
+3 ;no direct entry
+4 QUIT
+5 ;
POST ;Main entry point for post-install item(s)
+1 ;
+2 DO POST1
+3 QUIT
+4 ;
POST1 ;Queue off job to file HISTORIC KATRINA ERI
+1 ;
+2 ;Queue off a job to file HISTORIC KATRINA ERI for patients(DFNs) temporarily
+3 ;stored in the ^XTMP("DG531011P") global by patch DG*5.3*1011.
+4 ;
+5 ; External References:
+6 ; ICR# TYPE DESCRIPTION
+7 ; ----- ---- -----------
+8 ; 10063 Sup ^%ZTLOAD
+9 ; 10141 Sup ^XPDUTL:BMES, MES, PATCH
+10 ; 10103 Sup NOW^XLFDT
+11 ;
+12 ;new ^%ZTLOAD input vars
+13 NEW ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSK,ZTSAVE
+14 ;
+15 DO BMES^XPDUTL(">>> Patients (DFNs) temporarily stored in ^XTMP(""DG531011P"") global")
+16 DO MES^XPDUTL(" by patch DG*5.3*1011 had an Emergency Response Indicator (ERI)")
+17 DO MES^XPDUTL(" of 'HURRICANE KATRINA'. For historical purposes, this data will")
+18 DO MES^XPDUTL(" now be filed back into the patient's record. It will be stored in")
+19 DO MES^XPDUTL(" the HISTORIC KATRINA ERI (#.182) field of the PATIENT (#2) file.")
+20 ;
+21 ;quit if patch previously installed
+22 IF $$PATCH^XPDUTL("DG*5.3*1012")
DO BMES^XPDUTL(" - Not needed since patch DG*5.3*1012 has been installed previously.")
QUIT
+23 ;
+24 ;quit if ^xtmp global does not exist
+25 IF '$DATA(^XTMP("DG531011P"))
DO BMES^XPDUTL(" - Not needed since ^XTMP(""DG531011P"") global does not exist.")
QUIT
+26 ;
+27 ;queue off job to file HISTORIC KATRINA ERI
+28 ;DO "LABEL^ROUTINE"
SET ZTRTN="FILEHERI^DG531012P"
+29 ;task description
SET ZTDESC="DG*5.3*1012 Post-Install Process (File HISTORIC KATRINA ERI)"
+30 ;start time
SET ZTDTH=$$NOW^XLFDT
+31 ;device the task should use, NULL=no device is used
SET ZTIO=""
+32 ;save installer DUZ for job
SET ZTSAVE=("DUZ")=""
+33 DO ^%ZTLOAD
+34 ;
+35 ;if job successfully queued
+36 IF $GET(ZTSK)
Begin DoDot:1
+37 DO BMES^XPDUTL(" - File HISTORIC KATRINA ERI job has been queued.")
+38 DO MES^XPDUTL(" The task number is: "_$GET(ZTSK)_".")
+39 DO BMES^XPDUTL(" - A MailMan message containing job results will be sent")
+40 DO MES^XPDUTL(" to the patch installer.")
End DoDot:1
+41 ;
+42 ;if job not successfully queued
+43 IF '$GET(ZTSK)
Begin DoDot:1
+44 DO BMES^XPDUTL(" *********************************************************")
+45 DO MES^XPDUTL(" * !!!! WARNING !!!! *")
+46 DO MES^XPDUTL(" * *")
+47 DO MES^XPDUTL(" * Job to file HISTORIC KATRINA ERI could not be queued. *")
+48 DO MES^XPDUTL(" * Please log YOUR IT Services ticket for assistance. *")
+49 DO MES^XPDUTL(" * *")
+50 DO MES^XPDUTL(" *********************************************************")
End DoDot:1
+51 QUIT
+52 ;
FILEHERI ;File Historical Emergency Response Indicator Job
+1 ;
+2 ;Patients (DFNs) temporarily stored in ^XTMP("DG531011P") global by patch DG*5.3*1011 had
+3 ;an Emergency Response Indicator (ERI) of 'HURRICANE KATRINA'. For historical purposes,
+4 ;this data will now be filed back into the patient's record. It will be stored in the
+5 ;new HISTORIC KATRINA ERI (#.182) field of the PATIENT (#2) file. A MailMan message will
+6 ;be sent to the patch installer (DUZ) with the results of the job.
+7 ;
+8 ; External References:
+9 ; ICR# TYPE DESCRIPTION
+10 ; ----- ---- -----------
+11 ; 2053 Sup FILE^DIE
+12 ;
+13 ;new vars
+14 NEW DGCNT1,DGCNT2,DGCNT3,DGERR,DGFDA,DGDFN,DGIENS,DGSUB1,DGSUB2
+15 ;
+16 ;init vars
+17 SET (DGCNT1,DGCNT2,DGCNT3,DGSUB1,DGSUB2)=0
+18 ;temp global used to store any filing errors
KILL ^TMP("DG531012P")
+19 ;
+20 ;get $j subscript ^xtmp global
+21 SET DGSUB1=+$ORDER(^XTMP("DG531011P",DGSUB1))
+22 ;
+23 ;loop through ^xtmp global to retrieve patients (DFNs) that had a HURRICANE KATRINA indicator
+24 FOR
SET DGSUB2=$ORDER(^XTMP("DG531011P",DGSUB1,"DFN",DGSUB2))
if 'DGSUB2
QUIT
Begin DoDot:1
+25 ;
+26 ;count records processed
+27 SET DGCNT1=DGCNT1+1
+28 ;
+29 ;get DFN of patient record in PATIENT (#2) file
+30 SET DGDFN=+$GET(^XTMP("DG531011P",DGSUB1,"DFN",DGSUB2))
+31 ;
+32 ;file 'HURRICANE KATRINA' indicator into patient's record - file into
+33 ;the HISTORIC KATRINA ERI (#.182) field of PATIENT (#2) file
+34 ;FileMan IENs string
SET DGIENS=DGDFN_","
+35 ;FDA array for FILE^DIE
SET DGFDA(2,DGIENS,.182)="K"
+36 DO FILE^DIE("","DGFDA","DGERR")
+37 ;shouldn't happen, but if filing error returned from FILE^DIE call then record it
+38 IF $DATA(DGERR)
Begin DoDot:2
+39 ;total records not updated
SET DGCNT3=DGCNT3+1
+40 ;save DFN & error msg into ^tmp global, 1st piece=DFN & 2nd piece=error msg
+41 SET ^TMP("DG531012P",$JOB,"ERRORS",DGCNT3)=DGDFN_"^"_$GET(DGERR("DIERR",1,"TEXT",1))
+42 KILL DGERR
End DoDot:2
QUIT
+43 ;otherwise, filing was successful
+44 ;total records successfully updated
SET DGCNT2=DGCNT2+1
+45 ;
End DoDot:1
+46 ;send msg with results
+47 DO SENDMSG($GET(DGCNT1),$GET(DGCNT2),$GET(DGCNT3),$GET(DUZ))
+48 QUIT
+49 ;
+50 ;
SENDMSG(DGCNT1,DGCNT2,DGCNT3,DGDUZ) ;Send MailMan Message
+1 ;
+2 ;This procedure will create and send a MailMan message to the patch installer.
+3 ;The message will contain results from running the DG*5.3*1012 post-install.
+4 ;
+5 ; Input:
+6 ; DGCNT1 - Total records processed in ^XTMP("DG531011P") global.
+7 ; DGCNT2 - Total records successfully updated in PATIENT (#2) file.
+8 ; DGCNT3 - Total records not successfully updated in PATIENT (#2) file.
+9 ; DGDUZ - Patch installer DUZ.
+10 ;
+11 ; Output: None
+12 ;
+13 ; External References:
+14 ; ICR# TYPE DESCRIPTION
+15 ; ----- ---- -----------
+16 ; 10070 Sup ^XMD
+17 ;
+18 ;new vars
+19 ;when invoking ^XMD in post-init routine of the KIDS build, the calling routine must NEW the DIFROM variable
NEW DIFROM
+20 ;input vars for ^XMD call
NEW XMSUB,XMTEXT,XMY
+21 ;local vars
NEW DGERROUT,DGI,DGLN,DGTEXT
+22 ;
+23 ;construct mailman msg
+24 ;msg subject
SET XMSUB="DG*5.3*1012 Post-Install Job Results"
+25 ;msg addressee array
SET (XMY(.5),XMY($GET(DGDUZ)))=""
+26 ;array containing the text of msg
SET XMTEXT="DGTEXT("
+27 ;msg line #
SET DGLN=1
+28 SET DGTEXT(DGLN)="DG*5.3*1012 post-install job results."
+29 SET DGLN=DGLN+1
SET DGTEXT(DGLN)=""
+30 ;
+31 ;if no filing errors
+32 SET DGLN=DGLN+1
SET DGTEXT(DGLN)="Job was successful and no other action is required."
+33 ;
+34 ;if filing errors
+35 IF $GET(DGCNT3)>0
SET DGTEXT(DGLN)="WARNING - Job was not successful!"
+36 ;
+37 ;total records processed and total records updated
+38 SET DGLN=DGLN+1
SET DGTEXT(DGLN)=""
+39 SET DGLN=DGLN+1
SET DGTEXT(DGLN)=" - Total records in ^XTMP(""DG531011P"") global: "_$GET(DGCNT1)
+40 SET DGLN=DGLN+1
SET DGTEXT(DGLN)=" - Total records updated in PATIENT (#2) file: "_$GET(DGCNT2)
+41 ;
+42 ;if filing errors occurred, list them
+43 IF $GET(DGCNT3)>0
Begin DoDot:1
+44 SET DGLN=DGLN+1
SET DGTEXT(DGLN)=""
+45 SET DGLN=DGLN+1
SET DGTEXT(DGLN)="Filing errors were encountered while running DG*5.3*1012 post-install job!"
+46 SET DGLN=DGLN+1
SET DGTEXT(DGLN)=""
+47 SET DGLN=DGLN+1
SET DGTEXT(DGLN)="Please log YOUR IT Services ticket for assistance with resolving these errors."
+48 SET DGLN=DGLN+1
SET DGTEXT(DGLN)=""
+49 SET DGLN=DGLN+1
SET DGTEXT(DGLN)="Patient DFN Error"
+50 SET DGLN=DGLN+1
SET DGTEXT(DGLN)="-------------------------------------------------"
+51 ;loop through errors in ^tmp global and get DFN(s) with error msg
+52 SET DGI=0
+53 FOR
SET DGI=$ORDER(^TMP("DG531012P",$JOB,"ERRORS",DGI))
if 'DGI
QUIT
Begin DoDot:2
+54 SET DGERROUT=$GET(^TMP("DG531012P",$JOB,"ERRORS",DGI))
+55 SET DGLN=DGLN+1
SET DGTEXT(DGLN)=$EXTRACT($PIECE($GET(DGERROUT),U)_" ",1,20)_$PIECE($GET(DGERROUT),U,2)
End DoDot:2
+56 ;
+57 ;cleanup ^temp error global
+58 KILL ^TMP("DG531012P")
End DoDot:1
+59 ;
+60 ;send mailman msg
+61 DO ^XMD
+62 ;
+63 QUIT
