- HLUOPT4 ;OIFO-O/LJA - Purging Entries in file #772 and #773 ;02/04/2004 16:37
- ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13, 1995
- ;
- ; This routine was created by patch HL*1.6*109
- ;
- SHOW120 ; Call SHOWXTMP with 30 second redisplay...
- D SHOWXTMP(120)
- QUIT
- ;
- ASKSHOW ; Ask whether want to monitor purging job progress...
- N ACTION,XTMP
- S XTMP=$O(^XTMP("HLUOPT1 9999999.999999"),-1) QUIT:XTMP'["HLUOPT1 " ;->
- W !!,"As purging jobs run, they record critical information in the ^XTMP global for"
- W !,"later review. (This information is updated every two minutes.) You can view"
- W !,"purge information now..."
- F S ACTION=$$ACTION QUIT:'ACTION D
- . I ACTION=1 D SHOWALL^HLUOPT5(XTMP)
- . I ACTION=2 D SHOWXTMP(120)
- . I ACTION=3 D
- . . W @IOF
- . . D GRAPH^HLUOPT5
- . . S X=$$BTE^HLCSMON("Press RETURN to continue... ",1)
- QUIT
- ;
- ACTION() ;
- N DIR,DIRUT,DTOUT,DUOUT,X,Y
- S DIR(0)="S^1:Display all available purging data (full screen);2:Display purging summary (single line);3:Display purging graph;4:Exit."
- S DIR("?",1)="Option #1 displays all available purging data, for the last job."
- S DIR("?",2)=""
- S DIR("?",3)="Option #2 displays the most valuable purging data, but not all data. This"
- S DIR("?",4)="option includes data for the last purging job, plus previous puring jobs."
- S DIR("?",5)=""
- S DIR("?")="Option #3 displays purging times and totals in a graphic representation."
- D ^DIR
- QUIT $S(+Y=1:1,+Y=2:2,+Y=3:3,1:"")
- ;
- SHOWXTMP(SEC) ; Continual redisplay of purging progress ever SEC seconds...
- N ABORT,ACTIVE,HDR,IOINHI,IOINORM,X,XTMP
- ;
- S X="IOINHI;IOINORM" D ENDR^%ZISS
- S HDR=" Task-Number Start-Time Timestamp Finish-time 772@ 773@ Time-NOW"
- ;
- ; Get last purging process' XTMP...
- S XTMP=$O(^XTMP("HLUOPT1 9999999.999999"),-1)
- S ACTIVE=0 ; Default...
- I XTMP]"" S X=$P($G(^XTMP(XTMP,"RUN")),U,4) I X'?7N.E S ACTIVE=1
- ;
- ; Show last 10 runs...
- D SHOWNUM($S(ACTIVE:9,1:18))
- ;
- ; Redisplay SEC defaults to 30...
- S SEC=$S($G(SEC)>0:+SEC,1:30)
- ;
- ; What if no purging process exists?
- I XTMP']""!('ACTIVE) D QUIT ;->
- . W !!,"There is no currently running purge job..."
- . S X=$$BTE^HLCSMON("Press RETURN to exit... ",1)
- ;
- W !!,"Any old jobs that exist will be shown above. The current (or last) purge job"
- W !,"is shown below. The information on each line will automatically refresh"
- W !,"every ",SEC," seconds (or whenever you press RETURN.)"
- W !!,IOINHI,"Note!!",IOINORM," Enter '^' when you are ready to exit."
- W !!,"Current (or last) purge job..."
- W !
- S CT=0
- ;
- F D QUIT:ABORT
- . S ABORT=1,CT=CT+1
- . D LINERUN(XTMP)
- . R X:SEC QUIT:X]"" ;-> Quit if they enter anything
- . I CT>17 W ! S CT=0
- . S ABORT=0
- ;
- QUIT
- ;
- SHOWNUM(NUM) ; Show last NUM entries...
- N CT,HOLD,XTMP
- ; ACTIVE -- req
- S XTMP="HLUOPT1 9999999.99999"
- ; If last job is active, don't include it in array...
- I ACTIVE S XTMP=$O(^XTMP(XTMP),-1) QUIT:XTMP'["HLUOPT1 " ;->
- S CT=0
- F S XTMP=$O(^XTMP(XTMP),-1) Q:(CT>(NUM-1))!(XTMP'["HLUOPT1 ") D
- . S CT=CT+1
- . S HOLD(XTMP)=""
- QUIT:'$D(HOLD) ;->
- W !!,"Recent purge runs..."
- W !!,HDR,!,$$REPEAT^XLFSTR("-",IOM)
- S XTMP=""
- F S XTMP=$O(HOLD(XTMP)) Q:XTMP']"" D
- . D LINERUN(XTMP)
- QUIT
- ;
- LINERUN(XTMP) ; Display one line...
- N I,PCE1,PCE2,PCE3,PCE4,PCE5,PCE6,PCE7,PCE8,PCE9,PCE10,PCE11
- N PCE12,PCE13,PCE14
- S RUN=$G(^XTMP(XTMP,"RUN"))
- F I=1:1:14 S @("PCE"_I)=$P(RUN,U,I)
- S PCE2=$$SDT(PCE2),PCE3=$$SDT(PCE3),PCE4=$$SDT(PCE4)
- I ($P(PCE2,"@"))=$$SDT(DT) S PCE3=" "_$P(PCE3,"@",2)
- I ($P(PCE2,"@"))=$$SDT(DT) S PCE4=" "_$P(PCE4,"@",2)
- I CT=1 W !,HDR,!,$$REPEAT^XLFSTR("-",IOM)
- W !,$J(PCE1,12),?14,PCE2,?26,PCE3,?38,PCE4,?50,$J(PCE8,8)
- W ?59,$J(PCE10,8)
- W ?69,$$SDT($$NOW^XLFDT)
- QUIT
- ;
- SDT(DATE) ; Return shortened form of date...
- I DATE?7N QUIT $E(DATE,4,5)_"/"_$E(DATE,6,7) ;->
- I DATE?7N1"."1.N QUIT $E(DATE,4,5)_"/"_$E(DATE,6,7)_"@"_$E($P($$FMTE^XLFDT(DATE),"@",2),1,5)
- QUIT ""
- ;
- XTMPBEGN ; Initialize ^XTMP nodes for use in purging monitoring...
- N NOW
- S NOW=$$NOW^XLFDT,XTMP="HLUOPT1 "_NOW
- S ^XTMP(XTMP,0)=$$FMADD^XLFDT(NOW,14)_U_NOW_U_$G(DUZ)_U_"HLUOPT1 Purging"
- S ^XTMP(XTMP,"RUN")=$G(ZTSK)_U_NOW_U_NOW_U_U_"RUNNING"_U_"XTMPBEGN"
- QUIT
- ;
- XTMPUPD(XTMP,STATUS,WHERE) ; Update the data in purging's ^XTMP...
- N NOW,RUN
- ;
- ; Required variables...
- S NOW=$$NOW^XLFDT
- ;
- ; Update node...
- S RUN=$G(^XTMP(XTMP,"RUN"))
- S $P(RUN,U,3)=$$NOW^XLFDT ; Timestamp
- I STATUS="FINISHED"!(STATUS["ABORTED") S $P(RUN,U,4)=NOW ; Finish time
- S $P(RUN,U,5)=STATUS ; Status
- S $P(RUN,U,6)=WHERE ; Whereabouts
- S $P(RUN,U,7)=$G(XTMP(772,"REV")) ; # 772 reviewed
- S $P(RUN,U,8)=$G(XTMP(772,"DEL")) ; # 772 deleted
- S $P(RUN,U,9)=$G(XTMP(773,"REV")) ; # 773 reviewed
- S $P(RUN,U,10)=$G(XTMP(773,"DEL")) ;# 773 deleted
- S $P(RUN,U,11)=$G(XTMP(772,"LAST")) ; Last 772 IEN
- S $P(RUN,U,12)=$G(XTMP(772,"FAIL")) ; # failed purge check (in a row)
- S $P(RUN,U,13)=$G(XTMP(773,"LAST")) ; Last 773 IEN
- S $P(RUN,U,14)=$G(XTMP(773,"FAIL")) ; # failed purge check (in a row)
- S $P(RUN,U,15)=$G(XTMP(772,"LAST","TIME")) ; Last 772s .01 time
- S $P(RUN,U,16)=$G(XTMP(773,"LAST","TIME")) ; Last 773's 772s .01 time
- S ^XTMP(XTMP,"RUN")=RUN
- ;
- QUIT
- ;
- LOCKTELL ; Process is locked, so new purge job can't be started...
- N X
- W !!,"The '^HL(""HLUOPT1"")' lock is already owned by another purge job! So, this"
- W !,"purge job cannot be started."
- S X=$$BTE^HLCSMON("Press RETURN to exit... ",1)
- QUIT
- ;
- INIT ; Moved here from HLUOPT1 (ran out of room)
- ; If no data are stored in file 869.3, fields 41, 42, and 43,
- ; the default number for these fields is 7, 30, 90, respectively.
- N I,HLIEN,HLREC,HLDEF
- S HLDEF="7^30^90^90"
- S HLIEN=+$O(^HLCS(869.3,0))
- S HLREC=$S(HLIEN:$G(^HLCS(869.3,HLIEN,4)),1:"")
- F I=1:1:4 I '$P(HLREC,U,I) S $P(HLREC,U,I)=$P(HLDEF,U,I)
- ;
- ; If AWAITING ACK<COMPLETED -- or -- AWAITING ACK > ALL -- or -- PURGE < ALL use the default values (for an invalid date(s) has been entered into the paramters)
- I $P(HLREC,U,2)<$P(HLREC,U,1)!($P(HLREC,U,3)<$P(HLREC,U,2))!($P(HLREC,U,3)>$P(HLREC,U,4)) D
- . S HLREC=HLDEF
- ;
- I $D(ZTQUEUED) D Q
- . S HLPDT("COMP")=$$FMADD^XLFDT(DT,-$P(HLREC,U,1))_.9
- . S HLPDT("WAIT")=$$FMADD^XLFDT(DT,-$P(HLREC,U,2))_.9
- . S HLPDT("ALL")=$$FMADD^XLFDT(DT,-$P(HLREC,U,3))_.9
- . S HLPDT("ERR")=$$FMADD^XLFDT(DT,-$P(HLREC,U,4))_.9
- ;
- ; get input data from user
- N DIR,X,Y,DIRUT
- ; input cutoff date for "Successfully Completed" messages
- S DIR(0)="D^:"_$$FMADD^XLFDT(DT,-1)_":EX"
- S DIR("A",1)=" Enter inclusive date up to which to purge SUCCESSFULLY COMPLETED"
- S DIR("A")=" messages"
- S DIR("B")="T"_-$P(HLREC,U,1)
- S DIR("?",1)=" The suggested cutoff date to purge 'Successfully Completed' messages"
- S DIR("?",2)=" is seven days prior to today."
- S DIR("?")=" Must be on or before "_$$FMTE^XLFDT($$FMADD^XLFDT(DT,-1),2)_"."
- W ! D ^DIR I $D(DIRUT) S HLEXIT=1 Q
- S HLPDT("COMP")=Y
- K DIR
- ;
- ; input cutoff date for "Awaiting Acknowledgement" messages
- S DIR(0)="D^:"_HLPDT("COMP")_":EX"
- S DIR("A",1)=" Enter inclusive date up to which to purge AWAITING ACK"
- S DIR("A")=" messages"
- S DIR("B")="T"_-$P(HLREC,U,2)
- S DIR("?",1)=" The suggested cutoff date to purge 'Awaiting Acknowledgment' messages"
- S DIR("?",2)=" is thirty days prior to today."
- S DIR("?")=" Must be on or before "_$$FMTE^XLFDT(HLPDT("COMP"),2)_"."
- W ! D ^DIR I $D(DIRUT) S HLEXIT=1 Q
- S HLPDT("WAIT")=Y
- K DIR
- ;
- ; Input for Vaporization Date
- S DIR(0)="D^:"_HLPDT("WAIT")_":EX"
- S DIR("A",1)=" Enter inclusive date up to which to purge all messages, regardless"
- S DIR("A")=" of status (except ERROR status)"
- S DIR("B")="T"_-$P(HLREC,U,3)
- S DIR("?",1)=" The suggested cutoff date to purge all messages (except for 'Error' messages)"
- S DIR("?",2)=" is 90 days prior to today."
- S DIR("?")=" Must be on or before "_$$FMTE^XLFDT(HLPDT("WAIT"),2)_"."
- W ! D ^DIR I $D(DIRUT) S HLEXIT=1 Q
- S HLPDT("ALL")=Y+.9
- K DIR
- ;
- ; prompt whether to purge "Error" messages
- S DIR(0)="Y"
- S DIR("A")=" Do you also want to purge messages with an ERROR status"
- S DIR("B")="NO"
- S DIR("?",1)=" Enter 'Yes' to purge entries whose status is 'error'."
- S DIR("?",2)=" If you have reviewed/resolved the cause of the problem of those",DIR("?")=" entries with an 'error' status answer 'Yes'. Otherwise answer 'No'."
- W ! D ^DIR I $D(DIRUT) S HLEXIT=1 Q
- K DIR
- I 'Y S HLPDT("ERR")=0
- E D Q:HLEXIT
- . ; input cutoff date for "Error" messages
- . S DIR(0)="D^:"_HLPDT("WAIT")_":EX"
- . S DIR("A",1)=" WARNING: You should have investigated all errors because purging"
- . S DIR("A",2)=" these messages permanently removes them from the system."
- . S DIR("A",3)=" "
- . S DIR("A",4)=" Enter inclusive date up to which to purge ERROR"
- . S DIR("A")=" messages"
- . S DIR("B")="T"_-$P(HLREC,U,4)
- . S DIR("?",1)=" The suggested cutoff date to purge 'Error' messages"
- . S DIR("?",2)=" is 90 days prior to today."
- . S DIR("?")=" Must be on or before "_$$FMTE^XLFDT(HLPDT("WAIT"),2)_"."
- . W ! D ^DIR I $D(DIRUT) S HLEXIT=1 Q
- . S HLPDT("ERR")=Y+.9
- . K DIR
- ;
- ; prompt whether to run this purge in the background
- S DIR(0)="YA"
- S DIR("A")=" Would you like to queue this purge? "
- S DIR("B")="YES"
- S DIR("?")=" If run in the foreground, you will see dots and a total count."
- W ! D ^DIR I $D(DIRUT) S HLEXIT=1 Q
- S HLTASK=Y
- K DIR
- W !," "
- ;
- S HLPDT("COMP")=HLPDT("COMP")+.9,HLPDT("WAIT")=HLPDT("WAIT")+.9
- Q
- ;
- EOR ;HLUOPT4 - Purging Entries in file #772 and #773 ;12/10/02 16:37
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLUOPT4 9683 printed Feb 18, 2025@23:26:46 Page 2
- HLUOPT4 ;OIFO-O/LJA - Purging Entries in file #772 and #773 ;02/04/2004 16:37
- +1 ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13, 1995
- +2 ;
- +3 ; This routine was created by patch HL*1.6*109
- +4 ;
- SHOW120 ; Call SHOWXTMP with 30 second redisplay...
- +1 DO SHOWXTMP(120)
- +2 QUIT
- +3 ;
- ASKSHOW ; Ask whether want to monitor purging job progress...
- +1 NEW ACTION,XTMP
- +2 ;->
- SET XTMP=$ORDER(^XTMP("HLUOPT1 9999999.999999"),-1)
- if XTMP'["HLUOPT1 "
- QUIT
- +3 WRITE !!,"As purging jobs run, they record critical information in the ^XTMP global for"
- +4 WRITE !,"later review. (This information is updated every two minutes.) You can view"
- +5 WRITE !,"purge information now..."
- +6 FOR
- SET ACTION=$$ACTION
- if 'ACTION
- QUIT
- Begin DoDot:1
- +7 IF ACTION=1
- DO SHOWALL^HLUOPT5(XTMP)
- +8 IF ACTION=2
- DO SHOWXTMP(120)
- +9 IF ACTION=3
- Begin DoDot:2
- +10 WRITE @IOF
- +11 DO GRAPH^HLUOPT5
- +12 SET X=$$BTE^HLCSMON("Press RETURN to continue... ",1)
- End DoDot:2
- End DoDot:1
- +13 QUIT
- +14 ;
- ACTION() ;
- +1 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
- +2 SET DIR(0)="S^1:Display all available purging data (full screen);2:Display purging summary (single line);3:Display purging graph;4:Exit."
- +3 SET DIR("?",1)="Option #1 displays all available purging data, for the last job."
- +4 SET DIR("?",2)=""
- +5 SET DIR("?",3)="Option #2 displays the most valuable purging data, but not all data. This"
- +6 SET DIR("?",4)="option includes data for the last purging job, plus previous puring jobs."
- +7 SET DIR("?",5)=""
- +8 SET DIR("?")="Option #3 displays purging times and totals in a graphic representation."
- +9 DO ^DIR
- +10 QUIT $SELECT(+Y=1:1,+Y=2:2,+Y=3:3,1:"")
- +11 ;
- SHOWXTMP(SEC) ; Continual redisplay of purging progress ever SEC seconds...
- +1 NEW ABORT,ACTIVE,HDR,IOINHI,IOINORM,X,XTMP
- +2 ;
- +3 SET X="IOINHI;IOINORM"
- DO ENDR^%ZISS
- +4 SET HDR=" Task-Number Start-Time Timestamp Finish-time 772@ 773@ Time-NOW"
- +5 ;
- +6 ; Get last purging process' XTMP...
- +7 SET XTMP=$ORDER(^XTMP("HLUOPT1 9999999.999999"),-1)
- +8 ; Default...
- SET ACTIVE=0
- +9 IF XTMP]""
- SET X=$PIECE($GET(^XTMP(XTMP,"RUN")),U,4)
- IF X'?7N.E
- SET ACTIVE=1
- +10 ;
- +11 ; Show last 10 runs...
- +12 DO SHOWNUM($SELECT(ACTIVE:9,1:18))
- +13 ;
- +14 ; Redisplay SEC defaults to 30...
- +15 SET SEC=$SELECT($GET(SEC)>0:+SEC,1:30)
- +16 ;
- +17 ; What if no purging process exists?
- +18 ;->
- IF XTMP']""!('ACTIVE)
- Begin DoDot:1
- +19 WRITE !!,"There is no currently running purge job..."
- +20 SET X=$$BTE^HLCSMON("Press RETURN to exit... ",1)
- End DoDot:1
- QUIT
- +21 ;
- +22 WRITE !!,"Any old jobs that exist will be shown above. The current (or last) purge job"
- +23 WRITE !,"is shown below. The information on each line will automatically refresh"
- +24 WRITE !,"every ",SEC," seconds (or whenever you press RETURN.)"
- +25 WRITE !!,IOINHI,"Note!!",IOINORM," Enter '^' when you are ready to exit."
- +26 WRITE !!,"Current (or last) purge job..."
- +27 WRITE !
- +28 SET CT=0
- +29 ;
- +30 FOR
- Begin DoDot:1
- +31 SET ABORT=1
- SET CT=CT+1
- +32 DO LINERUN(XTMP)
- +33 ;-> Quit if they enter anything
- READ X:SEC
- if X]""
- QUIT
- +34 IF CT>17
- WRITE !
- SET CT=0
- +35 SET ABORT=0
- End DoDot:1
- if ABORT
- QUIT
- +36 ;
- +37 QUIT
- +38 ;
- SHOWNUM(NUM) ; Show last NUM entries...
- +1 NEW CT,HOLD,XTMP
- +2 ; ACTIVE -- req
- +3 SET XTMP="HLUOPT1 9999999.99999"
- +4 ; If last job is active, don't include it in array...
- +5 ;->
- IF ACTIVE
- SET XTMP=$ORDER(^XTMP(XTMP),-1)
- if XTMP'["HLUOPT1 "
- QUIT
- +6 SET CT=0
- +7 FOR
- SET XTMP=$ORDER(^XTMP(XTMP),-1)
- if (CT>(NUM-1))!(XTMP'["HLUOPT1 ")
- QUIT
- Begin DoDot:1
- +8 SET CT=CT+1
- +9 SET HOLD(XTMP)=""
- End DoDot:1
- +10 ;->
- if '$DATA(HOLD)
- QUIT
- +11 WRITE !!,"Recent purge runs..."
- +12 WRITE !!,HDR,!,$$REPEAT^XLFSTR("-",IOM)
- +13 SET XTMP=""
- +14 FOR
- SET XTMP=$ORDER(HOLD(XTMP))
- if XTMP']""
- QUIT
- Begin DoDot:1
- +15 DO LINERUN(XTMP)
- End DoDot:1
- +16 QUIT
- +17 ;
- LINERUN(XTMP) ; Display one line...
- +1 NEW I,PCE1,PCE2,PCE3,PCE4,PCE5,PCE6,PCE7,PCE8,PCE9,PCE10,PCE11
- +2 NEW PCE12,PCE13,PCE14
- +3 SET RUN=$GET(^XTMP(XTMP,"RUN"))
- +4 FOR I=1:1:14
- SET @("PCE"_I)=$PIECE(RUN,U,I)
- +5 SET PCE2=$$SDT(PCE2)
- SET PCE3=$$SDT(PCE3)
- SET PCE4=$$SDT(PCE4)
- +6 IF ($PIECE(PCE2,"@"))=$$SDT(DT)
- SET PCE3=" "_$PIECE(PCE3,"@",2)
- +7 IF ($PIECE(PCE2,"@"))=$$SDT(DT)
- SET PCE4=" "_$PIECE(PCE4,"@",2)
- +8 IF CT=1
- WRITE !,HDR,!,$$REPEAT^XLFSTR("-",IOM)
- +9 WRITE !,$JUSTIFY(PCE1,12),?14,PCE2,?26,PCE3,?38,PCE4,?50,$JUSTIFY(PCE8,8)
- +10 WRITE ?59,$JUSTIFY(PCE10,8)
- +11 WRITE ?69,$$SDT($$NOW^XLFDT)
- +12 QUIT
- +13 ;
- SDT(DATE) ; Return shortened form of date...
- +1 ;->
- IF DATE?7N
- QUIT $EXTRACT(DATE,4,5)_"/"_$EXTRACT(DATE,6,7)
- +2 IF DATE?7N1"."1.N
- QUIT $EXTRACT(DATE,4,5)_"/"_$EXTRACT(DATE,6,7)_"@"_$EXTRACT($PIECE($$FMTE^XLFDT(DATE),"@",2),1,5)
- +3 QUIT ""
- +4 ;
- XTMPBEGN ; Initialize ^XTMP nodes for use in purging monitoring...
- +1 NEW NOW
- +2 SET NOW=$$NOW^XLFDT
- SET XTMP="HLUOPT1 "_NOW
- +3 SET ^XTMP(XTMP,0)=$$FMADD^XLFDT(NOW,14)_U_NOW_U_$GET(DUZ)_U_"HLUOPT1 Purging"
- +4 SET ^XTMP(XTMP,"RUN")=$GET(ZTSK)_U_NOW_U_NOW_U_U_"RUNNING"_U_"XTMPBEGN"
- +5 QUIT
- +6 ;
- XTMPUPD(XTMP,STATUS,WHERE) ; Update the data in purging's ^XTMP...
- +1 NEW NOW,RUN
- +2 ;
- +3 ; Required variables...
- +4 SET NOW=$$NOW^XLFDT
- +5 ;
- +6 ; Update node...
- +7 SET RUN=$GET(^XTMP(XTMP,"RUN"))
- +8 ; Timestamp
- SET $PIECE(RUN,U,3)=$$NOW^XLFDT
- +9 ; Finish time
- IF STATUS="FINISHED"!(STATUS["ABORTED")
- SET $PIECE(RUN,U,4)=NOW
- +10 ; Status
- SET $PIECE(RUN,U,5)=STATUS
- +11 ; Whereabouts
- SET $PIECE(RUN,U,6)=WHERE
- +12 ; # 772 reviewed
- SET $PIECE(RUN,U,7)=$GET(XTMP(772,"REV"))
- +13 ; # 772 deleted
- SET $PIECE(RUN,U,8)=$GET(XTMP(772,"DEL"))
- +14 ; # 773 reviewed
- SET $PIECE(RUN,U,9)=$GET(XTMP(773,"REV"))
- +15 ;# 773 deleted
- SET $PIECE(RUN,U,10)=$GET(XTMP(773,"DEL"))
- +16 ; Last 772 IEN
- SET $PIECE(RUN,U,11)=$GET(XTMP(772,"LAST"))
- +17 ; # failed purge check (in a row)
- SET $PIECE(RUN,U,12)=$GET(XTMP(772,"FAIL"))
- +18 ; Last 773 IEN
- SET $PIECE(RUN,U,13)=$GET(XTMP(773,"LAST"))
- +19 ; # failed purge check (in a row)
- SET $PIECE(RUN,U,14)=$GET(XTMP(773,"FAIL"))
- +20 ; Last 772s .01 time
- SET $PIECE(RUN,U,15)=$GET(XTMP(772,"LAST","TIME"))
- +21 ; Last 773's 772s .01 time
- SET $PIECE(RUN,U,16)=$GET(XTMP(773,"LAST","TIME"))
- +22 SET ^XTMP(XTMP,"RUN")=RUN
- +23 ;
- +24 QUIT
- +25 ;
- LOCKTELL ; Process is locked, so new purge job can't be started...
- +1 NEW X
- +2 WRITE !!,"The '^HL(""HLUOPT1"")' lock is already owned by another purge job! So, this"
- +3 WRITE !,"purge job cannot be started."
- +4 SET X=$$BTE^HLCSMON("Press RETURN to exit... ",1)
- +5 QUIT
- +6 ;
- INIT ; Moved here from HLUOPT1 (ran out of room)
- +1 ; If no data are stored in file 869.3, fields 41, 42, and 43,
- +2 ; the default number for these fields is 7, 30, 90, respectively.
- +3 NEW I,HLIEN,HLREC,HLDEF
- +4 SET HLDEF="7^30^90^90"
- +5 SET HLIEN=+$ORDER(^HLCS(869.3,0))
- +6 SET HLREC=$SELECT(HLIEN:$GET(^HLCS(869.3,HLIEN,4)),1:"")
- +7 FOR I=1:1:4
- IF '$PIECE(HLREC,U,I)
- SET $PIECE(HLREC,U,I)=$PIECE(HLDEF,U,I)
- +8 ;
- +9 ; If AWAITING ACK<COMPLETED -- or -- AWAITING ACK > ALL -- or -- PURGE < ALL use the default values (for an invalid date(s) has been entered into the paramters)
- +10 IF $PIECE(HLREC,U,2)<$PIECE(HLREC,U,1)!($PIECE(HLREC,U,3)<$PIECE(HLREC,U,2))!($PIECE(HLREC,U,3)>$PIECE(HLREC,U,4))
- Begin DoDot:1
- +11 SET HLREC=HLDEF
- End DoDot:1
- +12 ;
- +13 IF $DATA(ZTQUEUED)
- Begin DoDot:1
- +14 SET HLPDT("COMP")=$$FMADD^XLFDT(DT,-$PIECE(HLREC,U,1))_.9
- +15 SET HLPDT("WAIT")=$$FMADD^XLFDT(DT,-$PIECE(HLREC,U,2))_.9
- +16 SET HLPDT("ALL")=$$FMADD^XLFDT(DT,-$PIECE(HLREC,U,3))_.9
- +17 SET HLPDT("ERR")=$$FMADD^XLFDT(DT,-$PIECE(HLREC,U,4))_.9
- End DoDot:1
- QUIT
- +18 ;
- +19 ; get input data from user
- +20 NEW DIR,X,Y,DIRUT
- +21 ; input cutoff date for "Successfully Completed" messages
- +22 SET DIR(0)="D^:"_$$FMADD^XLFDT(DT,-1)_":EX"
- +23 SET DIR("A",1)=" Enter inclusive date up to which to purge SUCCESSFULLY COMPLETED"
- +24 SET DIR("A")=" messages"
- +25 SET DIR("B")="T"_-$PIECE(HLREC,U,1)
- +26 SET DIR("?",1)=" The suggested cutoff date to purge 'Successfully Completed' messages"
- +27 SET DIR("?",2)=" is seven days prior to today."
- +28 SET DIR("?")=" Must be on or before "_$$FMTE^XLFDT($$FMADD^XLFDT(DT,-1),2)_"."
- +29 WRITE !
- DO ^DIR
- IF $DATA(DIRUT)
- SET HLEXIT=1
- QUIT
- +30 SET HLPDT("COMP")=Y
- +31 KILL DIR
- +32 ;
- +33 ; input cutoff date for "Awaiting Acknowledgement" messages
- +34 SET DIR(0)="D^:"_HLPDT("COMP")_":EX"
- +35 SET DIR("A",1)=" Enter inclusive date up to which to purge AWAITING ACK"
- +36 SET DIR("A")=" messages"
- +37 SET DIR("B")="T"_-$PIECE(HLREC,U,2)
- +38 SET DIR("?",1)=" The suggested cutoff date to purge 'Awaiting Acknowledgment' messages"
- +39 SET DIR("?",2)=" is thirty days prior to today."
- +40 SET DIR("?")=" Must be on or before "_$$FMTE^XLFDT(HLPDT("COMP"),2)_"."
- +41 WRITE !
- DO ^DIR
- IF $DATA(DIRUT)
- SET HLEXIT=1
- QUIT
- +42 SET HLPDT("WAIT")=Y
- +43 KILL DIR
- +44 ;
- +45 ; Input for Vaporization Date
- +46 SET DIR(0)="D^:"_HLPDT("WAIT")_":EX"
- +47 SET DIR("A",1)=" Enter inclusive date up to which to purge all messages, regardless"
- +48 SET DIR("A")=" of status (except ERROR status)"
- +49 SET DIR("B")="T"_-$PIECE(HLREC,U,3)
- +50 SET DIR("?",1)=" The suggested cutoff date to purge all messages (except for 'Error' messages)"
- +51 SET DIR("?",2)=" is 90 days prior to today."
- +52 SET DIR("?")=" Must be on or before "_$$FMTE^XLFDT(HLPDT("WAIT"),2)_"."
- +53 WRITE !
- DO ^DIR
- IF $DATA(DIRUT)
- SET HLEXIT=1
- QUIT
- +54 SET HLPDT("ALL")=Y+.9
- +55 KILL DIR
- +56 ;
- +57 ; prompt whether to purge "Error" messages
- +58 SET DIR(0)="Y"
- +59 SET DIR("A")=" Do you also want to purge messages with an ERROR status"
- +60 SET DIR("B")="NO"
- +61 SET DIR("?",1)=" Enter 'Yes' to purge entries whose status is 'error'."
- +62 SET DIR("?",2)=" If you have reviewed/resolved the cause of the problem of those"
- SET DIR("?")=" entries with an 'error' status answer 'Yes'. Otherwise answer 'No'."
- +63 WRITE !
- DO ^DIR
- IF $DATA(DIRUT)
- SET HLEXIT=1
- QUIT
- +64 KILL DIR
- +65 IF 'Y
- SET HLPDT("ERR")=0
- +66 IF '$TEST
- Begin DoDot:1
- +67 ; input cutoff date for "Error" messages
- +68 SET DIR(0)="D^:"_HLPDT("WAIT")_":EX"
- +69 SET DIR("A",1)=" WARNING: You should have investigated all errors because purging"
- +70 SET DIR("A",2)=" these messages permanently removes them from the system."
- +71 SET DIR("A",3)=" "
- +72 SET DIR("A",4)=" Enter inclusive date up to which to purge ERROR"
- +73 SET DIR("A")=" messages"
- +74 SET DIR("B")="T"_-$PIECE(HLREC,U,4)
- +75 SET DIR("?",1)=" The suggested cutoff date to purge 'Error' messages"
- +76 SET DIR("?",2)=" is 90 days prior to today."
- +77 SET DIR("?")=" Must be on or before "_$$FMTE^XLFDT(HLPDT("WAIT"),2)_"."
- +78 WRITE !
- DO ^DIR
- IF $DATA(DIRUT)
- SET HLEXIT=1
- QUIT
- +79 SET HLPDT("ERR")=Y+.9
- +80 KILL DIR
- End DoDot:1
- if HLEXIT
- QUIT
- +81 ;
- +82 ; prompt whether to run this purge in the background
- +83 SET DIR(0)="YA"
- +84 SET DIR("A")=" Would you like to queue this purge? "
- +85 SET DIR("B")="YES"
- +86 SET DIR("?")=" If run in the foreground, you will see dots and a total count."
- +87 WRITE !
- DO ^DIR
- IF $DATA(DIRUT)
- SET HLEXIT=1
- QUIT
- +88 SET HLTASK=Y
- +89 KILL DIR
- +90 WRITE !," "
- +91 ;
- +92 SET HLPDT("COMP")=HLPDT("COMP")+.9
- SET HLPDT("WAIT")=HLPDT("WAIT")+.9
- +93 QUIT
- +94 ;
- EOR ;HLUOPT4 - Purging Entries in file #772 and #773 ;12/10/02 16:37