QAN2P35.m

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 ---QAN2P35   2724     printed  Apr 23, 2025@18:13:56                                                                                                                                                                                                     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