LRNIGHT ;SLC/CJS/AVAMC/REG - NIGHTLY LAB CLEANUP ;Mar 18, 2021@15:14
;;5.2;LAB SERVICE;**291,350,458,543,554**;Sep 27, 1994;Build 13
;
;D REQUE ;REQUED BY TASKMAN
Q:'$D(^LAB(69.9,1,0)) S:$D(ZTQUEUED) DUZ(0)="@",ZTREQ="@" K ^LRO(69,"AN") K ^LRO(69,DT-1,1,"AD") I $P(^LAB(69.9,1,0),U,14) D MANUAL
S %DT="",X="T-"_$S($P(^LAB(69.9,1,0),"^",9):$P(^(0),"^",9),1:7) D ^%DT S LRSAVE=Y
F L=0:0 S L=$O(^LRO(69,"AT",L)) Q:L'>0 F T=0:0 S T=$O(^LRO(69,"AT",L,T)) Q:T'>0 F S=0:0 S S=$O(^LRO(69,"AT",L,T,S)) Q:S'>0 S X=-LRSAVE,X1=LRSAVE F X=X:0 S X=$O(^LRO(69,"AT",L,T,S,X)) Q:X=""!(X'<X1) K ^LRO(69,"AT",L,T,S,X)
K %,%H,%X,%Y,L,LRIOZERO,LRSAVE,POP,S,T,X,X1,Z,Y
STDQC ;
;
D SUBTASKS
;
;Cleanup the XTMP("LRCAP" global
D XTMP^LRCAPPH
;
;Check roll-up date; process pending panels if appropriate date
S X=$T(EN^LRBEBA5) I X'="" D EN^LRBEBA5
;
Q
;
REQUE S ZTDTH=$H+1_",1",ZTIO="",ZTRTN="^LRNIGHT" D ^%ZTLOAD K ZTDTH,ZTIO,ZTRTN,ZTSK Q
END K DUOUT,DTOUT,%DT,LRW,D,S2,S3,S4,S5,S6,S7,S8,S9,S10,S11,S12,S13,S14,S15,LRDFN,DFN,LRCD
Q
MANUAL ;
RANGE ;
S ZTRTN="LRCAPV2",ZTIO="",ZTDTH=$H,ZTDESC="TALLY CAP WORKLOAD"
D ^%ZTLOAD
Q
;
SUBTASKS ; Task off other jobs that are initiated by LRNIGHT
;
; Protect TaskMan variables of calling tasked job
N ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZTDTH
;
;--------------------------------------------
; Analyze File 63: Organism sub-file and data.
I $T(LRNIGHT^LRWU8)'="",$E($$DT^XLFDT,6,7)="01" D
. S ZTIO="",ZTDTH=$H
. S ZTRTN="LRNIGHT^LRWU8",ZTDESC="FILE 63 ORGANISM CLEANUP"
. D ^%ZTLOAD
. K ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZTDTH
;
;--------------------------------------------
; Analyze File 63: For bad data names.
I $T(LRNIGHT^LRWU9)'="",$E($$DT^XLFDT,6,7)="01" D
. S ZTIO="",ZTDTH=$H
. S ZTRTN="LRNIGHT^LRWU9",ZTDESC="FILE 63 BAD DATA NAMES CLEANUP"
. D ^%ZTLOAD
. K ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZTDTH
;
;--------------------------------------------
; Purge eligible entries in file 95.4
I $T(PRGNIGHT^LRSRVR5)'="" D
. S ZTIO="",ZTDTH=$H
. S ZTRTN="PRGNIGHT^LRSRVR5",ZTDESC="Lab file #95.4 purge/cleanup"
. D ^%ZTLOAD
. K ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZTDTH
;
;--------------------------------------------
; Purge old entries in ^LAH global
I $T(LRNIGHT^LRVR3)'="" D
. S ZTIO="",ZTDTH=$H
. S ZTRTN="LRNIGHT^LRVR3",ZTDESC="Purge old instrument data from LAH global"
. D ^%ZTLOAD
. K ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZTDTH
;
;LR*5.2*543 - Check for orderable items which point to non-existent Lab tests
I $T(LRNIGHT^LRWU9A)'="" D
. S ZTIO="",ZTDTH=$H
. S ZTRTN="LRNIGHT^LRWU9A",ZTDESC="Check for OI's pointing to non-existent Lab tests"
. D ^%ZTLOAD
. K ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZTDTH
;
;LR*5.2*554 Purge old entries in ^LRHY global, file #69.87 - HOWDY SPECIMEN TIMES BY UID file
I $T(LRHOWDY^LRWU9A)'="" D
. S ZTIO="",ZTDTH=$H
. S ZTRTN="LRHOWDY^LRWU9A",ZTDESC="Purge 69.87 records more than 9 years old"
. D ^%ZTLOAD
. K ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZTDTH
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRNIGHT 3030 printed Apr 09, 2024@21:10:45 Page 2
LRNIGHT ;SLC/CJS/AVAMC/REG - NIGHTLY LAB CLEANUP ;Mar 18, 2021@15:14
+1 ;;5.2;LAB SERVICE;**291,350,458,543,554**;Sep 27, 1994;Build 13
+2 ;
+3 ;D REQUE ;REQUED BY TASKMAN
+4 if '$DATA(^LAB(69.9,1,0))
QUIT
if $DATA(ZTQUEUED)
SET DUZ(0)="@"
SET ZTREQ="@"
KILL ^LRO(69,"AN")
KILL ^LRO(69,DT-1,1,"AD")
IF $PIECE(^LAB(69.9,1,0),U,14)
DO MANUAL
+5 SET %DT=""
SET X="T-"_$SELECT($PIECE(^LAB(69.9,1,0),"^",9):$PIECE(^(0),"^",9),1:7)
DO ^%DT
SET LRSAVE=Y
+6 FOR L=0:0
SET L=$ORDER(^LRO(69,"AT",L))
if L'>0
QUIT
FOR T=0:0
SET T=$ORDER(^LRO(69,"AT",L,T))
if T'>0
QUIT
FOR S=0:0
SET S=$ORDER(^LRO(69,"AT",L,T,S))
if S'>0
QUIT
SET X=-LRSAVE
SET X1=LRSAVE
FOR X=X:0
SET X=$ORDER(^LRO(69,"AT",L,T,S,X))
if X=""!(X'<X1)
QUIT
KILL ^LRO(69,"AT",L,T,S,X)
+7 KILL %,%H,%X,%Y,L,LRIOZERO,LRSAVE,POP,S,T,X,X1,Z,Y
STDQC ;
+1 ;
+2 DO SUBTASKS
+3 ;
+4 ;Cleanup the XTMP("LRCAP" global
+5 DO XTMP^LRCAPPH
+6 ;
+7 ;Check roll-up date; process pending panels if appropriate date
+8 SET X=$TEXT(EN^LRBEBA5)
IF X'=""
DO EN^LRBEBA5
+9 ;
+10 QUIT
+11 ;
REQUE SET ZTDTH=$HOROLOG+1_",1"
SET ZTIO=""
SET ZTRTN="^LRNIGHT"
DO ^%ZTLOAD
KILL ZTDTH,ZTIO,ZTRTN,ZTSK
QUIT
END KILL DUOUT,DTOUT,%DT,LRW,D,S2,S3,S4,S5,S6,S7,S8,S9,S10,S11,S12,S13,S14,S15,LRDFN,DFN,LRCD
+1 QUIT
MANUAL ;
RANGE ;
+1 SET ZTRTN="LRCAPV2"
SET ZTIO=""
SET ZTDTH=$HOROLOG
SET ZTDESC="TALLY CAP WORKLOAD"
+2 DO ^%ZTLOAD
+3 QUIT
+4 ;
SUBTASKS ; Task off other jobs that are initiated by LRNIGHT
+1 ;
+2 ; Protect TaskMan variables of calling tasked job
+3 NEW ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZTDTH
+4 ;
+5 ;--------------------------------------------
+6 ; Analyze File 63: Organism sub-file and data.
+7 IF $TEXT(LRNIGHT^LRWU8)'=""
IF $EXTRACT($$DT^XLFDT,6,7)="01"
Begin DoDot:1
+8 SET ZTIO=""
SET ZTDTH=$HOROLOG
+9 SET ZTRTN="LRNIGHT^LRWU8"
SET ZTDESC="FILE 63 ORGANISM CLEANUP"
+10 DO ^%ZTLOAD
+11 KILL ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZTDTH
End DoDot:1
+12 ;
+13 ;--------------------------------------------
+14 ; Analyze File 63: For bad data names.
+15 IF $TEXT(LRNIGHT^LRWU9)'=""
IF $EXTRACT($$DT^XLFDT,6,7)="01"
Begin DoDot:1
+16 SET ZTIO=""
SET ZTDTH=$HOROLOG
+17 SET ZTRTN="LRNIGHT^LRWU9"
SET ZTDESC="FILE 63 BAD DATA NAMES CLEANUP"
+18 DO ^%ZTLOAD
+19 KILL ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZTDTH
End DoDot:1
+20 ;
+21 ;--------------------------------------------
+22 ; Purge eligible entries in file 95.4
+23 IF $TEXT(PRGNIGHT^LRSRVR5)'=""
Begin DoDot:1
+24 SET ZTIO=""
SET ZTDTH=$HOROLOG
+25 SET ZTRTN="PRGNIGHT^LRSRVR5"
SET ZTDESC="Lab file #95.4 purge/cleanup"
+26 DO ^%ZTLOAD
+27 KILL ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZTDTH
End DoDot:1
+28 ;
+29 ;--------------------------------------------
+30 ; Purge old entries in ^LAH global
+31 IF $TEXT(LRNIGHT^LRVR3)'=""
Begin DoDot:1
+32 SET ZTIO=""
SET ZTDTH=$HOROLOG
+33 SET ZTRTN="LRNIGHT^LRVR3"
SET ZTDESC="Purge old instrument data from LAH global"
+34 DO ^%ZTLOAD
+35 KILL ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZTDTH
End DoDot:1
+36 ;
+37 ;LR*5.2*543 - Check for orderable items which point to non-existent Lab tests
+38 IF $TEXT(LRNIGHT^LRWU9A)'=""
Begin DoDot:1
+39 SET ZTIO=""
SET ZTDTH=$HOROLOG
+40 SET ZTRTN="LRNIGHT^LRWU9A"
SET ZTDESC="Check for OI's pointing to non-existent Lab tests"
+41 DO ^%ZTLOAD
+42 KILL ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZTDTH
End DoDot:1
+43 ;
+44 ;LR*5.2*554 Purge old entries in ^LRHY global, file #69.87 - HOWDY SPECIMEN TIMES BY UID file
+45 IF $TEXT(LRHOWDY^LRWU9A)'=""
Begin DoDot:1
+46 SET ZTIO=""
SET ZTDTH=$HOROLOG
+47 SET ZTRTN="LRHOWDY^LRWU9A"
SET ZTDESC="Purge 69.87 records more than 9 years old"
+48 DO ^%ZTLOAD
+49 KILL ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZTDTH
End DoDot:1
+50 QUIT
