LBR25P15 ;ADM/DBE - Library Package Decommission ;12/21/17
;;2.5;Library;**15**;Mar 11, 1996;Build 10
;
;The Library package is being retired. This routine will remove
;the Library 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 Library 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^LBR25P15",ZTDESC="Library Package File & Data Removal"
S ZTIO="",ZTDTH=$H
D ^%ZTLOAD
Q
;
BEGDEL ;background job entry point to remove all files and data
;
N DIU,LBRCNT,LBRNODE,LBRLOOP,LBRTXT,LBRFILE,LBRFLG,LBRSTART,LBREND,LBRSTR
S (LBRCNT,LBRFLG)=0,LBRSTART=$$FMTE^XLFDT($$NOW^XLFDT,1)
K ^TMP($J,"LBRP15")
F LBRLOOP=1:1 S LBRTXT=$P($T(MSGTXT+LBRLOOP),";;",2) Q:LBRTXT="QUIT" D LINE(LBRTXT) ;build beginning of mail message
S DIU(0)="DST" ;flags to delete data, subfile and templates
F LBRFILE=680:.1:680.9,681,681.1,682,682.1,686,686.11:.01:686.14 D ;loop through known library files
.S DIU=$$ROOT^DILFD(LBRFILE),LBRNODE=$$CREF^DILF(DIU) ;set diu=file root and lbrnode=closed file root
.I '$$VFILE^DILFD(LBRFILE) Q ;verify file exists
.D EN^DIU2 ;delete file and data in diu
.;check if DD and data is removed
.I '$D(@LBRNODE),'$$VFILE^DILFD(LBRFILE) D Q ;file successfully deleted
..S LBRSTR=DIU_" successfully removed" D LINE(LBRSTR) Q
.S LBRSTR=DIU_" was not successfully removed",LBRFLG=1 D LINE(LBRSTR) ;fall through if file not deleted
I LBRFLG D
.D LINE("")
.S LBRSTR="A file was not removed successfully. Please have your IRM re-run"
.S LBRSTR=LBRSTR_" the background job" D LINE(LBRSTR)
.S LBRSTR="by entering this command at the programmer's prompt" D LINE(LBRSTR)
.S LBRSTR=" D BEGDEL^LBR25P15"
D DIRCHK ;check if namespaced routines remain
D LINE("")
S LBRSTART="Start Time: "_LBRSTART D LINE(LBRSTART)
S LBREND=$$FMTE^XLFDT($$NOW^XLFDT,1)
S LBREND="End Time: "_LBREND D LINE(LBREND)
D MAIL ;send mail message
K ^TMP($J,"LBRP15")
Q
;
MSGTXT ;message into
;; The Library package is being retired and all data and data dictionary
;; 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 LBRCNT=LBRCNT+1,^TMP($J,"LBRP15",LBRCNT)=TEXT
Q
;
DIRCHK ;checks ^ROUTINE global for files beginning with LBR that were not removed
;
N X,LBRFND,LBRSTR
S LBRFND=1
S X="LBQ~" F S X=$O(^ROUTINE(X)) Q:(X="")!($E(X,1,3)'="LBR") D
.I X="LBR25P15" Q
.I LBRFND D
..D LINE("")
..S LBRSTR="The following routines beginning with LBR were found in the directory." D LINE(LBRSTR)
..S LBRSTR="They were not removed with patch LBR*2.5*15 installation. You will need to" D LINE(LBRSTR)
..S LBRSTR="review these routines and delete them if necessary." D LINE(LBRSTR)
.D LINE(X) S LBRFND=0
Q
;
MAIL ;send message
;
N XMDUZ,XMY,XMTEXT,XMSUB
S XMY(DUZ)="",XMDUZ=.5
S XMSUB="Library Package Data & Data Dictionary Removal"
S XMTEXT="^TMP($J,""LBRP15"","
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLBR25P15 3230 printed Apr 09, 2024@21:12:16 Page 2
LBR25P15 ;ADM/DBE - Library Package Decommission ;12/21/17
+1 ;;2.5;Library;**15**;Mar 11, 1996;Build 10
+2 ;
+3 ;The Library package is being retired. This routine will remove
+4 ;the Library 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 Library 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^LBR25P15"
SET ZTDESC="Library 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,LBRCNT,LBRNODE,LBRLOOP,LBRTXT,LBRFILE,LBRFLG,LBRSTART,LBREND,LBRSTR
+3 SET (LBRCNT,LBRFLG)=0
SET LBRSTART=$$FMTE^XLFDT($$NOW^XLFDT,1)
+4 KILL ^TMP($JOB,"LBRP15")
+5 ;build beginning of mail message
FOR LBRLOOP=1:1
SET LBRTXT=$PIECE($TEXT(MSGTXT+LBRLOOP),";;",2)
if LBRTXT="QUIT"
QUIT
DO LINE(LBRTXT)
+6 ;flags to delete data, subfile and templates
SET DIU(0)="DST"
+7 ;loop through known library files
FOR LBRFILE=680:.1:680.9,681,681.1,682,682.1,686,686.11:.01:686.14
Begin DoDot:1
+8 ;set diu=file root and lbrnode=closed file root
SET DIU=$$ROOT^DILFD(LBRFILE)
SET LBRNODE=$$CREF^DILF(DIU)
+9 ;verify file exists
IF '$$VFILE^DILFD(LBRFILE)
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(@LBRNODE)
IF '$$VFILE^DILFD(LBRFILE)
Begin DoDot:2
+13 SET LBRSTR=DIU_" successfully removed"
DO LINE(LBRSTR)
QUIT
End DoDot:2
QUIT
+14 ;fall through if file not deleted
SET LBRSTR=DIU_" was not successfully removed"
SET LBRFLG=1
DO LINE(LBRSTR)
End DoDot:1
+15 IF LBRFLG
Begin DoDot:1
+16 DO LINE("")
+17 SET LBRSTR="A file was not removed successfully. Please have your IRM re-run"
+18 SET LBRSTR=LBRSTR_" the background job"
DO LINE(LBRSTR)
+19 SET LBRSTR="by entering this command at the programmer's prompt"
DO LINE(LBRSTR)
+20 SET LBRSTR=" D BEGDEL^LBR25P15"
End DoDot:1
+21 ;check if namespaced routines remain
DO DIRCHK
+22 DO LINE("")
+23 SET LBRSTART="Start Time: "_LBRSTART
DO LINE(LBRSTART)
+24 SET LBREND=$$FMTE^XLFDT($$NOW^XLFDT,1)
+25 SET LBREND="End Time: "_LBREND
DO LINE(LBREND)
+26 ;send mail message
DO MAIL
+27 KILL ^TMP($JOB,"LBRP15")
+28 QUIT
+29 ;
MSGTXT ;message into
+1 ;; The Library package is being retired and all data and data dictionary
+2 ;; will be removed from the system. This message shows a list of
+3 ;; files that were removed.
+4 ;;
+5 ;;QUIT
+6 QUIT
LINE(TEXT) ;add line to tmp global stored for mail message
+1 ;
+2 SET LBRCNT=LBRCNT+1
SET ^TMP($JOB,"LBRP15",LBRCNT)=TEXT
+3 QUIT
+4 ;
DIRCHK ;checks ^ROUTINE global for files beginning with LBR that were not removed
+1 ;
+2 NEW X,LBRFND,LBRSTR
+3 SET LBRFND=1
+4 SET X="LBQ~"
FOR
SET X=$ORDER(^ROUTINE(X))
if (X="")!($EXTRACT(X,1,3)'="LBR")
QUIT
Begin DoDot:1
+5 IF X="LBR25P15"
QUIT
+6 IF LBRFND
Begin DoDot:2
+7 DO LINE("")
+8 SET LBRSTR="The following routines beginning with LBR were found in the directory."
DO LINE(LBRSTR)
+9 SET LBRSTR="They were not removed with patch LBR*2.5*15 installation. You will need to"
DO LINE(LBRSTR)
+10 SET LBRSTR="review these routines and delete them if necessary."
DO LINE(LBRSTR)
End DoDot:2
+11 DO LINE(X)
SET LBRFND=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="Library Package Data & Data Dictionary Removal"
+5 SET XMTEXT="^TMP($J,""LBRP15"","
+6 DO ^XMD
+7 QUIT
