| 1 | VAQPUR10 ;ALB/JRP - PURGING;15JUL93
|
|---|
| 2 | ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
|
|---|
| 3 | START ;START RESPONSE TIME MONITORING (TIME TO PURGE SINGLE TRANSACTION)
|
|---|
| 4 | I ($D(XRTL)) D T0^%ZOSV
|
|---|
| 5 | Q
|
|---|
| 6 | ;
|
|---|
| 7 | STOP ;STOP RESPONSE TIME MONITORING
|
|---|
| 8 | I ($D(XRT0)) S XRTN=$T(+0) D T1^%ZOSV K XRTN,XRT0
|
|---|
| 9 | Q
|
|---|
| 10 | ;
|
|---|
| 11 | JOB ;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 | ;
|
|---|
| 29 | PURGER(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
|
|---|
