source: WorldVistAEHR/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQPUR10.m@ 1006

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

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1VAQPUR10 ;ALB/JRP - PURGING;15JUL93
2 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
3START ;START RESPONSE TIME MONITORING (TIME TO PURGE SINGLE TRANSACTION)
4 I ($D(XRTL)) D T0^%ZOSV
5 Q
6 ;
7STOP ;STOP RESPONSE TIME MONITORING
8 I ($D(XRT0)) S XRTN=$T(+0) D T1^%ZOSV K XRTN,XRT0
9 Q
10 ;
11JOB ;ENTRY POINT FOR PURGING THAT HAS BEEN JOBBED
12 ;INPUT : VAQDATE - Earliest date allowed for transactions (FileMan)
13 ; VAQINTR - Interactive flag
14 ; If 1, write purging information to current device
15 ; If 0, do not write purging information (default)
16 ;OUTPUT : None
17 ;NOTES : See $$PURGER^VAQPUR10
18 ;
19 ;CHECK INPUT
20 I ('$D(VAQDATE)) S ZTREQ="@" Q
21 S:('$D(VAQINTR)) VAQINTR=0
22 ;DECLARE VARIABLE
23 N JUNK
24 ;CALL PURGER
25 S JUNK=$$PURGER(VAQDATE,VAQINTR)
26 S ZTREQ="@"
27 Q
28 ;
29PURGER(PURDATE,DBUG) ;PURGER
30 ;INPUT : PURDATE - Earliest date allowed for transactions (FileMan)
31 ; DBUG - Debug flag
32 ; If 1, write purging information to current device
33 ; If 0, do not write purging information (default)
34 ;OUTPUT : N - Number of transactions purged
35 ;NOTES : Transactions that were created on or before PURDATE will
36 ; be purged. Data that is associated with the transaction
37 ; will also be purged.
38 ; : Work-load information that relates to the transaction will
39 ; not be purged.
40 ; : Transactions that are missing critical data will have their
41 ; purge flag set. This allows the transaction to be purged
42 ; the next time the purger is run and prevents transactions
43 ; that are currently being worked on from being deleted.
44 ;
45 ;CHECK INPUT
46 Q:('(+$G(PURDATE))) 0
47 S DBUG=+$G(DBUG)
48 ;DECLARE VARIABLES
49 N TRANPTR,PURGE,PRGCNT,ERROR,TMP,STOPJOB
50 S ERROR="^TMP(""VAQ-PURGE"","_$J_")"
51 K @ERROR
52 S PRGCNT=0
53 S STOPJOB=0
54 W:(DBUG) !!,"- PDX Purger -"
55 ;DELETE ALL TRANSACTIONS THAT HAVE PURGE FLAG SET
56 W:(DBUG) !!!,"Deleting transactions with purge flag set"
57 S TRANPTR=""
58 F S TRANPTR=$O(^VAT(394.61,"PURGE",1,TRANPTR)) Q:((TRANPTR="")!(STOPJOB)) D START D D STOP
59 .S STOPJOB=$$S^%ZTLOAD
60 .Q:(STOPJOB)
61 .S TMP=+$$DELTRAN^VAQFILE(TRANPTR)
62 .I (TMP<0) D Q
63 ..S @ERROR@(TRANPTR)="Unable to delete entry"
64 ..W:(DBUG) !,"Unable to delete entry number ",TRANPTR
65 .S PRGCNT=PRGCNT+1
66 .W:(DBUG) !,"Entry number ",TRANPTR," has been deleted"
67 ;JOB HAS BEEN STOPPED
68 I (STOPJOB) D Q PRGCNT
69 .S @ERROR@("STOPPED")=""
70 .W:(DBUG) !!!,"*** Purger has been stopped ***",!!!
71 .;SEND ERROR BULLETIN
72 .S:('DBUG) TMP=$$PURGE^VAQBUL07(ERROR)
73 .K @ERROR
74 ;CHECK ALL TRANSACTIONS FOR POSSIBLE PURGING
75 W:(DBUG) !!!,"Checking all transactions against purge criteria"
76 S TRANPTR=0
77 F S TRANPTR=$O(^VAT(394.61,TRANPTR)) Q:((TRANPTR="")!(TRANPTR'?1.N)!(STOPJOB)) D START D D STOP
78 .S STOPJOB=$$S^%ZTLOAD
79 .Q:(STOPJOB)
80 .S PURGE=$$PRGCHK^VAQPUR11(TRANPTR,PURDATE,1)
81 .Q:('PURGE)
82 .I (PURGE<0) D Q
83 ..S @ERROR@(TRANPTR)="Could not determine if entry should be deleted"
84 ..W:(DBUG) !,"Could not determine if entry number ",TRANPTR," should be deleted"
85 .I ((+PURGE)=2) D Q
86 ..S TMP=$P(PURGE,"^",2)
87 ..I (TMP=0) W:(DBUG) !,"Purge flag was not set for entry number ",TRANPTR S @ERROR@(TRANPTR)="Did not set purge flag" Q
88 ..I (TMP=1) W:(DBUG) !,"Purge flag has been set for entry number ",TRANPTR Q
89 ..I (TMP=-1) W:(DBUG) !,"Purge flag could not be set for entry number ",TRANPTR S @ERROR@(TRANPTR)="Could not set purge flag"
90 .S TMP=+$$DELTRAN^VAQFILE(TRANPTR)
91 .I (TMP<0) D Q
92 ..S @ERROR@(TRANPTR)="Unable to delete entry"
93 ..W:(DBUG) !,"Unable to delete entry number ",TRANPTR
94 .S PRGCNT=PRGCNT+1
95 .W:(DBUG) !,"Entry number ",TRANPTR," has been deleted"
96 ;JOB HAS BEEN STOPPED
97 I (STOPJOB) D Q PRGCNT
98 .S @ERROR@("STOPPED")=""
99 .W:(DBUG) !!!,"*** Purger has been stopped ***",!!!
100 .;SEND ERROR BULLETIN
101 .S:('DBUG) TMP=$$PURGE^VAQBUL07(ERROR)
102 .K @ERROR
103 W:(DBUG) !!!,"- Done -",!!!
104 ;SEND ERROR BULLETIN IF NOT IN DEBUG MODE
105 S:('DBUG) TMP=$$PURGE^VAQBUL07(ERROR)
106 K @ERROR
107 Q PRGCNT
Note: See TracBrowser for help on using the repository browser.