| 1 | VAQPUR ;ALB/JRP - PURGING;15JUL93
 | 
|---|
| 2 |  ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
 | 
|---|
| 3 | DEFAULT ;ENTRY POINT TO USE DEFAULT LIFETIME FOR PURGING
 | 
|---|
| 4 |  ;INPUT  : None
 | 
|---|
| 5 |  ;OUTPUT : None
 | 
|---|
| 6 |  ;
 | 
|---|
| 7 |  ;DECLARE VARIABLES
 | 
|---|
| 8 |  N X1,X2,X,%H,VAQDATE
 | 
|---|
| 9 |  ;GET LIFETIME FROM PARAMETER FILE (DEFAULTS TO 30)
 | 
|---|
| 10 |  S X2=0
 | 
|---|
| 11 |  S X1=$O(^VAT(394.81,0))
 | 
|---|
| 12 |  S:(X1) X2=+$G(^VAT(394.81,X1,"LIFE"))
 | 
|---|
| 13 |  S:('X2) X2=30
 | 
|---|
| 14 |  ;INCREMENT LIFETIME BY 3
 | 
|---|
| 15 |  S X2=X2+3
 | 
|---|
| 16 |  ;DETERMINE PURGE DATE (SUBTRACT LIFETIME FROM TODAY)
 | 
|---|
| 17 |  S X2=0-X2
 | 
|---|
| 18 |  S X1=+$G(DT)
 | 
|---|
| 19 |  S:('X1) X1=$$NOW^VAQUTL99(1,0)
 | 
|---|
| 20 |  D C^%DTC
 | 
|---|
| 21 |  S VAQDATE=X
 | 
|---|
| 22 |  ;CALL PURGER (IF JOBBED)
 | 
|---|
| 23 |  I ($D(ZTQUEUED)) S X1=$$PURGER^VAQPUR10(VAQDATE,0) Q
 | 
|---|
| 24 |  ;TASK PURGER
 | 
|---|
| 25 |  D TASKIT
 | 
|---|
| 26 |  Q
 | 
|---|
| 27 |  ;
 | 
|---|
| 28 | USERLIF ;ENTRY POINT TO GET LIFETIME FOR PURGING FROM USER
 | 
|---|
| 29 |  ;INPUT  : None
 | 
|---|
| 30 |  ;OUTPUT : None
 | 
|---|
| 31 |  ;
 | 
|---|
| 32 |  ;DECLARE VARIABLES
 | 
|---|
| 33 |  N X1,X2,X,%H,DIR,Y,VAQDATE
 | 
|---|
| 34 |  ;GET LIFETIME FROM USER (DEFAULT IS 30)
 | 
|---|
| 35 |  S DIR(0)="NAO^1:99999:0"
 | 
|---|
| 36 |  S DIR("A")="Lifetime to use for purging : "
 | 
|---|
| 37 |  S DIR("B")=30
 | 
|---|
| 38 |  S DIR("?",1)="Enter the number of days a PDX transaction is considered valid."
 | 
|---|
| 39 |  S DIR("?",2)="Transactions, and their data, that are older than this value"
 | 
|---|
| 40 |  S DIR("?")="plus three will be deleted."
 | 
|---|
| 41 |  D ^DIR
 | 
|---|
| 42 |  I ($D(DTOUT)!$D(DUOUT)) K DTOUT,DUOUT,DIRUT,DIROUT Q
 | 
|---|
| 43 |  ;INCREMENT LIFETIME BY 3
 | 
|---|
| 44 |  S X2=Y+3
 | 
|---|
| 45 |  ;DETERMINE PURGE DATE (SUBTRACT LIFETIME FROM TODAY)
 | 
|---|
| 46 |  S X2=0-X2
 | 
|---|
| 47 |  S X1=+$G(DT)
 | 
|---|
| 48 |  S:('X1) X1=$$NOW^VAQUTL99(1,0)
 | 
|---|
| 49 |  D C^%DTC
 | 
|---|
| 50 |  S VAQDATE=X
 | 
|---|
| 51 |  ;TASK PURGER
 | 
|---|
| 52 |  D TASKIT
 | 
|---|
| 53 |  Q
 | 
|---|
| 54 |  ;
 | 
|---|
| 55 | USERDAT ;ENTRY POINT TO GET DATE TO USE FOR PURGING FROM USER
 | 
|---|
| 56 |  ;INPUT  : None
 | 
|---|
| 57 |  ;OUTPUT : None
 | 
|---|
| 58 |  ;
 | 
|---|
| 59 |  ;DECLARE VARIABLES
 | 
|---|
| 60 |  N X1,X2,X,%H,DIR,Y
 | 
|---|
| 61 |  ;DEFAULT IS 30 DAYS BACK
 | 
|---|
| 62 |  S X1=+$G(DT)
 | 
|---|
| 63 |  S:('X1) X1=$$NOW^VAQUTL99(1,0)
 | 
|---|
| 64 |  S X2=-30
 | 
|---|
| 65 |  D C^%DTC
 | 
|---|
| 66 |  S X1=$$DOBFMT^VAQUTL99(X,0)
 | 
|---|
| 67 |  S DIR("B")=X1
 | 
|---|
| 68 |  ;FORCE USER TO PUT IN A DATE OLDER THAN 3 DAYS BACK
 | 
|---|
| 69 |  S X1=+$G(DT)
 | 
|---|
| 70 |  S:('X1) X1=$$NOW^VAQUTL99(1,0)
 | 
|---|
| 71 |  S X2=-3
 | 
|---|
| 72 |  D C^%DTC
 | 
|---|
| 73 |  S DIR(0)="DAO^:"_X_":EX"
 | 
|---|
| 74 |  S DIR("A")="Date to use for purging : "
 | 
|---|
| 75 |  S DIR("?",1)="Enter the day after which a PDX transaction is considered valid."
 | 
|---|
| 76 |  S DIR("?",2)="Transactions, and their data, that were created before this date"
 | 
|---|
| 77 |  S DIR("?")="will be deleted."
 | 
|---|
| 78 |  D ^DIR
 | 
|---|
| 79 |  I ($D(DTOUT)!$D(DUOUT)) K DTOUT,DUOUT,DIRUT,DIROUT Q
 | 
|---|
| 80 |  S VAQDATE=Y
 | 
|---|
| 81 |  ;TASK PURGER
 | 
|---|
| 82 |  D TASKIT
 | 
|---|
| 83 |  Q
 | 
|---|
| 84 |  ;
 | 
|---|
| 85 | TASKIT ;TASKS PURGER USING DATE PROVIDED BY USER
 | 
|---|
| 86 |  N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTSK
 | 
|---|
| 87 |  ;SET UP VARIABLES FOR CALL TO %ZTLOAD
 | 
|---|
| 88 |  S ZTRTN="JOB^VAQPUR10"
 | 
|---|
| 89 |  S ZTDESC="Purging of PDX Transactions"
 | 
|---|
| 90 |  S ZTSAVE("VAQDATE")=VAQDATE
 | 
|---|
| 91 |  S ZTSAVE("VAQINTR")=0
 | 
|---|
| 92 |  S ZTIO=""
 | 
|---|
| 93 |  S ZTDTH=""
 | 
|---|
| 94 |  S ZTSK=0
 | 
|---|
| 95 |  W !!
 | 
|---|
| 96 |  ;TASK
 | 
|---|
| 97 |  D ^%ZTLOAD
 | 
|---|
| 98 |  ;COULD NOT BE TASKED
 | 
|---|
| 99 |  I ('(+$G(ZTSK))) D  Q
 | 
|---|
| 100 |  .W !!,$C(7)
 | 
|---|
| 101 |  .W "** Purging of PDX Transactions could not be queued **"
 | 
|---|
| 102 |  .W !!,$C(7)
 | 
|---|
| 103 |  ;TELL USER TASK NUMBER
 | 
|---|
| 104 |  W !!
 | 
|---|
| 105 |  W "Purging of PDX Transactions has been queued."
 | 
|---|
| 106 |  W !,?2,"Task number: ",ZTSK
 | 
|---|
| 107 |  W !!
 | 
|---|
| 108 |  Q
 | 
|---|