VAQPUR ;ALB/JRP - PURGING;15JUL93
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
DEFAULT ;ENTRY POINT TO USE DEFAULT LIFETIME FOR PURGING
;INPUT : None
;OUTPUT : None
;
;DECLARE VARIABLES
N X1,X2,X,%H,VAQDATE
;GET LIFETIME FROM PARAMETER FILE (DEFAULTS TO 30)
S X2=0
S X1=$O(^VAT(394.81,0))
S:(X1) X2=+$G(^VAT(394.81,X1,"LIFE"))
S:('X2) X2=30
;INCREMENT LIFETIME BY 3
S X2=X2+3
;DETERMINE PURGE DATE (SUBTRACT LIFETIME FROM TODAY)
S X2=0-X2
S X1=+$G(DT)
S:('X1) X1=$$NOW^VAQUTL99(1,0)
D C^%DTC
S VAQDATE=X
;CALL PURGER (IF JOBBED)
I ($D(ZTQUEUED)) S X1=$$PURGER^VAQPUR10(VAQDATE,0) Q
;TASK PURGER
D TASKIT
Q
;
USERLIF ;ENTRY POINT TO GET LIFETIME FOR PURGING FROM USER
;INPUT : None
;OUTPUT : None
;
;DECLARE VARIABLES
N X1,X2,X,%H,DIR,Y,VAQDATE
;GET LIFETIME FROM USER (DEFAULT IS 30)
S DIR(0)="NAO^1:99999:0"
S DIR("A")="Lifetime to use for purging : "
S DIR("B")=30
S DIR("?",1)="Enter the number of days a PDX transaction is considered valid."
S DIR("?",2)="Transactions, and their data, that are older than this value"
S DIR("?")="plus three will be deleted."
D ^DIR
I ($D(DTOUT)!$D(DUOUT)) K DTOUT,DUOUT,DIRUT,DIROUT Q
;INCREMENT LIFETIME BY 3
S X2=Y+3
;DETERMINE PURGE DATE (SUBTRACT LIFETIME FROM TODAY)
S X2=0-X2
S X1=+$G(DT)
S:('X1) X1=$$NOW^VAQUTL99(1,0)
D C^%DTC
S VAQDATE=X
;TASK PURGER
D TASKIT
Q
;
USERDAT ;ENTRY POINT TO GET DATE TO USE FOR PURGING FROM USER
;INPUT : None
;OUTPUT : None
;
;DECLARE VARIABLES
N X1,X2,X,%H,DIR,Y
;DEFAULT IS 30 DAYS BACK
S X1=+$G(DT)
S:('X1) X1=$$NOW^VAQUTL99(1,0)
S X2=-30
D C^%DTC
S X1=$$DOBFMT^VAQUTL99(X,0)
S DIR("B")=X1
;FORCE USER TO PUT IN A DATE OLDER THAN 3 DAYS BACK
S X1=+$G(DT)
S:('X1) X1=$$NOW^VAQUTL99(1,0)
S X2=-3
D C^%DTC
S DIR(0)="DAO^:"_X_":EX"
S DIR("A")="Date to use for purging : "
S DIR("?",1)="Enter the day after which a PDX transaction is considered valid."
S DIR("?",2)="Transactions, and their data, that were created before this date"
S DIR("?")="will be deleted."
D ^DIR
I ($D(DTOUT)!$D(DUOUT)) K DTOUT,DUOUT,DIRUT,DIROUT Q
S VAQDATE=Y
;TASK PURGER
D TASKIT
Q
;
TASKIT ;TASKS PURGER USING DATE PROVIDED BY USER
N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTSK
;SET UP VARIABLES FOR CALL TO %ZTLOAD
S ZTRTN="JOB^VAQPUR10"
S ZTDESC="Purging of PDX Transactions"
S ZTSAVE("VAQDATE")=VAQDATE
S ZTSAVE("VAQINTR")=0
S ZTIO=""
S ZTDTH=""
S ZTSK=0
W !!
;TASK
D ^%ZTLOAD
;COULD NOT BE TASKED
I ('(+$G(ZTSK))) D Q
.W !!,$C(7)
.W "** Purging of PDX Transactions could not be queued **"
.W !!,$C(7)
;TELL USER TASK NUMBER
W !!
W "Purging of PDX Transactions has been queued."
W !,?2,"Task number: ",ZTSK
W !!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQPUR 2775 printed Apr 09, 2024@21:28:38 Page 2
VAQPUR ;ALB/JRP - PURGING;15JUL93
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
DEFAULT ;ENTRY POINT TO USE DEFAULT LIFETIME FOR PURGING
+1 ;INPUT : None
+2 ;OUTPUT : None
+3 ;
+4 ;DECLARE VARIABLES
+5 NEW X1,X2,X,%H,VAQDATE
+6 ;GET LIFETIME FROM PARAMETER FILE (DEFAULTS TO 30)
+7 SET X2=0
+8 SET X1=$ORDER(^VAT(394.81,0))
+9 if (X1)
SET X2=+$GET(^VAT(394.81,X1,"LIFE"))
+10 if ('X2)
SET X2=30
+11 ;INCREMENT LIFETIME BY 3
+12 SET X2=X2+3
+13 ;DETERMINE PURGE DATE (SUBTRACT LIFETIME FROM TODAY)
+14 SET X2=0-X2
+15 SET X1=+$GET(DT)
+16 if ('X1)
SET X1=$$NOW^VAQUTL99(1,0)
+17 DO C^%DTC
+18 SET VAQDATE=X
+19 ;CALL PURGER (IF JOBBED)
+20 IF ($DATA(ZTQUEUED))
SET X1=$$PURGER^VAQPUR10(VAQDATE,0)
QUIT
+21 ;TASK PURGER
+22 DO TASKIT
+23 QUIT
+24 ;
USERLIF ;ENTRY POINT TO GET LIFETIME FOR PURGING FROM USER
+1 ;INPUT : None
+2 ;OUTPUT : None
+3 ;
+4 ;DECLARE VARIABLES
+5 NEW X1,X2,X,%H,DIR,Y,VAQDATE
+6 ;GET LIFETIME FROM USER (DEFAULT IS 30)
+7 SET DIR(0)="NAO^1:99999:0"
+8 SET DIR("A")="Lifetime to use for purging : "
+9 SET DIR("B")=30
+10 SET DIR("?",1)="Enter the number of days a PDX transaction is considered valid."
+11 SET DIR("?",2)="Transactions, and their data, that are older than this value"
+12 SET DIR("?")="plus three will be deleted."
+13 DO ^DIR
+14 IF ($DATA(DTOUT)!$DATA(DUOUT))
KILL DTOUT,DUOUT,DIRUT,DIROUT
QUIT
+15 ;INCREMENT LIFETIME BY 3
+16 SET X2=Y+3
+17 ;DETERMINE PURGE DATE (SUBTRACT LIFETIME FROM TODAY)
+18 SET X2=0-X2
+19 SET X1=+$GET(DT)
+20 if ('X1)
SET X1=$$NOW^VAQUTL99(1,0)
+21 DO C^%DTC
+22 SET VAQDATE=X
+23 ;TASK PURGER
+24 DO TASKIT
+25 QUIT
+26 ;
USERDAT ;ENTRY POINT TO GET DATE TO USE FOR PURGING FROM USER
+1 ;INPUT : None
+2 ;OUTPUT : None
+3 ;
+4 ;DECLARE VARIABLES
+5 NEW X1,X2,X,%H,DIR,Y
+6 ;DEFAULT IS 30 DAYS BACK
+7 SET X1=+$GET(DT)
+8 if ('X1)
SET X1=$$NOW^VAQUTL99(1,0)
+9 SET X2=-30
+10 DO C^%DTC
+11 SET X1=$$DOBFMT^VAQUTL99(X,0)
+12 SET DIR("B")=X1
+13 ;FORCE USER TO PUT IN A DATE OLDER THAN 3 DAYS BACK
+14 SET X1=+$GET(DT)
+15 if ('X1)
SET X1=$$NOW^VAQUTL99(1,0)
+16 SET X2=-3
+17 DO C^%DTC
+18 SET DIR(0)="DAO^:"_X_":EX"
+19 SET DIR("A")="Date to use for purging : "
+20 SET DIR("?",1)="Enter the day after which a PDX transaction is considered valid."
+21 SET DIR("?",2)="Transactions, and their data, that were created before this date"
+22 SET DIR("?")="will be deleted."
+23 DO ^DIR
+24 IF ($DATA(DTOUT)!$DATA(DUOUT))
KILL DTOUT,DUOUT,DIRUT,DIROUT
QUIT
+25 SET VAQDATE=Y
+26 ;TASK PURGER
+27 DO TASKIT
+28 QUIT
+29 ;
TASKIT ;TASKS PURGER USING DATE PROVIDED BY USER
+1 NEW ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTSK
+2 ;SET UP VARIABLES FOR CALL TO %ZTLOAD
+3 SET ZTRTN="JOB^VAQPUR10"
+4 SET ZTDESC="Purging of PDX Transactions"
+5 SET ZTSAVE("VAQDATE")=VAQDATE
+6 SET ZTSAVE("VAQINTR")=0
+7 SET ZTIO=""
+8 SET ZTDTH=""
+9 SET ZTSK=0
+10 WRITE !!
+11 ;TASK
+12 DO ^%ZTLOAD
+13 ;COULD NOT BE TASKED
+14 IF ('(+$GET(ZTSK)))
Begin DoDot:1
+15 WRITE !!,$CHAR(7)
+16 WRITE "** Purging of PDX Transactions could not be queued **"
+17 WRITE !!,$CHAR(7)
End DoDot:1
QUIT
+18 ;TELL USER TASK NUMBER
+19 WRITE !!
+20 WRITE "Purging of PDX Transactions has been queued."
+21 WRITE !,?2,"Task number: ",ZTSK
+22 WRITE !!
+23 QUIT
