source: WorldVistAEHR/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQPUR.m@ 1000

Last change on this file since 1000 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 2.6 KB
RevLine 
[613]1VAQPUR ;ALB/JRP - PURGING;15JUL93
2 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
3DEFAULT ;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 ;
28USERLIF ;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 ;
55USERDAT ;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 ;
85TASKIT ;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
Note: See TracBrowser for help on using the repository browser.