QAC2P25 ;ADM/TXH - Patient Representative Package Decommission ;Aug 05, 2021@12:14
;;2.0;Patient Representative;**25**;Jul 25, 1995;Build 4
;
; The Patient Representative package is being retired.
; This routine will remove the Patient Representative files and data.
;
; References to %ZTLOAD supported by ICR# 10063
; References to $$CREF^DILF supported by ICR# 2054
; References to $$ROOT^DILFD supported by ICR# 2055
; References to $$VFILE^DILFD supported by ICR# 2055
; References to EN^DIU2 supported by ICR# 10014
; References to $$FMTE^XLFDT supported by ICR #10103
; References to $$NOW^XLFDT supported by ICR #10103
; References to ^XMD supported by ICR # 10070
; References to BMES^XPDUTL supported by ICR# 10141
; References to MES^XPDUTL supported by ICR# 10141
;
Q
;
TASK ;task the file deletion
;
N ZTRTN,ZTDESC,ZTIO,ZTDTH
D BMES^XPDUTL("* A background job will be tasked to delete all Patient ")
D MES^XPDUTL(" Representative files and data.")
D BMES^XPDUTL("* A Mailman message will be generated and sent to the ")
D MES^XPDUTL(" installer when the job is completed.")
D MES^XPDUTL(" ")
S ZTRTN="BEGDEL^QAC2P25"
S ZTDESC="Patient Representative Package File & Data Removal"
S ZTIO="",ZTDTH=$H
D ^%ZTLOAD
Q
;
BEGDEL ;background job entry point to remove all files and data
;
N DIU,QACCNT,QACNODE,QACLOOP,QACTXT,QACFILE,QACFLG,QACSTART
N QACEND,QACSTR
S (QACCNT,QACFLG)=0,QACSTART=$$FMTE^XLFDT($$NOW^XLFDT,1)
K ^TMP($J,"QACP25")
; build beginning of mail message
F QACLOOP=1:1 S QACTXT=$P($T(MSGTXT+QACLOOP),";;",2) Q:QACTXT="QUIT" D LINE(QACTXT)
; flags to delete data, subfile and templates
S DIU(0)="DST"
; loop through known Patient Representative files
F QACFILE=745.1,745.2,745.3,745.4,745.5,745.55,745.6 D
. ; set DIU=file root and QACNODE=closed file root
. S DIU=$$ROOT^DILFD(QACFILE),QACNODE=$$CREF^DILF(DIU)
. ; verify file exists
. I '$$VFILE^DILFD(QACFILE) Q
. ; delete file and data in DIU
. D EN^DIU2
. ; check if DD and data is removed
. ; file successfully deleted
. I '$D(@QACNODE),'$$VFILE^DILFD(QACFILE) D Q
. . S QACSTR=DIU_" successfully removed" D LINE(QACSTR) Q
. ; fall through if file not deleted
. S QACSTR=DIU_" was not successfully removed",QACFLG=1 D LINE(QACSTR)
;
I QACFLG D
. D LINE("")
. S QACSTR="A file was not removed successfully. Please have your"
. S QACSTR=QACSTR_" installer re-run the background job"
. D LINE(QACSTR)
. S QACSTR="by entering this command at the programmer's prompt"
. D LINE(QACSTR)
. S QACSTR=" D BEGDEL^QAC2P25"
;
; check if namespaced routines remain
D DIRCHK
D LINE("")
S QACSTART="Start Time: "_QACSTART D LINE(QACSTART)
S QACEND=$$FMTE^XLFDT($$NOW^XLFDT,1)
S QACEND="End Time: "_QACEND D LINE(QACEND)
; send mail message
D MAIL
K ^TMP($J,"QACP25")
Q
;
MSGTXT ;message into
;; The Patient Representative package is being retired and all data
;; and data dictionary entries will be removed from the system.
;; This message shows a list of files that were removed.
;;
;;QUIT
Q
;
LINE(TEXT) ;add line to tmp global stored for mail message
;
S QACCNT=QACCNT+1,^TMP($J,"QACP25",QACCNT)=TEXT
Q
;
DIRCHK ;checks ^ROUTINE global for files beginning with QAC that
; were not removed
;
N X,QACFND,QACSTR
S QACFND=1
S X="QAB~" F S X=$O(^ROUTINE(X)) Q:(X="")!($E(X,1,3)'="QAC") D
. I X="QAC2P25" Q
. I QACFND D ;only print header message once
. . D LINE("")
. . S QACSTR="The following routines beginning with QAC were found "
. . S QACSTR=QACSTR_"in the directory."
. . D LINE(QACSTR)
. . S QACSTR="They were not removed with patch QAC*2.0*25 installation. "
. . S QACSTR=QACSTR_"You will need to"
. . D LINE(QACSTR)
. . S QACSTR="review these routines and delete them if necessary."
. . D LINE(QACSTR)
. D LINE(X) S QACFND=0 ;turn off header message print
Q
;
MAIL ;send message
;
N XMDUZ,XMY,XMTEXT,XMSUB,DIFROM
S XMY(DUZ)="",XMDUZ=.5
S XMSUB="Patient Representative Package Data & Data Dictionary Removal"
S XMTEXT="^TMP($J,""QACP25"","
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAC2P25 4166 printed Oct 16, 2024@18:26:04 Page 2
QAC2P25 ;ADM/TXH - Patient Representative Package Decommission ;Aug 05, 2021@12:14
+1 ;;2.0;Patient Representative;**25**;Jul 25, 1995;Build 4
+2 ;
+3 ; The Patient Representative package is being retired.
+4 ; This routine will remove the Patient Representative files and data.
+5 ;
+6 ; References to %ZTLOAD supported by ICR# 10063
+7 ; References to $$CREF^DILF supported by ICR# 2054
+8 ; References to $$ROOT^DILFD supported by ICR# 2055
+9 ; References to $$VFILE^DILFD supported by ICR# 2055
+10 ; References to EN^DIU2 supported by ICR# 10014
+11 ; References to $$FMTE^XLFDT supported by ICR #10103
+12 ; References to $$NOW^XLFDT supported by ICR #10103
+13 ; References to ^XMD supported by ICR # 10070
+14 ; References to BMES^XPDUTL supported by ICR# 10141
+15 ; References to MES^XPDUTL supported by ICR# 10141
+16 ;
+17 QUIT
+18 ;
TASK ;task the file deletion
+1 ;
+2 NEW ZTRTN,ZTDESC,ZTIO,ZTDTH
+3 DO BMES^XPDUTL("* A background job will be tasked to delete all Patient ")
+4 DO MES^XPDUTL(" Representative files and data.")
+5 DO BMES^XPDUTL("* A Mailman message will be generated and sent to the ")
+6 DO MES^XPDUTL(" installer when the job is completed.")
+7 DO MES^XPDUTL(" ")
+8 SET ZTRTN="BEGDEL^QAC2P25"
+9 SET ZTDESC="Patient Representative Package File & Data Removal"
+10 SET ZTIO=""
SET ZTDTH=$HOROLOG
+11 DO ^%ZTLOAD
+12 QUIT
+13 ;
BEGDEL ;background job entry point to remove all files and data
+1 ;
+2 NEW DIU,QACCNT,QACNODE,QACLOOP,QACTXT,QACFILE,QACFLG,QACSTART
+3 NEW QACEND,QACSTR
+4 SET (QACCNT,QACFLG)=0
SET QACSTART=$$FMTE^XLFDT($$NOW^XLFDT,1)
+5 KILL ^TMP($JOB,"QACP25")
+6 ; build beginning of mail message
+7 FOR QACLOOP=1:1
SET QACTXT=$PIECE($TEXT(MSGTXT+QACLOOP),";;",2)
if QACTXT="QUIT"
QUIT
DO LINE(QACTXT)
+8 ; flags to delete data, subfile and templates
+9 SET DIU(0)="DST"
+10 ; loop through known Patient Representative files
+11 FOR QACFILE=745.1,745.2,745.3,745.4,745.5,745.55,745.6
Begin DoDot:1
+12 ; set DIU=file root and QACNODE=closed file root
+13 SET DIU=$$ROOT^DILFD(QACFILE)
SET QACNODE=$$CREF^DILF(DIU)
+14 ; verify file exists
+15 IF '$$VFILE^DILFD(QACFILE)
QUIT
+16 ; delete file and data in DIU
+17 DO EN^DIU2
+18 ; check if DD and data is removed
+19 ; file successfully deleted
+20 IF '$DATA(@QACNODE)
IF '$$VFILE^DILFD(QACFILE)
Begin DoDot:2
+21 SET QACSTR=DIU_" successfully removed"
DO LINE(QACSTR)
QUIT
End DoDot:2
QUIT
+22 ; fall through if file not deleted
+23 SET QACSTR=DIU_" was not successfully removed"
SET QACFLG=1
DO LINE(QACSTR)
End DoDot:1
+24 ;
+25 IF QACFLG
Begin DoDot:1
+26 DO LINE("")
+27 SET QACSTR="A file was not removed successfully. Please have your"
+28 SET QACSTR=QACSTR_" installer re-run the background job"
+29 DO LINE(QACSTR)
+30 SET QACSTR="by entering this command at the programmer's prompt"
+31 DO LINE(QACSTR)
+32 SET QACSTR=" D BEGDEL^QAC2P25"
End DoDot:1
+33 ;
+34 ; check if namespaced routines remain
+35 DO DIRCHK
+36 DO LINE("")
+37 SET QACSTART="Start Time: "_QACSTART
DO LINE(QACSTART)
+38 SET QACEND=$$FMTE^XLFDT($$NOW^XLFDT,1)
+39 SET QACEND="End Time: "_QACEND
DO LINE(QACEND)
+40 ; send mail message
+41 DO MAIL
+42 KILL ^TMP($JOB,"QACP25")
+43 QUIT
+44 ;
MSGTXT ;message into
+1 ;; The Patient Representative package is being retired and all data
+2 ;; and data dictionary entries will be removed from the system.
+3 ;; This message shows a list of files that were removed.
+4 ;;
+5 ;;QUIT
+6 QUIT
+7 ;
LINE(TEXT) ;add line to tmp global stored for mail message
+1 ;
+2 SET QACCNT=QACCNT+1
SET ^TMP($JOB,"QACP25",QACCNT)=TEXT
+3 QUIT
+4 ;
DIRCHK ;checks ^ROUTINE global for files beginning with QAC that
+1 ; were not removed
+2 ;
+3 NEW X,QACFND,QACSTR
+4 SET QACFND=1
+5 SET X="QAB~"
FOR
SET X=$ORDER(^ROUTINE(X))
if (X="")!($EXTRACT(X,1,3)'="QAC")
QUIT
Begin DoDot:1
+6 IF X="QAC2P25"
QUIT
+7 ;only print header message once
IF QACFND
Begin DoDot:2
+8 DO LINE("")
+9 SET QACSTR="The following routines beginning with QAC were found "
+10 SET QACSTR=QACSTR_"in the directory."
+11 DO LINE(QACSTR)
+12 SET QACSTR="They were not removed with patch QAC*2.0*25 installation. "
+13 SET QACSTR=QACSTR_"You will need to"
+14 DO LINE(QACSTR)
+15 SET QACSTR="review these routines and delete them if necessary."
+16 DO LINE(QACSTR)
End DoDot:2
+17 ;turn off header message print
DO LINE(X)
SET QACFND=0
End DoDot:1
+18 QUIT
+19 ;
MAIL ;send message
+1 ;
+2 NEW XMDUZ,XMY,XMTEXT,XMSUB,DIFROM
+3 SET XMY(DUZ)=""
SET XMDUZ=.5
+4 SET XMSUB="Patient Representative Package Data & Data Dictionary Removal"
+5 SET XMTEXT="^TMP($J,""QACP25"","
+6 DO ^XMD
+7 QUIT
