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