ABSV4P45 ;LKG/OI&T - VOLUNTARY TIMEKEEPING PKG DECOMMISSIONING ;12/10/20 10:35
V ;;4.0;VOLUNTARY TIMEKEEPING;**45**;JULY 6, 1994;Build 12
;Per VA Directive 6402, this routine should not be modified.
;
;The Voluntary Timekeeping package is being retired. This routine will
;remove the Voluntary Timekeeping files and data
;
;
TASK ;task the file deletion
;
N ZTRTN,ZTDESC,ZTIO,ZTDTH
D MES^XPDUTL(" ")
D MES^XPDUTL("A background job will be tasked to delete Voluntary Timekeeping")
D MES^XPDUTL("files and data...")
D MES^XPDUTL("A Mailman message will be generated and sent to the installer when")
D MES^XPDUTL("the job is completed.")
S ZTRTN="BEGDEL^ABSV4P45",ZTDESC="Voluntary Timekeeping Pkg File & Data Removal"
S ZTIO="",ZTDTH=$H
D ^%ZTLOAD
Q
;
BEGDEL ;background job entry point to remove all files and data
;
N DIU,ABSVCNT,ABSVNODE,ABSVLOOP,ABSVTXT,ABSVFILE,ABSVFLG,ABSVSTART,ABSVEND,ABSVSTR
S (ABSVCNT,ABSVFLG)=0,ABSVSTART=$$FMTE^XLFDT($$NOW^XLFDT,1)
K ^TMP($J,"ABSV4P45")
F ABSVLOOP=1:1 S ABSVTXT=$P($T(MSGTXT+ABSVLOOP),";;",2) Q:ABSVTXT="QUIT" D LINE(ABSVTXT) ;build beginning of mail message
S DIU(0)="DT" ;flags to delete data and templates
;Loop through known Voluntary Timekeeping files
F ABSVFILE=503330,503330.1,503330.2,503331,503332,503333,503334,503334.1,503335,503336,503337,503338,503338.1,503339,503339.1,503339.2,503339.3,503339.5,503339.9,503340,503340.1,503341,503342,503343,503344,503345,503346.1,503347 D
.S DIU=$$ROOT^DILFD(ABSVFILE),ABSVNODE=$$CREF^DILF(DIU) ;set diu=file root and absvnode=closed file root
.I '$$VFILE^DILFD(ABSVFILE) Q ;verify file exists
.D EN^DIU2 ;delete file and data in diu
.;check if DD and data is removed
.I '$D(@ABSVNODE),'$$VFILE^DILFD(ABSVFILE) D Q ;file successfully deleted
..S ABSVSTR=DIU_" successfully removed" D LINE(ABSVSTR) Q
.S ABSVSTR=DIU_" was not successfully removed",ABSVFLG=1 D LINE(ABSVSTR) ;fall through if file not deleted
I ABSVFLG D
.D LINE("")
.S ABSVSTR="A file was not removed successfully. Please re-run the"
.S ABSVSTR=ABSVSTR_" background job" D LINE(ABSVSTR)
.S ABSVSTR="by entering this command at the programmer's prompt:" D LINE(ABSVSTR)
.S ABSVSTR=" D BEGDEL^ABSV4P45" D LINE(ABSVSTR)
D DELFX
D DIRCHK ;check if namespaced routines remain
D LINE("")
S ABSVSTART="Start Time: "_ABSVSTART D LINE(ABSVSTART)
S ABSVEND=$$FMTE^XLFDT($$NOW^XLFDT,1)
S ABSVEND="End Time: "_ABSVEND D LINE(ABSVEND)
D MAIL ;send mail message
K ^TMP($J,"ABSV4P45")
Q
DELFX ;Delete functions in FUNC list
N ABSVI,ABSVN
F ABSVI=1:1 S ABSVN=$P($T(FUNC+ABSVI),";;",2) Q:ABSVN="**END**" D
. N ABSVDA,ABSVARR,ABSVERR S ABSVDA=$$FIND1^DIC(.5,"","BX",ABSVN) Q:ABSVDA'>0
. S ABSVARR(.5,ABSVDA_",",.01)="@" D FILE^DIE("EK","ABSVARR","ABSVERR")
Q
;
MSGTXT ;message into
;; The Voluntary Timekeeping pkg is being retired and all data and data
;; dictionaries 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 ABSVCNT=ABSVCNT+1,^TMP($J,"ABSV4P45",ABSVCNT)=TEXT
Q
;
DIRCHK ;checks ^ROUTINE global for files beginning with ABSV that were not removed
;
N X,ABSVFND,ABSVSTR
S ABSVFND=1
S X="ABSU~" F S X=$O(^ROUTINE(X)) Q:(X="")!($E(X,1,4)'="ABSV") D
.I X="ABSV4P45" Q
.I ABSVFND D
..D LINE("")
..S ABSVSTR="The following routines beginning with ABSV were found in the directory." D LINE(ABSVSTR)
..S ABSVSTR="They were not removed with patch ABSV*4*45 installation. You will need to" D LINE(ABSVSTR)
..S ABSVSTR="review these routines and delete them if necessary." D LINE(ABSVSTR)
.D LINE(X) S ABSVFND=0
Q
;
MAIL ;send message
;
N XMDUZ,XMY,XMTEXT,XMSUB,DIFROM
S XMY(DUZ)="",XMDUZ=.5
S XMSUB="Voluntary Timekeeping Package Data & Data Dictionary Removal"
S XMTEXT="^TMP($J,""ABSV4P45"","
D ^XMD
Q
;
FUNC ;List of Volunatary Timekeeping functions to be removed
;;ABSVAGE
;;ABSVM VOLREMARKS
;;ABSV DOLLAR
;;ABSVM FIX DATE
;;ABSVM NAME FAMILY
;;ABSVM NAME GIVEN
;;ABSVM NAME MIDDLE
;;ABSVM NAME SUFFIX
;;ABSVM SITE
;;**END**
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HABSV4P45 4203 printed Apr 09, 2024@21:48:19 Page 2
ABSV4P45 ;LKG/OI&T - VOLUNTARY TIMEKEEPING PKG DECOMMISSIONING ;12/10/20 10:35
V ;;4.0;VOLUNTARY TIMEKEEPING;**45**;JULY 6, 1994;Build 12
+1 ;Per VA Directive 6402, this routine should not be modified.
+2 ;
+3 ;The Voluntary Timekeeping package is being retired. This routine will
+4 ;remove the Voluntary Timekeeping files and data
+5 ;
+6 ;
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 Voluntary Timekeeping")
+5 DO MES^XPDUTL("files and data...")
+6 DO MES^XPDUTL("A Mailman message will be generated and sent to the installer when")
+7 DO MES^XPDUTL("the job is completed.")
+8 SET ZTRTN="BEGDEL^ABSV4P45"
SET ZTDESC="Voluntary Timekeeping Pkg File & Data Removal"
+9 SET ZTIO=""
SET ZTDTH=$HOROLOG
+10 DO ^%ZTLOAD
+11 QUIT
+12 ;
BEGDEL ;background job entry point to remove all files and data
+1 ;
+2 NEW DIU,ABSVCNT,ABSVNODE,ABSVLOOP,ABSVTXT,ABSVFILE,ABSVFLG,ABSVSTART,ABSVEND,ABSVSTR
+3 SET (ABSVCNT,ABSVFLG)=0
SET ABSVSTART=$$FMTE^XLFDT($$NOW^XLFDT,1)
+4 KILL ^TMP($JOB,"ABSV4P45")
+5 ;build beginning of mail message
FOR ABSVLOOP=1:1
SET ABSVTXT=$PIECE($TEXT(MSGTXT+ABSVLOOP),";;",2)
if ABSVTXT="QUIT"
QUIT
DO LINE(ABSVTXT)
+6 ;flags to delete data and templates
SET DIU(0)="DT"
+7 ;Loop through known Voluntary Timekeeping files
+8 FOR ABSVFILE=503330,503330.1,503330.2,503331,503332,503333,503334,503334.1,503335,503336,503337,503338,503338.1,503339,503339.1,503339.2,503339.3,503339.5,503339.9,503340,503340.1,503341,503342,503343,503344,503345,503346.1,503347
Begin DoDot:1
+9 ;set diu=file root and absvnode=closed file root
SET DIU=$$ROOT^DILFD(ABSVFILE)
SET ABSVNODE=$$CREF^DILF(DIU)
+10 ;verify file exists
IF '$$VFILE^DILFD(ABSVFILE)
QUIT
+11 ;delete file and data in diu
DO EN^DIU2
+12 ;check if DD and data is removed
+13 ;file successfully deleted
IF '$DATA(@ABSVNODE)
IF '$$VFILE^DILFD(ABSVFILE)
Begin DoDot:2
+14 SET ABSVSTR=DIU_" successfully removed"
DO LINE(ABSVSTR)
QUIT
End DoDot:2
QUIT
+15 ;fall through if file not deleted
SET ABSVSTR=DIU_" was not successfully removed"
SET ABSVFLG=1
DO LINE(ABSVSTR)
End DoDot:1
+16 IF ABSVFLG
Begin DoDot:1
+17 DO LINE("")
+18 SET ABSVSTR="A file was not removed successfully. Please re-run the"
+19 SET ABSVSTR=ABSVSTR_" background job"
DO LINE(ABSVSTR)
+20 SET ABSVSTR="by entering this command at the programmer's prompt:"
DO LINE(ABSVSTR)
+21 SET ABSVSTR=" D BEGDEL^ABSV4P45"
DO LINE(ABSVSTR)
End DoDot:1
+22 DO DELFX
+23 ;check if namespaced routines remain
DO DIRCHK
+24 DO LINE("")
+25 SET ABSVSTART="Start Time: "_ABSVSTART
DO LINE(ABSVSTART)
+26 SET ABSVEND=$$FMTE^XLFDT($$NOW^XLFDT,1)
+27 SET ABSVEND="End Time: "_ABSVEND
DO LINE(ABSVEND)
+28 ;send mail message
DO MAIL
+29 KILL ^TMP($JOB,"ABSV4P45")
+30 QUIT
DELFX ;Delete functions in FUNC list
+1 NEW ABSVI,ABSVN
+2 FOR ABSVI=1:1
SET ABSVN=$PIECE($TEXT(FUNC+ABSVI),";;",2)
if ABSVN="**END**"
QUIT
Begin DoDot:1
+3 NEW ABSVDA,ABSVARR,ABSVERR
SET ABSVDA=$$FIND1^DIC(.5,"","BX",ABSVN)
if ABSVDA'>0
QUIT
+4 SET ABSVARR(.5,ABSVDA_",",.01)="@"
DO FILE^DIE("EK","ABSVARR","ABSVERR")
End DoDot:1
+5 QUIT
+6 ;
MSGTXT ;message into
+1 ;; The Voluntary Timekeeping pkg is being retired and all data and data
+2 ;; dictionaries will be removed from the system. This message shows a
+3 ;; 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 ABSVCNT=ABSVCNT+1
SET ^TMP($JOB,"ABSV4P45",ABSVCNT)=TEXT
+3 QUIT
+4 ;
DIRCHK ;checks ^ROUTINE global for files beginning with ABSV that were not removed
+1 ;
+2 NEW X,ABSVFND,ABSVSTR
+3 SET ABSVFND=1
+4 SET X="ABSU~"
FOR
SET X=$ORDER(^ROUTINE(X))
if (X="")!($EXTRACT(X,1,4)'="ABSV")
QUIT
Begin DoDot:1
+5 IF X="ABSV4P45"
QUIT
+6 IF ABSVFND
Begin DoDot:2
+7 DO LINE("")
+8 SET ABSVSTR="The following routines beginning with ABSV were found in the directory."
DO LINE(ABSVSTR)
+9 SET ABSVSTR="They were not removed with patch ABSV*4*45 installation. You will need to"
DO LINE(ABSVSTR)
+10 SET ABSVSTR="review these routines and delete them if necessary."
DO LINE(ABSVSTR)
End DoDot:2
+11 DO LINE(X)
SET ABSVFND=0
End DoDot:1
+12 QUIT
+13 ;
MAIL ;send message
+1 ;
+2 NEW XMDUZ,XMY,XMTEXT,XMSUB,DIFROM
+3 SET XMY(DUZ)=""
SET XMDUZ=.5
+4 SET XMSUB="Voluntary Timekeeping Package Data & Data Dictionary Removal"
+5 SET XMTEXT="^TMP($J,""ABSV4P45"","
+6 DO ^XMD
+7 QUIT
+8 ;
FUNC ;List of Volunatary Timekeeping functions to be removed
+1 ;;ABSVAGE
+2 ;;ABSVM VOLREMARKS
+3 ;;ABSV DOLLAR
+4 ;;ABSVM FIX DATE
+5 ;;ABSVM NAME FAMILY
+6 ;;ABSVM NAME GIVEN
+7 ;;ABSVM NAME MIDDLE
+8 ;;ABSVM NAME SUFFIX
+9 ;;ABSVM SITE
+10 ;;**END**
