- 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 Feb 19, 2025@00:01:39 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