PPP44PI ;BIRM/JAM - Post Install to remove PPP data and DDs ;06/05/09
;;1.0;PHARMACY PRESCRIPTION PRACTICE;**44**;APR 7,1995;Build 19
;
;Retiring of PPP package - removal of all its files & data
EN ; entry point
;
N STR,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTREQ,ZTSAVE
D MES^XPDUTL(" ")
S STR="A background job will be tasked to delete all PPP data and data dictionary..."
D MES^XPDUTL(STR)
S STR="A Mailman message will be generated and sent to the installer when the job"
D MES^XPDUTL(STR)
D MES^XPDUTL("is completed.")
S ZTRTN="BGEN^PPP44PI",ZTDESC="PPP Package Data & Data Dictionary Removal"
S ZTIO="",ZTDTH=$H,ZTREQ="@",ZTSAVE("ZTREQ")=""
D ^%ZTLOAD
Q
;
BGEN ;Background job entry
N DIU,COUNT,GNOD,I,TXT,FILE,FLG,START,END
S (COUNT,FLG)=0,START=$$FMTE^XLFDT($$NOW^XLFDT,1)
K ^TMP($J,"PPP44")
F I=1:1 S TXT=$P($T(MSGTXT+I),";;",2) Q:TXT="QUIT" D LINE(TXT)
S DIU(0)="DST"
F FILE=1020.1:.1:1020.8,1020.128 D
.S DIU=$$ROOT^DILFD(FILE),GNOD=$$CREF^DILF(DIU)
.I '$$VFILE^DILFD(FILE) Q
.D EN^DIU2
.; check if DD and data is removed
.I '$D(@GNOD),'$$VFILE^DILFD(FILE) D Q
..S STR=DIU_" successfully removed" D LINE(STR) Q
.S STR=DIU_" was not successfully removed",FLG=1 D LINE(STR)
I FLG D
.D LINE("")
.S STR="A file was not removed successfully. Please have your IRM re-run"
.S STR=STR_" the background job" D LINE(STR)
.S STR="by entering this command at the programmer's prompt" D LINE(STR)
.S STR=" D EN^PPP44PI"
D DIRCHK
D LINE("")
S START="Start Time: "_START D LINE(START)
S END=$$FMTE^XLFDT($$NOW^XLFDT,1)
S STR="End Time: "_END D LINE(STR)
D MAIL
Q
;
MSGTXT ; Message into
;; The PPP 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 message global
S COUNT=COUNT+1,^TMP($J,"PPP44",COUNT)=TEXT
Q
;
DIRCHK ; Checks ^ROUTINE global for files beginning with PPP that were not
; removed.
N X,FND,STR
S FND=1
S X="PPO~" F S X=$O(^ROUTINE(X)) Q:(X="")!($E(X,1,3)'="PPP") D
.I X="PPP44PI" Q
.I FND D
..D LINE("")
..S STR="The following routines beginning with PPP were found in the directory." D LINE(STR)
..S STR="They were not removed with patch PPP*1*44 installation. You will need to" D LINE(STR)
..S STR="review these routines and delete them if necessary." D LINE(STR)
.D LINE(X) S FND=0
Q
;
MAIL ; Send message
N XMDUZ,XMY,XMTEXT,XMSUB
S XMY(DUZ)="",XMDUZ=.5
S XMSUB="PPP Package Data & Data Dictionary Removal"
S XMTEXT="^TMP($J,""PPP44"","
D ^XMD
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPPP44PI 2647 printed Nov 22, 2024@17:39:24 Page 2
PPP44PI ;BIRM/JAM - Post Install to remove PPP data and DDs ;06/05/09
+1 ;;1.0;PHARMACY PRESCRIPTION PRACTICE;**44**;APR 7,1995;Build 19
+2 ;
+3 ;Retiring of PPP package - removal of all its files & data
EN ; entry point
+1 ;
+2 NEW STR,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTREQ,ZTSAVE
+3 DO MES^XPDUTL(" ")
+4 SET STR="A background job will be tasked to delete all PPP data and data dictionary..."
+5 DO MES^XPDUTL(STR)
+6 SET STR="A Mailman message will be generated and sent to the installer when the job"
+7 DO MES^XPDUTL(STR)
+8 DO MES^XPDUTL("is completed.")
+9 SET ZTRTN="BGEN^PPP44PI"
SET ZTDESC="PPP Package Data & Data Dictionary Removal"
+10 SET ZTIO=""
SET ZTDTH=$HOROLOG
SET ZTREQ="@"
SET ZTSAVE("ZTREQ")=""
+11 DO ^%ZTLOAD
+12 QUIT
+13 ;
BGEN ;Background job entry
+1 NEW DIU,COUNT,GNOD,I,TXT,FILE,FLG,START,END
+2 SET (COUNT,FLG)=0
SET START=$$FMTE^XLFDT($$NOW^XLFDT,1)
+3 KILL ^TMP($JOB,"PPP44")
+4 FOR I=1:1
SET TXT=$PIECE($TEXT(MSGTXT+I),";;",2)
if TXT="QUIT"
QUIT
DO LINE(TXT)
+5 SET DIU(0)="DST"
+6 FOR FILE=1020.1:.1:1020.8,1020.128
Begin DoDot:1
+7 SET DIU=$$ROOT^DILFD(FILE)
SET GNOD=$$CREF^DILF(DIU)
+8 IF '$$VFILE^DILFD(FILE)
QUIT
+9 DO EN^DIU2
+10 ; check if DD and data is removed
+11 IF '$DATA(@GNOD)
IF '$$VFILE^DILFD(FILE)
Begin DoDot:2
+12 SET STR=DIU_" successfully removed"
DO LINE(STR)
QUIT
End DoDot:2
QUIT
+13 SET STR=DIU_" was not successfully removed"
SET FLG=1
DO LINE(STR)
End DoDot:1
+14 IF FLG
Begin DoDot:1
+15 DO LINE("")
+16 SET STR="A file was not removed successfully. Please have your IRM re-run"
+17 SET STR=STR_" the background job"
DO LINE(STR)
+18 SET STR="by entering this command at the programmer's prompt"
DO LINE(STR)
+19 SET STR=" D EN^PPP44PI"
End DoDot:1
+20 DO DIRCHK
+21 DO LINE("")
+22 SET START="Start Time: "_START
DO LINE(START)
+23 SET END=$$FMTE^XLFDT($$NOW^XLFDT,1)
+24 SET STR="End Time: "_END
DO LINE(STR)
+25 DO MAIL
+26 QUIT
+27 ;
MSGTXT ; Message into
+1 ;; The PPP 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 message global
+1 SET COUNT=COUNT+1
SET ^TMP($JOB,"PPP44",COUNT)=TEXT
+2 QUIT
+3 ;
DIRCHK ; Checks ^ROUTINE global for files beginning with PPP that were not
+1 ; removed.
+2 NEW X,FND,STR
+3 SET FND=1
+4 SET X="PPO~"
FOR
SET X=$ORDER(^ROUTINE(X))
if (X="")!($EXTRACT(X,1,3)'="PPP")
QUIT
Begin DoDot:1
+5 IF X="PPP44PI"
QUIT
+6 IF FND
Begin DoDot:2
+7 DO LINE("")
+8 SET STR="The following routines beginning with PPP were found in the directory."
DO LINE(STR)
+9 SET STR="They were not removed with patch PPP*1*44 installation. You will need to"
DO LINE(STR)
+10 SET STR="review these routines and delete them if necessary."
DO LINE(STR)
End DoDot:2
+11 DO LINE(X)
SET FND=0
End DoDot:1
+12 QUIT
+13 ;
MAIL ; Send message
+1 NEW XMDUZ,XMY,XMTEXT,XMSUB
+2 SET XMY(DUZ)=""
SET XMDUZ=.5
+3 SET XMSUB="PPP Package Data & Data Dictionary Removal"
+4 SET XMTEXT="^TMP($J,""PPP44"","
+5 DO ^XMD
+6 QUIT
+7 ;
