HLUOPTF2 ;ALB/CJM-HL7 -Fast Purge ;02/04/2004
;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13, 1995
;
FAST1 ;entry point for FAST PURGE 1, called by the Event Monitor
I '$$COUNT D PURGE
Q
FAST2 ;entry point for FAST PURGE 2, called by the Event Monitor
I $$COUNT=1 D PURGE
Q
;
START ;Interactive entry point, asks user whether or not to queue the Fast Purge
;
N ASK,STOP
S STOP=1
S ASK=$$ASKYESNO^HLEMU("Do you want to queue the Fast Purge so that it operates in the background","YES")
I ASK D
.N ZTRTN,ZTDESC,ZTSAVE,ZTIO,ZTSK
.S ZTRTN="PURGE^HLUOPTF2"
.S ZTDESC="HL7 FAST PURGE UTILITY"
.S ZTIO=""
.S ZTSAVE("STOP")=1
.D ^%ZTLOAD
.W !,$S($D(ZTSK):"HL7 FAST PURGE UTILITY QUEUED, TASK="_ZTSK,1:"REQUEST CANCELLED")
E I ASK=0 D
.W !,"Starting Fast Purge....",!
.D PURGE
K ^TMP("HLEVFLAG",$J)
Q
STOP ;
;entry point to ask the Fast Purge Job to stop
I $$COUNT>$G(^XTMP("HL7 FAST PURGE JOBS","STOP")),$$I^HLEMU($NA(^XTMP("HL7 FAST PURGE JOBS","STOP")),1)
Q
COUNT() ;
;returns the number of Fast Purge Jobs that are running
N COUNT,I
S COUNT=0
F I=1:1:20 D
.L ^XTMP("HL7 FAST PURGE JOBS",I):0
.I '$T D
..S COUNT=COUNT+1
.E D
..L -^XTMP("HL7 FAST PURGE JOBS",I)
Q COUNT
;
PURGE ;entry point for the FAST PURGE
;
;Variables:
; CHECKAT - next time to check in with TaskMan, Job Monitor, andEvent Logging, set every 10 minutes
; HOUR - the date and time to 1 hour precision that this process is currently purging, each hour is locked before purging
; IEN772 - entry in file 772 identified for purging
; IEN773 - entry in file 773 identified for purging
; LASTCHK - a simple count, the time is checked everytime this count reaches 500 - for efficiency, do not want to check the time after purging every entry
; CNT773 - count to report for EVENT LOGGING of entries purged (file 773)
; CNT772 - count to report for EVENT LOGGING of entries purged (file 772)
; QUIT - set to 1 when signaled to stop via TaskMan
; TIME - time currently being processed on the AI x-ref, file 773
;
;
I $G(STOP)=1 D
.;setting this flag allows the job to run outside of Process Monitorng
.S ^TMP("HLEVFLAG",$J)="STOP"
;
N LCNT,CNT773,CNT772,HOUR,LASTCHK,TIME,IEN772,IEN773,CHECKAT,QUIT,VAR,I
S (TIME,HOUR,CNT773,CNT772,LCOUNT,QUIT)=0
;
D START^HLEVAPI(.VAR)
;
S CHECKAT=$$FMADD^XLFDT($$NOW^XLFDT,,,10)
;
;let everyone know that there is 1 more purge job running - maximum of 20 Fast Purges running at once
F I=1:1:20 L ^XTMP("HL7 FAST PURGE JOBS",I):0 Q:$T
;
;loop until signaled to stop or there is no work for a while
I $T F D Q:QUIT
.S:'TIME HOUR=$$FINDHOUR(HOUR) S:HOUR TIME=HOUR-.00000001
.;
.;wasn't able to get an hour to lock
.I 'HOUR D Q
..;
..;if there has been no work for a while then quit
..I $$NOW^XLFDT>CHECKAT,CNT773<2000 D
...S QUIT=$$CHECKIN(.CHECKAT,.CNT773,.CNT772,.LCOUNT)
...S QUIT=1
..E D
...S QUIT=$$CHECKIN(.CHECKAT,.CNT773,.CNT772,.LCOUNT)
...D EVENT(.CNT773,.CNT772)
...Q:QUIT
...D PAUSE
.;
.;at this point, an hour has been locked, so delete all the entries for that hour
.F S TIME=$O(^HLMA("AI",TIME)) D Q:'TIME Q:QUIT
..I ('TIME)!($E(TIME,1,10)>HOUR) S TIME=0 Q
..S LCOUNT=LCOUNT+1
..I LCOUNT>500 S QUIT=$$CHECKIN(.CHECKAT,.CNT773,.CNT772,.LCOUNT) Q:QUIT
..S (IEN772,IEN773)=0
..F S IEN773=$O(^HLMA("AI",TIME,773,IEN773)) Q:'IEN773 D
...S CNT773=CNT773+1
...D DEL773^HLUOPT3(IEN773)
...;
..F S IEN772=$O(^HLMA("AI",TIME,772,IEN772)) Q:'IEN772 D
...S CNT772=CNT772+1
...D DEL772^HLUOPT3(IEN772)
..;
..; make sure that no more records are on this x-ref for that time - could only happen in the case of corruption of some sort
..K ^HLMA("AI",TIME)
;
;unlock the last hour currently being held
L:HOUR -^HLMA("AI",HOUR)
;
;let everyone know that there is 1 less purge job running
F I=1:1:20 L -^XTMP("HL7 FAST PURGE JOBS",I)
D CHECKOUT^HLEVAPI
K ^TMP("HLEVFLAG",$J)
Q
;
PAUSE ;sleep for 10 SECONDS
H 10
Q
;
CHECKIN(CHECKAT,CNT773,CNT772,LCOUNT) ;
;if NOW>CHECKAT then:
; 1) check in with TaskMan
; 2) send a new event to the event monitor
; 3) reset CHECKAT for 10 minutes in the future
; 4) as an alternative to TaskMan, check if special Stop Fast Purge option has been used
;
;Input:
; CHECKAT - the end of the current 10 minute time period
; CNT773 - number of records in file 773 purged since the last time Event Logging was updated
; CNT772 - number of records in file 772 purged since the last time Event Logging was updated
;Output:
; Function returns 1 if the Fast Purge should stop, 0 otherwise
; LCOUNT is reset to 0 **pass by reference**
; CNT773 and CNT772 are set to 0 if reported to Event Logging **pass by reference**
; CHECKAT is reset to 10 minute sin the future if the time is up **pass by reference**
;
N NOW,QUIT
S QUIT=0
;
S NOW=$$NOW^XLFDT
I NOW>CHECKAT D
.D EVENT(.CNT773,.CNT772)
.S CHECKAT=$$FMADD^XLFDT(NOW,,,10)
.I '$D(ZTQUEUED) D
..W "."
.E D
..;check in with the Job Monitor
..D CHECKIN^HLEVAPI
..S QUIT=$$S^ZTLOAD
..S:QUIT ZTSTOP=1
;
;Check if the special option has been used to stop the purge
I $G(^XTMP("HL7 FAST PURGE JOBS","STOP"))>0 D
.S QUIT=1
.I $$I^HLEMU($NA(^XTMP("HL7 FAST PURGE JOBS","STOP")),-1)
;
S LCOUNT=0
Q QUIT
;
FINDHOUR(HOUR) ;
;Finds the next dt/tm to the hour on the AI x-ref of file 773 that can be locked, returns 0 on failure
N QUIT,NOW
S QUIT=0
;
;unlock the last hour currently being held
L:HOUR -^HLMA("AI",HOUR)
;
S NOW=$$NOW^XLFDT
;
;if this is the first time through then start with the first entry on the x-ref
I 'HOUR D Q:QUIT HOUR
.S HOUR=$O(^HLMA("AI",0))
.;
.;any records to purge?
.I 'HOUR S QUIT=1 Q
.;
.;if so, quit if the next purgeable record is for the future
.I HOUR>NOW S HOUR=0 Q
.;
.S HOUR=$E(HOUR,1,10)
.L +^HLMA("AI",+HOUR):0 S:$T QUIT=1
;
S HOUR=$E(HOUR,1,10)
F D Q:QUIT
.;
.;look for the next entry at least 1 hour in the future
.S HOUR=$$FMADD^XLFDT(HOUR,,1)-.000000001
.S HOUR=$E($O(^HLMA("AI",HOUR)),1,10)
.I 'HOUR S QUIT=1 Q
.;
.;I the hour is in the future then the entries can not yet be purged
.I (HOUR>NOW) S HOUR=0,QUIT=1 Q
.;
.;check if this hour can be locked, if so this is the hour to be purged
.L +^HLMA("AI",+HOUR):0 I $T S QUIT=1
;
Q HOUR
;
EVENT(CNT773,CNT772) ;
;add the last number of records purged to event logging
N EVENT
I CNT773 D
.S EVENT=$$EVENT^HLEME("773 PURGE","HEALTH LEVEL SEVEN")
.I CNT773>1,$$INC^HLEME(EVENT,CNT773-1)
.S CNT773=0
I CNT772 D
.S EVENT=$$EVENT^HLEME("772 PURGE","HEALTH LEVEL SEVEN")
.I CNT772>1,$$INC^HLEME(EVENT,CNT772-1)
.S CNT772=0
Q
;
CHECK1() ;called by the Master Job to determine whether
;FAST HL7 PURGE #1 should run.
;Output:
; function returns 1 if yes, 0 if no
;
I $$COUNT^HLEVAPI3("FAST HL7 PURGE #1")
Q '$T
;
CHECK2() ;called by the Master Job to determine whether
;FAST HL7 PURGE #2 should run.
;Output:
; function returns 1 if yes, 0 if no
;
I $$COUNT^HLEVAPI3("FAST HL7 PURGE #1"),'$$COUNT^HLEVAPI3("FAST HL7 PURGE #2")
Q $T
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLUOPTF2 7233 printed Sep 23, 2025@19:36:32 Page 2
HLUOPTF2 ;ALB/CJM-HL7 -Fast Purge ;02/04/2004
+1 ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13, 1995
+2 ;
FAST1 ;entry point for FAST PURGE 1, called by the Event Monitor
+1 IF '$$COUNT
DO PURGE
+2 QUIT
FAST2 ;entry point for FAST PURGE 2, called by the Event Monitor
+1 IF $$COUNT=1
DO PURGE
+2 QUIT
+3 ;
START ;Interactive entry point, asks user whether or not to queue the Fast Purge
+1 ;
+2 NEW ASK,STOP
+3 SET STOP=1
+4 SET ASK=$$ASKYESNO^HLEMU("Do you want to queue the Fast Purge so that it operates in the background","YES")
+5 IF ASK
Begin DoDot:1
+6 NEW ZTRTN,ZTDESC,ZTSAVE,ZTIO,ZTSK
+7 SET ZTRTN="PURGE^HLUOPTF2"
+8 SET ZTDESC="HL7 FAST PURGE UTILITY"
+9 SET ZTIO=""
+10 SET ZTSAVE("STOP")=1
+11 DO ^%ZTLOAD
+12 WRITE !,$SELECT($DATA(ZTSK):"HL7 FAST PURGE UTILITY QUEUED, TASK="_ZTSK,1:"REQUEST CANCELLED")
End DoDot:1
+13 IF '$TEST
IF ASK=0
Begin DoDot:1
+14 WRITE !,"Starting Fast Purge....",!
+15 DO PURGE
End DoDot:1
+16 KILL ^TMP("HLEVFLAG",$JOB)
+17 QUIT
STOP ;
+1 ;entry point to ask the Fast Purge Job to stop
+2 IF $$COUNT>$G(^XTMP("HL7 FAST PURGE JOBS","STOP"))
IF $$I^HLEMU($NAME(^XTMP("HL7 FAST PURGE JOBS","STOP")),1)
+3 QUIT
COUNT() ;
+1 ;returns the number of Fast Purge Jobs that are running
+2 NEW COUNT,I
+3 SET COUNT=0
+4 FOR I=1:1:20
Begin DoDot:1
+5 LOCK ^XTMP("HL7 FAST PURGE JOBS",I):0
+6 IF '$TEST
Begin DoDot:2
+7 SET COUNT=COUNT+1
End DoDot:2
+8 IF '$TEST
Begin DoDot:2
+9 LOCK -^XTMP("HL7 FAST PURGE JOBS",I)
End DoDot:2
End DoDot:1
+10 QUIT COUNT
+11 ;
PURGE ;entry point for the FAST PURGE
+1 ;
+2 ;Variables:
+3 ; CHECKAT - next time to check in with TaskMan, Job Monitor, andEvent Logging, set every 10 minutes
+4 ; HOUR - the date and time to 1 hour precision that this process is currently purging, each hour is locked before purging
+5 ; IEN772 - entry in file 772 identified for purging
+6 ; IEN773 - entry in file 773 identified for purging
+7 ; LASTCHK - a simple count, the time is checked everytime this count reaches 500 - for efficiency, do not want to check the time after purging every entry
+8 ; CNT773 - count to report for EVENT LOGGING of entries purged (file 773)
+9 ; CNT772 - count to report for EVENT LOGGING of entries purged (file 772)
+10 ; QUIT - set to 1 when signaled to stop via TaskMan
+11 ; TIME - time currently being processed on the AI x-ref, file 773
+12 ;
+13 ;
+14 IF $GET(STOP)=1
Begin DoDot:1
+15 ;setting this flag allows the job to run outside of Process Monitorng
+16 SET ^TMP("HLEVFLAG",$JOB)="STOP"
End DoDot:1
+17 ;
+18 NEW LCNT,CNT773,CNT772,HOUR,LASTCHK,TIME,IEN772,IEN773,CHECKAT,QUIT,VAR,I
+19 SET (TIME,HOUR,CNT773,CNT772,LCOUNT,QUIT)=0
+20 ;
+21 DO START^HLEVAPI(.VAR)
+22 ;
+23 SET CHECKAT=$$FMADD^XLFDT($$NOW^XLFDT,,,10)
+24 ;
+25 ;let everyone know that there is 1 more purge job running - maximum of 20 Fast Purges running at once
+26 FOR I=1:1:20
LOCK ^XTMP("HL7 FAST PURGE JOBS",I):0
if $TEST
QUIT
+27 ;
+28 ;loop until signaled to stop or there is no work for a while
+29 IF $TEST
FOR
Begin DoDot:1
+30 if 'TIME
SET HOUR=$$FINDHOUR(HOUR)
if HOUR
SET TIME=HOUR-.00000001
+31 ;
+32 ;wasn't able to get an hour to lock
+33 IF 'HOUR
Begin DoDot:2
+34 ;
+35 ;if there has been no work for a while then quit
+36 IF $$NOW^XLFDT>CHECKAT
IF CNT773<2000
Begin DoDot:3
+37 SET QUIT=$$CHECKIN(.CHECKAT,.CNT773,.CNT772,.LCOUNT)
+38 SET QUIT=1
End DoDot:3
+39 IF '$TEST
Begin DoDot:3
+40 SET QUIT=$$CHECKIN(.CHECKAT,.CNT773,.CNT772,.LCOUNT)
+41 DO EVENT(.CNT773,.CNT772)
+42 if QUIT
QUIT
+43 DO PAUSE
End DoDot:3
End DoDot:2
QUIT
+44 ;
+45 ;at this point, an hour has been locked, so delete all the entries for that hour
+46 FOR
SET TIME=$ORDER(^HLMA("AI",TIME))
Begin DoDot:2
+47 IF ('TIME)!($EXTRACT(TIME,1,10)>HOUR)
SET TIME=0
QUIT
+48 SET LCOUNT=LCOUNT+1
+49 IF LCOUNT>500
SET QUIT=$$CHECKIN(.CHECKAT,.CNT773,.CNT772,.LCOUNT)
if QUIT
QUIT
+50 SET (IEN772,IEN773)=0
+51 FOR
SET IEN773=$ORDER(^HLMA("AI",TIME,773,IEN773))
if 'IEN773
QUIT
Begin DoDot:3
+52 SET CNT773=CNT773+1
+53 DO DEL773^HLUOPT3(IEN773)
+54 ;
End DoDot:3
+55 FOR
SET IEN772=$ORDER(^HLMA("AI",TIME,772,IEN772))
if 'IEN772
QUIT
Begin DoDot:3
+56 SET CNT772=CNT772+1
+57 DO DEL772^HLUOPT3(IEN772)
End DoDot:3
+58 ;
+59 ; make sure that no more records are on this x-ref for that time - could only happen in the case of corruption of some sort
+60 KILL ^HLMA("AI",TIME)
End DoDot:2
if 'TIME
QUIT
if QUIT
QUIT
End DoDot:1
if QUIT
QUIT
+61 ;
+62 ;unlock the last hour currently being held
+63 if HOUR
LOCK -^HLMA("AI",HOUR)
+64 ;
+65 ;let everyone know that there is 1 less purge job running
+66 FOR I=1:1:20
LOCK -^XTMP("HL7 FAST PURGE JOBS",I)
+67 DO CHECKOUT^HLEVAPI
+68 KILL ^TMP("HLEVFLAG",$JOB)
+69 QUIT
+70 ;
PAUSE ;sleep for 10 SECONDS
+1 HANG 10
+2 QUIT
+3 ;
CHECKIN(CHECKAT,CNT773,CNT772,LCOUNT) ;
+1 ;if NOW>CHECKAT then:
+2 ; 1) check in with TaskMan
+3 ; 2) send a new event to the event monitor
+4 ; 3) reset CHECKAT for 10 minutes in the future
+5 ; 4) as an alternative to TaskMan, check if special Stop Fast Purge option has been used
+6 ;
+7 ;Input:
+8 ; CHECKAT - the end of the current 10 minute time period
+9 ; CNT773 - number of records in file 773 purged since the last time Event Logging was updated
+10 ; CNT772 - number of records in file 772 purged since the last time Event Logging was updated
+11 ;Output:
+12 ; Function returns 1 if the Fast Purge should stop, 0 otherwise
+13 ; LCOUNT is reset to 0 **pass by reference**
+14 ; CNT773 and CNT772 are set to 0 if reported to Event Logging **pass by reference**
+15 ; CHECKAT is reset to 10 minute sin the future if the time is up **pass by reference**
+16 ;
+17 NEW NOW,QUIT
+18 SET QUIT=0
+19 ;
+20 SET NOW=$$NOW^XLFDT
+21 IF NOW>CHECKAT
Begin DoDot:1
+22 DO EVENT(.CNT773,.CNT772)
+23 SET CHECKAT=$$FMADD^XLFDT(NOW,,,10)
+24 IF '$DATA(ZTQUEUED)
Begin DoDot:2
+25 WRITE "."
End DoDot:2
+26 IF '$TEST
Begin DoDot:2
+27 ;check in with the Job Monitor
+28 DO CHECKIN^HLEVAPI
+29 SET QUIT=$$S^ZTLOAD
+30 if QUIT
SET ZTSTOP=1
End DoDot:2
End DoDot:1
+31 ;
+32 ;Check if the special option has been used to stop the purge
+33 IF $GET(^XTMP("HL7 FAST PURGE JOBS","STOP"))>0
Begin DoDot:1
+34 SET QUIT=1
+35 IF $$I^HLEMU($NAME(^XTMP("HL7 FAST PURGE JOBS","STOP")),-1)
End DoDot:1
+36 ;
+37 SET LCOUNT=0
+38 QUIT QUIT
+39 ;
FINDHOUR(HOUR) ;
+1 ;Finds the next dt/tm to the hour on the AI x-ref of file 773 that can be locked, returns 0 on failure
+2 NEW QUIT,NOW
+3 SET QUIT=0
+4 ;
+5 ;unlock the last hour currently being held
+6 if HOUR
LOCK -^HLMA("AI",HOUR)
+7 ;
+8 SET NOW=$$NOW^XLFDT
+9 ;
+10 ;if this is the first time through then start with the first entry on the x-ref
+11 IF 'HOUR
Begin DoDot:1
+12 SET HOUR=$ORDER(^HLMA("AI",0))
+13 ;
+14 ;any records to purge?
+15 IF 'HOUR
SET QUIT=1
QUIT
+16 ;
+17 ;if so, quit if the next purgeable record is for the future
+18 IF HOUR>NOW
SET HOUR=0
QUIT
+19 ;
+20 SET HOUR=$EXTRACT(HOUR,1,10)
+21 LOCK +^HLMA("AI",+HOUR):0
if $TEST
SET QUIT=1
End DoDot:1
if QUIT
QUIT HOUR
+22 ;
+23 SET HOUR=$EXTRACT(HOUR,1,10)
+24 FOR
Begin DoDot:1
+25 ;
+26 ;look for the next entry at least 1 hour in the future
+27 SET HOUR=$$FMADD^XLFDT(HOUR,,1)-.000000001
+28 SET HOUR=$EXTRACT($ORDER(^HLMA("AI",HOUR)),1,10)
+29 IF 'HOUR
SET QUIT=1
QUIT
+30 ;
+31 ;I the hour is in the future then the entries can not yet be purged
+32 IF (HOUR>NOW)
SET HOUR=0
SET QUIT=1
QUIT
+33 ;
+34 ;check if this hour can be locked, if so this is the hour to be purged
+35 LOCK +^HLMA("AI",+HOUR):0
IF $TEST
SET QUIT=1
End DoDot:1
if QUIT
QUIT
+36 ;
+37 QUIT HOUR
+38 ;
EVENT(CNT773,CNT772) ;
+1 ;add the last number of records purged to event logging
+2 NEW EVENT
+3 IF CNT773
Begin DoDot:1
+4 SET EVENT=$$EVENT^HLEME("773 PURGE","HEALTH LEVEL SEVEN")
+5 IF CNT773>1
IF $$INC^HLEME(EVENT,CNT773-1)
+6 SET CNT773=0
End DoDot:1
+7 IF CNT772
Begin DoDot:1
+8 SET EVENT=$$EVENT^HLEME("772 PURGE","HEALTH LEVEL SEVEN")
+9 IF CNT772>1
IF $$INC^HLEME(EVENT,CNT772-1)
+10 SET CNT772=0
End DoDot:1
+11 QUIT
+12 ;
CHECK1() ;called by the Master Job to determine whether
+1 ;FAST HL7 PURGE #1 should run.
+2 ;Output:
+3 ; function returns 1 if yes, 0 if no
+4 ;
+5 IF $$COUNT^HLEVAPI3("FAST HL7 PURGE #1")
+6 QUIT '$TEST
+7 ;
CHECK2() ;called by the Master Job to determine whether
+1 ;FAST HL7 PURGE #2 should run.
+2 ;Output:
+3 ; function returns 1 if yes, 0 if no
+4 ;
+5 IF $$COUNT^HLEVAPI3("FAST HL7 PURGE #1")
IF '$$COUNT^HLEVAPI3("FAST HL7 PURGE #2")
+6 QUIT $TEST
