SOW3P65 ;ADM/DBE - Social Work Package Decommission ;5/9/19
;;3.0;Social Work;**65**;27 Apr 93;Build 2
;
;The Social Work package is being retired. This routine will remove
;the Social Work 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 Social Work 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^SOW3P65",ZTDESC="Social Work Package File & Data Removal"
S ZTIO="",ZTDTH=$H
D ^%ZTLOAD
Q
;
BEGDEL ;background job entry point to remove all files and data
;
N DIU,SOWCNT,SOWNODE,SOWLOOP,SOWTXT,SOWFILE,SOWFLG,SOWSTART,SOWEND,SOWSTR
S (SOWCNT,SOWFLG)=0,SOWSTART=$$FMTE^XLFDT($$NOW^XLFDT,1)
K ^TMP($J,"SOWP65")
F SOWLOOP=1:1 S SOWTXT=$P($T(MSGTXT+SOWLOOP),";;",2) Q:SOWTXT="QUIT" D LINE(SOWTXT) ;build beginning of mail message
S DIU(0)="DST" ;flags to delete data, subfile and templates
F SOWFILE=650,650.1,651:1:653,655,655.2:.001:655.203,656 D ;loop through known social work files
.S DIU=$$ROOT^DILFD(SOWFILE),SOWNODE=$$CREF^DILF(DIU) ;set diu=file root and sownode=closed file root
.I '$$VFILE^DILFD(SOWFILE) Q ;verify file exists
.D EN^DIU2 ;delete file and data in diu
.;check if DD and data is removed
.I '$D(@SOWNODE),'$$VFILE^DILFD(SOWFILE) D Q ;file successfully deleted
..S SOWSTR=DIU_" successfully removed" D LINE(SOWSTR) Q
.S SOWSTR=DIU_" was not successfully removed",SOWFLG=1 D LINE(SOWSTR) ;fall through if file not deleted
I SOWFLG D
.D LINE("")
.S SOWSTR="A file was not removed successfully. Please have your IRM re-run"
.S SOWSTR=SOWSTR_" the background job" D LINE(SOWSTR)
.S SOWSTR="by entering this command at the programmer's prompt" D LINE(SOWSTR)
.S SOWSTR=" D BEGDEL^SOW3P65"
D DIRCHK ;check if namespaced routines remain
D LINE("")
S SOWSTART="Start Time: "_SOWSTART D LINE(SOWSTART)
S SOWEND=$$FMTE^XLFDT($$NOW^XLFDT,1)
S SOWEND="End Time: "_SOWEND D LINE(SOWEND)
D MAIL ;send mail message
K ^TMP($J,"SOWP65")
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 SOWCNT=SOWCNT+1,^TMP($J,"SOWP65",SOWCNT)=TEXT
Q
;
DIRCHK ;checks ^ROUTINE global for files beginning with SOW that were not removed
;
N X,SOWFND,SOWSTR
S SOWFND=1
S X="SOV~" F S X=$O(^ROUTINE(X)) Q:(X="")!($E(X,1,3)'="SOW") D
.I X="SOW3P65" Q
.I SOWFND D ;only print header message once
..D LINE("")
..S SOWSTR="The following routines beginning with SOW were found in the directory." D LINE(SOWSTR)
..S SOWSTR="They were not removed with patch SOW*3.0*65 installation. You will need to" D LINE(SOWSTR)
..S SOWSTR="review these routines and delete them if necessary." D LINE(SOWSTR)
.D LINE(X) S SOWFND=0 ;turn off header message print
Q
;
MAIL ;send message
;
N XMDUZ,XMY,XMTEXT,XMSUB
S XMY(DUZ)="",XMDUZ=.5
S XMSUB="Social Work Package Data & Data Dictionary Removal"
S XMTEXT="^TMP($J,""SOWP65"","
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSOW3P65 3318 printed Dec 13, 2024@02:37:41 Page 2
SOW3P65 ;ADM/DBE - Social Work Package Decommission ;5/9/19
+1 ;;3.0;Social Work;**65**;27 Apr 93;Build 2
+2 ;
+3 ;The Social Work package is being retired. This routine will remove
+4 ;the Social Work 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 Social Work 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^SOW3P65"
SET ZTDESC="Social Work 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,SOWCNT,SOWNODE,SOWLOOP,SOWTXT,SOWFILE,SOWFLG,SOWSTART,SOWEND,SOWSTR
+3 SET (SOWCNT,SOWFLG)=0
SET SOWSTART=$$FMTE^XLFDT($$NOW^XLFDT,1)
+4 KILL ^TMP($JOB,"SOWP65")
+5 ;build beginning of mail message
FOR SOWLOOP=1:1
SET SOWTXT=$PIECE($TEXT(MSGTXT+SOWLOOP),";;",2)
if SOWTXT="QUIT"
QUIT
DO LINE(SOWTXT)
+6 ;flags to delete data, subfile and templates
SET DIU(0)="DST"
+7 ;loop through known social work files
FOR SOWFILE=650,650.1,651:1:653,655,655.2:.001:655.203,656
Begin DoDot:1
+8 ;set diu=file root and sownode=closed file root
SET DIU=$$ROOT^DILFD(SOWFILE)
SET SOWNODE=$$CREF^DILF(DIU)
+9 ;verify file exists
IF '$$VFILE^DILFD(SOWFILE)
QUIT
+10 ;delete file and data in diu
DO EN^DIU2
+11 ;check if DD and data is removed
+12 ;file successfully deleted
IF '$DATA(@SOWNODE)
IF '$$VFILE^DILFD(SOWFILE)
Begin DoDot:2
+13 SET SOWSTR=DIU_" successfully removed"
DO LINE(SOWSTR)
QUIT
End DoDot:2
QUIT
+14 ;fall through if file not deleted
SET SOWSTR=DIU_" was not successfully removed"
SET SOWFLG=1
DO LINE(SOWSTR)
End DoDot:1
+15 IF SOWFLG
Begin DoDot:1
+16 DO LINE("")
+17 SET SOWSTR="A file was not removed successfully. Please have your IRM re-run"
+18 SET SOWSTR=SOWSTR_" the background job"
DO LINE(SOWSTR)
+19 SET SOWSTR="by entering this command at the programmer's prompt"
DO LINE(SOWSTR)
+20 SET SOWSTR=" D BEGDEL^SOW3P65"
End DoDot:1
+21 ;check if namespaced routines remain
DO DIRCHK
+22 DO LINE("")
+23 SET SOWSTART="Start Time: "_SOWSTART
DO LINE(SOWSTART)
+24 SET SOWEND=$$FMTE^XLFDT($$NOW^XLFDT,1)
+25 SET SOWEND="End Time: "_SOWEND
DO LINE(SOWEND)
+26 ;send mail message
DO MAIL
+27 KILL ^TMP($JOB,"SOWP65")
+28 QUIT
+29 ;
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 SOWCNT=SOWCNT+1
SET ^TMP($JOB,"SOWP65",SOWCNT)=TEXT
+3 QUIT
+4 ;
DIRCHK ;checks ^ROUTINE global for files beginning with SOW that were not removed
+1 ;
+2 NEW X,SOWFND,SOWSTR
+3 SET SOWFND=1
+4 SET X="SOV~"
FOR
SET X=$ORDER(^ROUTINE(X))
if (X="")!($EXTRACT(X,1,3)'="SOW")
QUIT
Begin DoDot:1
+5 IF X="SOW3P65"
QUIT
+6 ;only print header message once
IF SOWFND
Begin DoDot:2
+7 DO LINE("")
+8 SET SOWSTR="The following routines beginning with SOW were found in the directory."
DO LINE(SOWSTR)
+9 SET SOWSTR="They were not removed with patch SOW*3.0*65 installation. You will need to"
DO LINE(SOWSTR)
+10 SET SOWSTR="review these routines and delete them if necessary."
DO LINE(SOWSTR)
End DoDot:2
+11 ;turn off header message print
DO LINE(X)
SET SOWFND=0
End DoDot:1
+12 QUIT
+13 ;
MAIL ;send message
+1 ;
+2 NEW XMDUZ,XMY,XMTEXT,XMSUB
+3 SET XMY(DUZ)=""
SET XMDUZ=.5
+4 SET XMSUB="Social Work Package Data & Data Dictionary Removal"
+5 SET XMTEXT="^TMP($J,""SOWP65"","
+6 DO ^XMD
+7 QUIT
