DG531111P ;ALB/JAM - DG*5.3*1111 INSTALL UTILITY;07/12/2021 15:21pm
;;5.3;Registration;**1111**;Jan 26 2022;Build 18
;
QUIT ;No direct entry
;
;---------------------------------------------------------------------------
;Patch DG*5.3*1111: Environment, Pre-Install, and Post-Install entry points.
;---------------------------------------------------------------------------
;
; Reference to BMES^XPDUTL supported by ICR #10141
; Reference to MES^XPDUTL supported by ICR #10141
; Reference to $$PATCH^XPDUTL in ICR #10141
; Reference to ^XMD in ICR #10070
;
;
ENV ;Main entry point for Environment check
Q
;
PRE ;Main entry point for Pre-Install items
Q
;
POST ;Main entry point for Post-Install items
;
D BMES^XPDUTL(">>> Beginning the DG*5.3*1111 Post-install routine...")
; Check if the patch has previously run and ^XTMP exists, if so quit out POST
I $$PATCH^XPDUTL("DG*5.3*1111"),$D(^XTMP("DG531111P")) D Q
. D BMES^XPDUTL("Patch has been previously installed and ^XTMP(""DG531111P"" global")
. D BMES^XPDUTL(" contains informational data from previous install.")
. D BMES^XPDUTL(" The Post-install will not be run again.")
. D BMES^XPDUTL(">>> Patch DG*5.3*1111 Post-install complete.")
D POST1
D POST2
D BMES^XPDUTL(">>> Patch DG*5.3*1111 - Post-install complete.")
Q
;
POST1 ; Rename any entries in ENROLLMENT STATUS file (#27.15) with REJECTED to DEFERRED
D BMES^XPDUTL(" - Rename all entries in the ENROLLMENT STATUS file (#27.15)")
D MES^XPDUTL(" with the name containing REJECTED to DEFERRED.")
N DGOLDNAME,DGNAME,DGIEN,DGDATA,DGERR,DGOLD,DGNEW,DGCTR,DGERR
S DGIEN=0
S DGOLD="REJECTED"
S DGNEW="DEFERRED"
F S DGIEN=$O(^DGEN(27.15,DGIEN)) Q:'DGIEN D
. S DGNAME=$$GET1^DIQ(27.15,DGIEN,.01)
. ; No action needed if the name does not contain REJECTED
. Q:DGNAME'[DGOLD
. S DGOLDNAME=DGNAME
. ; Replace REJECTED with DEFERRED in the name
. F DGCTR=1:1:($L(DGNAME,$E(DGOLD))-1) I $F(DGNAME,DGOLD)>0 S $E(DGNAME,$F(DGNAME,DGOLD)-$L(DGOLD),$F(DGNAME,DGOLD)-1)=DGNEW
. ; Set updated NAME back into the entry
. S DGDATA(.01)=DGNAME
. I $$UPD^DGENDBS(27.15,.DGIEN,.DGDATA,.DGERR) D
. . D BMES^XPDUTL("Enrollment Status: ")
. . D MES^XPDUTL(DGOLDNAME)
. . D MES^XPDUTL("renamed to: ")
. . D MES^XPDUTL(DGNAME)
. I $G(DGERR)'="" D
. . D BMES^XPDUTL("**** Error updating "_DGOLDNAME)
. . D MES^XPDUTL(">>> Error: "_DGERR)
. . D MES^XPDUTL(" - Submit a YOUR IT Services ticket with the Enterprise Service Desk")
. . D MES^XPDUTL(" for assistance.")
D BMES^XPDUTL(" - Rename of ENROLLMENT STATUS entries complete.")
Q
;
POST2 ; Update the REMARKS field (#.091) in the PATIENT file (#2) to replace instances with
; the text **REJECTED** with **DEFERRED**
;
D BMES^XPDUTL(" - Queuing job to replace **REJECTED** with **DEFERRED** in the REMARKS")
D MES^XPDUTL(" field (#.091) of the PATIENT file (#2) from all Patient records.")
D BMES^XPDUTL(" All records in the PATIENT file (#2) will be scanned.")
D MES^XPDUTL(" If the REMARKS field (#.091) contains the text **REJECTED**")
D MES^XPDUTL(" it will be replaced with **DEFERRED**.")
;
;queue off job
N ZTRTN,ZTDESC,ZTDTH,DGTEXT,ZTIO,ZTSK,DGTXT
S ZTRTN="QJOB^DG531111P"
S ZTDESC="DG*5.3*1111 Replace **REJECTED** with **DEFERRED** from the REMARKS (#.091) field in all Patient records."
S ZTDTH=$$NOW^XLFDT
S ZTIO=""
D ^%ZTLOAD
I $G(ZTSK)'="" D
. S DGTEXT(1)=""
. S DGTEXT(2)="Patient REMARKS data cleanup job queued."
. S DGTEXT(3)="The task number is "_$G(ZTSK)_"."
. S DGTEXT(4)=""
. S DGTEXT(5)="A Mailman Message containing job results will be sent to the installer."
I $G(ZTSK)="" D
. S DGTEXT(1)=""
. S DGTEXT(2)="*** Patient REMARKS data cleanup job FAILED TO QUEUE. ***"
. S DGTEXT(3)=""
. S DGTEXT(4)=" - Submit a YOUR IT Services ticket with the Enterprise Service Desk"
. S DGTEXT(5)=" for assistance."
D BMES^XPDUTL(.DGTEXT)
Q
;
QJOB ; Job Entry point
; Information from the job will be placed in ^XTMP (60 day expiration) and sent in a Mailman message
K ^XTMP("DG531111P")
S ^XTMP("DG531111P",0)=$$FMADD^XLFDT(DT,60)_U_DT_U_"PATCH DG*5.3*1111 Patient REMARKS data cleanup job"
; Collect stats: start/end time and the number of records scanned and modified
N %,DGDFN,DGCNT,DGERR,DGREM,DGREMORIG,DGDATA,DGDTS,DGDTE,Y,DGERRCNT,DGNEW,DGOLD,DGMAX,DGCTR
D NOW^%DTC S Y=% D DD^%DT
S DGDTS=Y
;
S (DGCNT,DGERRCNT,DGDFN)=0
S DGOLD="**REJECTED**"
S DGNEW="**DEFERRED**"
F S DGDFN=$O(^DPT(DGDFN)) Q:'DGDFN D ; loop patients
. ; Get REMARKS field data
. S (DGREM,DGREMORIG)=$$GET1^DIQ(2,DGDFN,.091)
. I DGREM'[DGOLD Q
. S DGMAX=$L(DGREM)
. ; Replace text in the DGREM string
. F DGCTR=1:1:($L(DGREM,$E(DGOLD))-1) I $F(DGREM,DGOLD)>0 S $E(DGREM,$F(DGREM,DGOLD)-$L(DGOLD),$F(DGREM,DGOLD)-1)=DGNEW
. ; Set updated remarks back into patient record
. S DGDATA(.091)=DGREM
. I $$UPD^DGENDBS(2,.DGDFN,.DGDATA,.DGERR) D Q
. . S DGCNT=DGCNT+1 ; bump count of patients we are updating
. . S ^XTMP("DG531111P",$J,"IA",DGCNT)=DGDFN_U_DGREMORIG ;update was successful, store the DFN and original REMARKS
. ; If error occurred, record it in ^XTMP
. I $G(DGERR)'="" D
. . S DGERRCNT=DGERRCNT+1 ; bump count of errors
. . S ^XTMP("DG531111P",$J,"IA","ERRORS",DGERRCNT)=DGDFN_U_DGERR ;set DFN and error into XTMP
;
; job completed, perhaps with an error, capture stats and send mailman message
D NOW^%DTC S Y=% D DD^%DT
S DGDTE=Y
;
; Place job data into ^XTMP Global
S ^XTMP("DG531111P",$J,"DGSTART")=$G(DGDTS) ;job start date/time
S ^XTMP("DG531111P",$J,"DGEND")=$G(DGDTE) ;job end date/time
S ^XTMP("DG531111P",$J,"PATIENT RECORDS MODIFIED")=DGCNT ; total records affected
S ^XTMP("DG531111P",$J,"ERROR TOTAL")=DGERRCNT ; total error records
;
D MESSAGE
Q
;
MESSAGE ; Send MailMan Message when process completes
N XMSUB,XMDUZ,XMY,XMTEXT,DGMSG,DGLN
S XMY(DUZ)="",XMTEXT="DGMSG("
S XMDUZ=.5,XMSUB="DG*5.3*1111 PATIENT REMARKS DATA CLEANUP JOB RESULTS"
;
S DGMSG($I(DGLN))="The DG*5.3*1111 process has completed."
S DGMSG($I(DGLN))=""
I DGERRCNT D
. S DGMSG($I(DGLN))="!!!! WARNING !!!!"
. S DGMSG($I(DGLN))=" - Filing Errors encountered: "_DGERRCNT
. S DGMSG($I(DGLN))=" - Submit a YOUR IT Services ticket with the Enterprise Service Desk"
. S DGMSG($I(DGLN))=" for assistance with the errors. ***"
. S DGMSG($I(DGLN))=""
S DGMSG($I(DGLN))="This process ran through the PATIENT file (#2)"
S DGMSG($I(DGLN))="and for each patient record, if the REMARKS field (#.091) contained"
S DGMSG($I(DGLN))="the text **REJECTED** it was replaced with **DEFERRED**"
S DGMSG($I(DGLN))=""
S DGMSG($I(DGLN))="The process statistics:"
S DGMSG($I(DGLN))="Job Start Date/Time: "_$G(DGDTS)
S DGMSG($I(DGLN))=" Job End Date/Time: "_$G(DGDTE)
S DGMSG($I(DGLN))="Total records with REMARKS text replaced: "_DGCNT
S DGMSG($I(DGLN))="Errors encountered: "_DGERRCNT
S DGMSG($I(DGLN))=""
S DGMSG($I(DGLN))="If a list of records that had the REMARKS text replaced"
S DGMSG($I(DGLN))="is needed, you may view global ^XTMP(""DG531111P"","_$J_",""IA"""
S DGMSG($I(DGLN))=""
S DGMSG($I(DGLN))="NOTE: The global ^XTMP(""DG531111P"") will be purged after 60 days."
; Per the MailMan Developer Guide, the variable DIFROM should be NEW'd prior to making the call to ^XMD.
N DIFROM
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG531111P 7453 printed Sep 15, 2024@22:00:06 Page 2
DG531111P ;ALB/JAM - DG*5.3*1111 INSTALL UTILITY;07/12/2021 15:21pm
+1 ;;5.3;Registration;**1111**;Jan 26 2022;Build 18
+2 ;
QUIT ;No direct entry
+1 ;
+2 ;---------------------------------------------------------------------------
+3 ;Patch DG*5.3*1111: Environment, Pre-Install, and Post-Install entry points.
+4 ;---------------------------------------------------------------------------
+5 ;
+6 ; Reference to BMES^XPDUTL supported by ICR #10141
+7 ; Reference to MES^XPDUTL supported by ICR #10141
+8 ; Reference to $$PATCH^XPDUTL in ICR #10141
+9 ; Reference to ^XMD in ICR #10070
+10 ;
+11 ;
ENV ;Main entry point for Environment check
+1 QUIT
+2 ;
PRE ;Main entry point for Pre-Install items
+1 QUIT
+2 ;
POST ;Main entry point for Post-Install items
+1 ;
+2 DO BMES^XPDUTL(">>> Beginning the DG*5.3*1111 Post-install routine...")
+3 ; Check if the patch has previously run and ^XTMP exists, if so quit out POST
+4 IF $$PATCH^XPDUTL("DG*5.3*1111")
IF $DATA(^XTMP("DG531111P"))
Begin DoDot:1
+5 DO BMES^XPDUTL("Patch has been previously installed and ^XTMP(""DG531111P"" global")
+6 DO BMES^XPDUTL(" contains informational data from previous install.")
+7 DO BMES^XPDUTL(" The Post-install will not be run again.")
+8 DO BMES^XPDUTL(">>> Patch DG*5.3*1111 Post-install complete.")
End DoDot:1
QUIT
+9 DO POST1
+10 DO POST2
+11 DO BMES^XPDUTL(">>> Patch DG*5.3*1111 - Post-install complete.")
+12 QUIT
+13 ;
POST1 ; Rename any entries in ENROLLMENT STATUS file (#27.15) with REJECTED to DEFERRED
+1 DO BMES^XPDUTL(" - Rename all entries in the ENROLLMENT STATUS file (#27.15)")
+2 DO MES^XPDUTL(" with the name containing REJECTED to DEFERRED.")
+3 NEW DGOLDNAME,DGNAME,DGIEN,DGDATA,DGERR,DGOLD,DGNEW,DGCTR,DGERR
+4 SET DGIEN=0
+5 SET DGOLD="REJECTED"
+6 SET DGNEW="DEFERRED"
+7 FOR
SET DGIEN=$ORDER(^DGEN(27.15,DGIEN))
if 'DGIEN
QUIT
Begin DoDot:1
+8 SET DGNAME=$$GET1^DIQ(27.15,DGIEN,.01)
+9 ; No action needed if the name does not contain REJECTED
+10 if DGNAME'[DGOLD
QUIT
+11 SET DGOLDNAME=DGNAME
+12 ; Replace REJECTED with DEFERRED in the name
+13 FOR DGCTR=1:1:($LENGTH(DGNAME,$EXTRACT(DGOLD))-1)
IF $FIND(DGNAME,DGOLD)>0
SET $EXTRACT(DGNAME,$FIND(DGNAME,DGOLD)-$LENGTH(DGOLD),$FIND(DGNAME,DGOLD)-1)=DGNEW
+14 ; Set updated NAME back into the entry
+15 SET DGDATA(.01)=DGNAME
+16 IF $$UPD^DGENDBS(27.15,.DGIEN,.DGDATA,.DGERR)
Begin DoDot:2
+17 DO BMES^XPDUTL("Enrollment Status: ")
+18 DO MES^XPDUTL(DGOLDNAME)
+19 DO MES^XPDUTL("renamed to: ")
+20 DO MES^XPDUTL(DGNAME)
End DoDot:2
+21 IF $GET(DGERR)'=""
Begin DoDot:2
+22 DO BMES^XPDUTL("**** Error updating "_DGOLDNAME)
+23 DO MES^XPDUTL(">>> Error: "_DGERR)
+24 DO MES^XPDUTL(" - Submit a YOUR IT Services ticket with the Enterprise Service Desk")
+25 DO MES^XPDUTL(" for assistance.")
End DoDot:2
End DoDot:1
+26 DO BMES^XPDUTL(" - Rename of ENROLLMENT STATUS entries complete.")
+27 QUIT
+28 ;
POST2 ; Update the REMARKS field (#.091) in the PATIENT file (#2) to replace instances with
+1 ; the text **REJECTED** with **DEFERRED**
+2 ;
+3 DO BMES^XPDUTL(" - Queuing job to replace **REJECTED** with **DEFERRED** in the REMARKS")
+4 DO MES^XPDUTL(" field (#.091) of the PATIENT file (#2) from all Patient records.")
+5 DO BMES^XPDUTL(" All records in the PATIENT file (#2) will be scanned.")
+6 DO MES^XPDUTL(" If the REMARKS field (#.091) contains the text **REJECTED**")
+7 DO MES^XPDUTL(" it will be replaced with **DEFERRED**.")
+8 ;
+9 ;queue off job
+10 NEW ZTRTN,ZTDESC,ZTDTH,DGTEXT,ZTIO,ZTSK,DGTXT
+11 SET ZTRTN="QJOB^DG531111P"
+12 SET ZTDESC="DG*5.3*1111 Replace **REJECTED** with **DEFERRED** from the REMARKS (#.091) field in all Patient records."
+13 SET ZTDTH=$$NOW^XLFDT
+14 SET ZTIO=""
+15 DO ^%ZTLOAD
+16 IF $GET(ZTSK)'=""
Begin DoDot:1
+17 SET DGTEXT(1)=""
+18 SET DGTEXT(2)="Patient REMARKS data cleanup job queued."
+19 SET DGTEXT(3)="The task number is "_$GET(ZTSK)_"."
+20 SET DGTEXT(4)=""
+21 SET DGTEXT(5)="A Mailman Message containing job results will be sent to the installer."
End DoDot:1
+22 IF $GET(ZTSK)=""
Begin DoDot:1
+23 SET DGTEXT(1)=""
+24 SET DGTEXT(2)="*** Patient REMARKS data cleanup job FAILED TO QUEUE. ***"
+25 SET DGTEXT(3)=""
+26 SET DGTEXT(4)=" - Submit a YOUR IT Services ticket with the Enterprise Service Desk"
+27 SET DGTEXT(5)=" for assistance."
End DoDot:1
+28 DO BMES^XPDUTL(.DGTEXT)
+29 QUIT
+30 ;
QJOB ; Job Entry point
+1 ; Information from the job will be placed in ^XTMP (60 day expiration) and sent in a Mailman message
+2 KILL ^XTMP("DG531111P")
+3 SET ^XTMP("DG531111P",0)=$$FMADD^XLFDT(DT,60)_U_DT_U_"PATCH DG*5.3*1111 Patient REMARKS data cleanup job"
+4 ; Collect stats: start/end time and the number of records scanned and modified
+5 NEW %,DGDFN,DGCNT,DGERR,DGREM,DGREMORIG,DGDATA,DGDTS,DGDTE,Y,DGERRCNT,DGNEW,DGOLD,DGMAX,DGCTR
+6 DO NOW^%DTC
SET Y=%
DO DD^%DT
+7 SET DGDTS=Y
+8 ;
+9 SET (DGCNT,DGERRCNT,DGDFN)=0
+10 SET DGOLD="**REJECTED**"
+11 SET DGNEW="**DEFERRED**"
+12 ; loop patients
FOR
SET DGDFN=$ORDER(^DPT(DGDFN))
if 'DGDFN
QUIT
Begin DoDot:1
+13 ; Get REMARKS field data
+14 SET (DGREM,DGREMORIG)=$$GET1^DIQ(2,DGDFN,.091)
+15 IF DGREM'[DGOLD
QUIT
+16 SET DGMAX=$LENGTH(DGREM)
+17 ; Replace text in the DGREM string
+18 FOR DGCTR=1:1:($LENGTH(DGREM,$EXTRACT(DGOLD))-1)
IF $FIND(DGREM,DGOLD)>0
SET $EXTRACT(DGREM,$FIND(DGREM,DGOLD)-$LENGTH(DGOLD),$FIND(DGREM,DGOLD)-1)=DGNEW
+19 ; Set updated remarks back into patient record
+20 SET DGDATA(.091)=DGREM
+21 IF $$UPD^DGENDBS(2,.DGDFN,.DGDATA,.DGERR)
Begin DoDot:2
+22 ; bump count of patients we are updating
SET DGCNT=DGCNT+1
+23 ;update was successful, store the DFN and original REMARKS
SET ^XTMP("DG531111P",$JOB,"IA",DGCNT)=DGDFN_U_DGREMORIG
End DoDot:2
QUIT
+24 ; If error occurred, record it in ^XTMP
+25 IF $GET(DGERR)'=""
Begin DoDot:2
+26 ; bump count of errors
SET DGERRCNT=DGERRCNT+1
+27 ;set DFN and error into XTMP
SET ^XTMP("DG531111P",$JOB,"IA","ERRORS",DGERRCNT)=DGDFN_U_DGERR
End DoDot:2
End DoDot:1
+28 ;
+29 ; job completed, perhaps with an error, capture stats and send mailman message
+30 DO NOW^%DTC
SET Y=%
DO DD^%DT
+31 SET DGDTE=Y
+32 ;
+33 ; Place job data into ^XTMP Global
+34 ;job start date/time
SET ^XTMP("DG531111P",$JOB,"DGSTART")=$GET(DGDTS)
+35 ;job end date/time
SET ^XTMP("DG531111P",$JOB,"DGEND")=$GET(DGDTE)
+36 ; total records affected
SET ^XTMP("DG531111P",$JOB,"PATIENT RECORDS MODIFIED")=DGCNT
+37 ; total error records
SET ^XTMP("DG531111P",$JOB,"ERROR TOTAL")=DGERRCNT
+38 ;
+39 DO MESSAGE
+40 QUIT
+41 ;
MESSAGE ; Send MailMan Message when process completes
+1 NEW XMSUB,XMDUZ,XMY,XMTEXT,DGMSG,DGLN
+2 SET XMY(DUZ)=""
SET XMTEXT="DGMSG("
+3 SET XMDUZ=.5
SET XMSUB="DG*5.3*1111 PATIENT REMARKS DATA CLEANUP JOB RESULTS"
+4 ;
+5
*** ERROR ***
SET DGMSG($I(DGLN))="The DG*5.3*1111 process has completed."
+6
*** ERROR ***
SET DGMSG($I(DGLN))=""
+7 IF DGERRCNT
Begin DoDot:1
+8
*** ERROR ***
SET DGMSG($I(DGLN))="!!!! WARNING !!!!"
+9
*** ERROR ***
SET DGMSG($I(DGLN))=" - Filing Errors encountered: "_DGERRCNT
+10
*** ERROR ***
SET DGMSG($I(DGLN))=" - Submit a YOUR IT Services ticket with the Enterprise Service Desk"
+11
*** ERROR ***
SET DGMSG($I(DGLN))=" for assistance with the errors. ***"
+12
*** ERROR ***
SET DGMSG($I(DGLN))=""
End DoDot:1
+13
*** ERROR ***
SET DGMSG($I(DGLN))="This process ran through the PATIENT file (#2)"
+14
*** ERROR ***
SET DGMSG($I(DGLN))="and for each patient record, if the REMARKS field (#.091) contained"
+15
*** ERROR ***
SET DGMSG($I(DGLN))="the text **REJECTED** it was replaced with **DEFERRED**"
+16
*** ERROR ***
SET DGMSG($I(DGLN))=""
+17
*** ERROR ***
SET DGMSG($I(DGLN))="The process statistics:"
+18
*** ERROR ***
SET DGMSG($I(DGLN))="Job Start Date/Time: "_$GET(DGDTS)
+19
*** ERROR ***
SET DGMSG($I(DGLN))=" Job End Date/Time: "_$GET(DGDTE)
+20
*** ERROR ***
SET DGMSG($I(DGLN))="Total records with REMARKS text replaced: "_DGCNT
+21
*** ERROR ***
SET DGMSG($I(DGLN))="Errors encountered: "_DGERRCNT
+22
*** ERROR ***
SET DGMSG($I(DGLN))=""
+23
*** ERROR ***
SET DGMSG($I(DGLN))="If a list of records that had the REMARKS text replaced"
+24
*** ERROR ***
SET DGMSG($I(DGLN))="is needed, you may view global ^XTMP(""DG531111P"","_$JOB_",""IA"""
+25
*** ERROR ***
SET DGMSG($I(DGLN))=""
+26
*** ERROR ***
SET DGMSG($I(DGLN))="NOTE: The global ^XTMP(""DG531111P"") will be purged after 60 days."
+27 ; Per the MailMan Developer Guide, the variable DIFROM should be NEW'd prior to making the call to ^XMD.
+28 NEW DIFROM
+29 DO ^XMD
+30 QUIT
