QAN2P35 ;ALB/MJB - Incident Reporting Package Decommission ;07/02/2024
;;2.0;Incident Reporting ;**35**; JUL 13, 1995;Build 5
;
; The Incident Reporting package is being retired.
; This routine will remove the Incident Reporting files and data.
;
Q
;
TASK ;task the file deletion
;
N ZTRTN,ZTDESC,ZTIO,ZTDTH
D MES^XPDUTL(" ")
D MES^XPDUTL("A background job will be tasked to delete all Incident Reporting files and data.")
D MES^XPDUTL("A Mailman message will be generated and sent to the installer when the job")
D MES^XPDUTL("is completed.")
S ZTRTN="BEGDEL^QAN2P35",ZTDESC="Incident Reporting Package File & Data Removal"
S ZTIO="",ZTDTH=$H
D ^%ZTLOAD
Q
;
BEGDEL ;background job entry point to remove all files and data
;
N DIU,QANCNT,QANNODE,QANLOOP,QANTXT,QANFILE,QANFLG,QANSTART,QANEND,QANSTR
S (QANCNT,QANFLG)=0,QANSTART=$$FMTE^XLFDT($$NOW^XLFDT,1)
K ^TMP($J,"QANP35")
F QANLOOP=1:1 S QANTXT=$P($T(MSGTXT+QANLOOP),";;",2) Q:QANTXT="QUIT" D LINE(QANTXT)
;build beginning of mail message
S DIU(0)="DST" ;flags to delete data, subfile and templates
F QANFILE=742,742.1,742.13,742.14,742.4,742.5,742.6 D
.;loop through known Incident Reporting files
.S DIU=$$ROOT^DILFD(QANFILE),QANNODE=$$CREF^DILF(DIU)
.;set diu=file root and QANnode=closed file root
.I '$$VFILE^DILFD(QANFILE) Q ;verify file exists
.;delete file and data in diu
.D EN^DIU2
.;check if DD and data is removed
.I '$D(@QANNODE),'$$VFILE^DILFD(QANFILE) D Q ;file successfully deleted
..S QANSTR=DIU_" successfully removed" D LINE(QANSTR) Q
.S QANSTR=DIU_" was not successfully removed",QANFLG=1 D LINE(QANSTR) ;fall through if file not deleted
I QANFLG D
.D LINE("")
.S QANSTR="A file was not removed successfully. Please have your IRM re-run"
.S QANSTR=QANSTR_" the background job" D LINE(QANSTR)
.S QANSTR="by entering this command at the programmer's prompt" D LINE(QANSTR)
.S QANSTR=" D BEGDEL^QAN2P35"
D LINE("")
S QANSTART="Start Time: "_QANSTART D LINE(QANSTART)
S QANEND=$$FMTE^XLFDT($$NOW^XLFDT,1)
S QANEND="End Time: "_QANEND D LINE(QANEND)
D MAIL ;send mail message
K ^TMP($J,"QANP35")
Q
;
MSGTXT ;message into
;; The Social Work 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 QANCNT=QANCNT+1,^TMP($J,"QANP35",QANCNT)=TEXT
Q
;
MAIL ;send message
;
N XMDUZ,XMY,XMTEXT,XMSUB
S XMY(DUZ)="",XMDUZ=.5
S XMSUB="Incident Reporting Package Data & Data Dictionary Removal"
S XMTEXT="^TMP($J,""QANP35"","
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAN2P35 2724 printed Sep 23, 2025@19:35:37 Page 2
QAN2P35 ;ALB/MJB - Incident Reporting Package Decommission ;07/02/2024
+1 ;;2.0;Incident Reporting ;**35**; JUL 13, 1995;Build 5
+2 ;
+3 ; The Incident Reporting package is being retired.
+4 ; This routine will remove the Incident Reporting files and data.
+5 ;
+6 QUIT
+7 ;
TASK ;task the file deletion
+1 ;
+2 NEW ZTRTN,ZTDESC,ZTIO,ZTDTH
+3 DO MES^XPDUTL(" ")
+4 DO MES^XPDUTL("A background job will be tasked to delete all Incident Reporting files and data.")
+5 DO MES^XPDUTL("A Mailman message will be generated and sent to the installer when the job")
+6 DO MES^XPDUTL("is completed.")
+7 SET ZTRTN="BEGDEL^QAN2P35"
SET ZTDESC="Incident Reporting Package File & Data Removal"
+8 SET ZTIO=""
SET ZTDTH=$HOROLOG
+9 DO ^%ZTLOAD
+10 QUIT
+11 ;
BEGDEL ;background job entry point to remove all files and data
+1 ;
+2 NEW DIU,QANCNT,QANNODE,QANLOOP,QANTXT,QANFILE,QANFLG,QANSTART,QANEND,QANSTR
+3 SET (QANCNT,QANFLG)=0
SET QANSTART=$$FMTE^XLFDT($$NOW^XLFDT,1)
+4 KILL ^TMP($JOB,"QANP35")
+5 FOR QANLOOP=1:1
SET QANTXT=$PIECE($TEXT(MSGTXT+QANLOOP),";;",2)
if QANTXT="QUIT"
QUIT
DO LINE(QANTXT)
+6 ;build beginning of mail message
+7 ;flags to delete data, subfile and templates
SET DIU(0)="DST"
+8 FOR QANFILE=742,742.1,742.13,742.14,742.4,742.5,742.6
Begin DoDot:1
+9 ;loop through known Incident Reporting files
+10 SET DIU=$$ROOT^DILFD(QANFILE)
SET QANNODE=$$CREF^DILF(DIU)
+11 ;set diu=file root and QANnode=closed file root
+12 ;verify file exists
IF '$$VFILE^DILFD(QANFILE)
QUIT
+13 ;delete file and data in diu
+14 DO EN^DIU2
+15 ;check if DD and data is removed
+16 ;file successfully deleted
IF '$DATA(@QANNODE)
IF '$$VFILE^DILFD(QANFILE)
Begin DoDot:2
+17 SET QANSTR=DIU_" successfully removed"
DO LINE(QANSTR)
QUIT
End DoDot:2
QUIT
+18 ;fall through if file not deleted
SET QANSTR=DIU_" was not successfully removed"
SET QANFLG=1
DO LINE(QANSTR)
End DoDot:1
+19 IF QANFLG
Begin DoDot:1
+20 DO LINE("")
+21 SET QANSTR="A file was not removed successfully. Please have your IRM re-run"
+22 SET QANSTR=QANSTR_" the background job"
DO LINE(QANSTR)
+23 SET QANSTR="by entering this command at the programmer's prompt"
DO LINE(QANSTR)
+24 SET QANSTR=" D BEGDEL^QAN2P35"
End DoDot:1
+25 DO LINE("")
+26 SET QANSTART="Start Time: "_QANSTART
DO LINE(QANSTART)
+27 SET QANEND=$$FMTE^XLFDT($$NOW^XLFDT,1)
+28 SET QANEND="End Time: "_QANEND
DO LINE(QANEND)
+29 ;send mail message
DO MAIL
+30 KILL ^TMP($JOB,"QANP35")
+31 QUIT
+32 ;
MSGTXT ;message into
+1 ;; The Social Work package is being retired and all data and data
+2 ;; dictionary entries will be removed from the system. This
+3 ;; message shows a list of files that were removed.
+4 ;;
+5 ;;QUIT
+6 QUIT
LINE(TEXT) ;add line to tmp global stored for mail message
+1 ;
+2 SET QANCNT=QANCNT+1
SET ^TMP($JOB,"QANP35",QANCNT)=TEXT
+3 QUIT
+4 ;
MAIL ;send message
+1 ;
+2 NEW XMDUZ,XMY,XMTEXT,XMSUB
+3 SET XMY(DUZ)=""
SET XMDUZ=.5
+4 SET XMSUB="Incident Reporting Package Data & Data Dictionary Removal"
+5 SET XMTEXT="^TMP($J,""QANP35"","
+6 DO ^XMD
+7 QUIT
