LRAC ;SLC/DCM/MILW/JMC - CUMULATIVE REPORTS DRIVER ;2/20/91 08:33 ; [ 07/22/2002 12:26 PM ]
;;5.2;LR;**1001*1013**;JUL 15, 2002
;;5.2;LAB SERVICE;**172**;Sep 27, 1994
;Routine has been change to handle separate file room scheduling.
;;Semi-automatic queuing of selected reports can occur by setting-up
;;an action type option: S LRX(x)="" D CLOCK^LRAC
;;Where 'x' is the internal number of the report desired.
;;Fields 200,201,202 of OPTION file should then be filled in.
K DIC,LRX
;
;
D ^LRPARAM ;---HOAK FOR PRINTER PROBLEMS
;
R !,"Print ALL or SELECTED reports? ALL// ",X:DTIME S:X="" X="A" Q:".^"[X
I "AaSs"'[$E(X) S X="?"
I X["?" W !?5,"Enter 'S' for SELECTED reports ",!?18,"-or-",!?11,"'A' for ALL reports" G LRAC
I "Ss"[$E(X,1) D Q:'$D(LRX)
. W ! ; Allow user to select reports to print.
. S DIC="^LAB(64.5,1,3,",DIC(0)="AEMQ",DIC("A")="Select REPORT NAME: "
. ; Screen out file room reports if printing separate file room, use appropiate option.
. I $P($G(^LAB(64.5,1,6)),U,2) S DIC("S")="I '$P($G(^LAB(64.5,1,3,Y,.1)),U,3)"
. F D ^DIC Q:Y<1 S LRX(+Y)=""
. K DIC W !
S U="^" D DT^LRX
S ZTRTN="CLOCK^LRAC",ZTIO="",ZTDESC="Laboratory cumulative report" S:$D(LRX) ZTSAVE("LRX*")="" D ^%ZTLOAD
K LRX,X,ZTSK,ZTSAVE,ZTDESC,ZTIO,ZTRTN
Q
;
CLOCK S:$D(ZTQUEUED) ZTREQ="@" K ZTSK
CL2 Q:'$D(^LAB(64.5,1,3))!($D(^LAC("LRAC","A")))
S LRXLR="LRAC" S:'$D(LRPERM) LRPERM=0
S LRFRSEP=$P($G(^LAB(64.5,1,6)),U,2) ; Set flag if printing separate file rooms.
I $D(XRTL) S XRTN="LRAC" D T0^%ZOSV ; START RESPONSE TIMING LOG
I '$D(LRDT) S %DT="",X="T-1" D ^%DT S LRDT=Y
L +^LAB(64.5)
;---last date cime printed--\/
S LRLDT=$P(^LAB(64.5,1,0),U,3)
;
I $L(LRLDT) D:LRDT'=LRLDT ^LRACK
S %DT="",X="T" D ^%DT S LRYDT=Y,U="^",LRBOT=$P(^LAB(64.5,1,0),U,2)
I LRDT'=LRLDT D ENT^LRACKL S $P(^LAB(64.5,1,0),U,3)=LRDT,$P(^(0),U,7)=LRLDT
L -^LAB(64.5) S LRRE=0
I '$D(LRX) D CL3
I $D(LRX) D CL4
I $D(XRTL),$D(XTR0) S XRTN="LRAC" D T1^%ZOSV ;STOP RESPONSE TIME LOG
K LRRE,LRX,LRXLR,X1,X2,Z
Q
CL3 ; Task "ALL" reports except file room if file room on separate schedule.
S LRRPTN=0
F S LRRPTN=$O(^LAB(64.5,1,3,LRRPTN)) Q:LRRPTN<1 D
. S X=$G(^LAB(64.5,1,3,LRRPTN,.1)) Q:$P(X,U,2) ; Don't start "manual" reports.
. I LRFRSEP,$P(X,U,3) Q ; Don't start "File Room" report if on separate schedule.
. S IOP=$P(X,U,1) D:IOP'="" CL3A
K LRBOT,LRDFN,LRDT,LRFRSEP,LRLDT,LRLLOC,LRNM,LRRPTN,LRYDT,X,Y,ZTSAVE,ZTSK
Q
;
CL3A ; Task the actual reports to run.
N ZTIO ; Tasked jobs have ZTIO defined, want ZTLOAD to build from IO* variables.
S %ZIS="N" D ^%ZIS I POP D ^%ZISC Q
S ZTRTN="ENT^LRAC1",ZTDTH=$H,ZTDESC="Laboratory cumulative report" K ZTSK
F I="LRPERM","LRXLR","LRDT","LRLDT","LRYDT","LRBOT","LRRE","LRRPTN" S ZTSAVE(I)=""
D ^%ZTLOAD,^%ZISC
Q
;
CL4 ; Task selected reports.
S LRRPTN=0
F S LRRPTN=$O(^LAB(64.5,1,3,LRRPTN)) Q:LRRPTN<1 I $D(LRX(LRRPTN)) D
. S X=$G(^LAB(64.5,1,3,LRRPTN,.1))
. I LRFRSEP,$P(X,U,3) Q ; Don't start "File Room" report if on separate schedule.
. S IOP=$P(X,U,1) D:IOP'="" CL3A
K LRBOT,LRDFN,LRDT,LRFRSEP,LRLDT,LRLLOC,LRNM,LRRPTN,LRX,LRYDT,X,Y,ZTSAVE,ZTSK
Q
LRAC ;SLC/DCM/MILW/JMC - CUMULATIVE REPORTS DRIVER ;2/20/91 08:33 ; [ 07/22/2002 12:26 PM ]
+1 ;;5.2;LR;**1001*1013**;JUL 15, 2002
+2 ;;5.2;LAB SERVICE;**172**;Sep 27, 1994
+3 ;Routine has been change to handle separate file room scheduling.
+4 ;;Semi-automatic queuing of selected reports can occur by setting-up
+5 ;;an action type option: S LRX(x)="" D CLOCK^LRAC
+6 ;;Where 'x' is the internal number of the report desired.
+7 ;;Fields 200,201,202 of OPTION file should then be filled in.
+8 KILL DIC,LRX
+9 ;
+10 ;
+11 ;---HOAK FOR PRINTER PROBLEMS
DO ^LRPARAM
+12 ;
+13 READ !,"Print ALL or SELECTED reports? ALL// ",X:DTIME
IF X=""
SET X="A"
IF ".^"[X
QUIT
+14 IF "AaSs"'[$EXTRACT(X)
SET X="?"
+15 IF X["?"
WRITE !?5,"Enter 'S' for SELECTED reports ",!?18,"-or-",!?11,"'A' for ALL reports"
GOTO LRAC
+16 IF "Ss"[$EXTRACT(X,1)
Begin DoDot:1
+17 ; Allow user to select reports to print.
WRITE !
+18 SET DIC="^LAB(64.5,1,3,"
SET DIC(0)="AEMQ"
SET DIC("A")="Select REPORT NAME: "
+19 ; Screen out file room reports if printing separate file room, use appropiate option.
+20 IF $PIECE($GET(^LAB(64.5,1,6)),U,2)
SET DIC("S")="I '$P($G(^LAB(64.5,1,3,Y,.1)),U,3)"
+21 FOR
DO ^DIC
IF Y<1
QUIT
SET LRX(+Y)=""
+22 KILL DIC
WRITE !
End DoDot:1
IF '$DATA(LRX)
QUIT
+23 SET U="^"
DO DT^LRX
+24 SET ZTRTN="CLOCK^LRAC"
SET ZTIO=""
SET ZTDESC="Laboratory cumulative report"
IF $DATA(LRX)
SET ZTSAVE("LRX*")=""
DO ^%ZTLOAD
+25 KILL LRX,X,ZTSK,ZTSAVE,ZTDESC,ZTIO,ZTRTN
+26 QUIT
+27 ;
CLOCK IF $DATA(ZTQUEUED)
SET ZTREQ="@"
KILL ZTSK
CL2 IF '$DATA(^LAB(64.5,1,3))!($DATA(^LAC("LRAC","A")))
QUIT
+1 SET LRXLR="LRAC"
IF '$DATA(LRPERM)
SET LRPERM=0
+2 ; Set flag if printing separate file rooms.
SET LRFRSEP=$PIECE($GET(^LAB(64.5,1,6)),U,2)
+3 ; START RESPONSE TIMING LOG
IF $DATA(XRTL)
SET XRTN="LRAC"
DO T0^%ZOSV
+4 IF '$DATA(LRDT)
SET %DT=""
SET X="T-1"
DO ^%DT
SET LRDT=Y
+5 LOCK +^LAB(64.5)
+6 ;---last date cime printed--\/
+7 SET LRLDT=$PIECE(^LAB(64.5,1,0),U,3)
+8 ;
+9 IF $LENGTH(LRLDT)
IF LRDT'=LRLDT
DO ^LRACK
+10 SET %DT=""
SET X="T"
DO ^%DT
SET LRYDT=Y
SET U="^"
SET LRBOT=$PIECE(^LAB(64.5,1,0),U,2)
+11 IF LRDT'=LRLDT
DO ENT^LRACKL
SET $PIECE(^LAB(64.5,1,0),U,3)=LRDT
SET $PIECE(^(0),U,7)=LRLDT
+12 LOCK -^LAB(64.5)
SET LRRE=0
+13 IF '$DATA(LRX)
DO CL3
+14 IF $DATA(LRX)
DO CL4
+15 ;STOP RESPONSE TIME LOG
IF $DATA(XRTL)
IF $DATA(XTR0)
SET XRTN="LRAC"
DO T1^%ZOSV
+16 KILL LRRE,LRX,LRXLR,X1,X2,Z
+17 QUIT
CL3 ; Task "ALL" reports except file room if file room on separate schedule.
+1 SET LRRPTN=0
+2 FOR
SET LRRPTN=$ORDER(^LAB(64.5,1,3,LRRPTN))
IF LRRPTN<1
QUIT
Begin DoDot:1
+3 ; Don't start "manual" reports.
SET X=$GET(^LAB(64.5,1,3,LRRPTN,.1))
IF $PIECE(X,U,2)
QUIT
+4 ; Don't start "File Room" report if on separate schedule.
IF LRFRSEP
IF $PIECE(X,U,3)
QUIT
+5 SET IOP=$PIECE(X,U,1)
IF IOP'=""
DO CL3A
End DoDot:1
+6 KILL LRBOT,LRDFN,LRDT,LRFRSEP,LRLDT,LRLLOC,LRNM,LRRPTN,LRYDT,X,Y,ZTSAVE,ZTSK
+7 QUIT
+8 ;
CL3A ; Task the actual reports to run.
+1 ; Tasked jobs have ZTIO defined, want ZTLOAD to build from IO* variables.
NEW ZTIO
+2 SET %ZIS="N"
DO ^%ZIS
IF POP
DO ^%ZISC
QUIT
+3 SET ZTRTN="ENT^LRAC1"
SET ZTDTH=$HOROLOG
SET ZTDESC="Laboratory cumulative report"
KILL ZTSK
+4 FOR I="LRPERM","LRXLR","LRDT","LRLDT","LRYDT","LRBOT","LRRE","LRRPTN"
SET ZTSAVE(I)=""
+5 DO ^%ZTLOAD
DO ^%ZISC
+6 QUIT
+7 ;
CL4 ; Task selected reports.
+1 SET LRRPTN=0
+2 FOR
SET LRRPTN=$ORDER(^LAB(64.5,1,3,LRRPTN))
IF LRRPTN<1
QUIT
IF $DATA(LRX(LRRPTN))
Begin DoDot:1
+3 SET X=$GET(^LAB(64.5,1,3,LRRPTN,.1))
+4 ; Don't start "File Room" report if on separate schedule.
IF LRFRSEP
IF $PIECE(X,U,3)
QUIT
+5 SET IOP=$PIECE(X,U,1)
IF IOP'=""
DO CL3A
End DoDot:1
+6 KILL LRBOT,LRDFN,LRDT,LRFRSEP,LRLDT,LRLLOC,LRNM,LRRPTN,LRX,LRYDT,X,Y,ZTSAVE,ZTSK
+7 QUIT
