- LRAC ;SLC/DCM/MILW/JMC - CUMULATIVE REPORTS DRIVER ;2/20/91 08:33 ;
- ;;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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRAC 3133 printed Jan 18, 2025@03:06:46 Page 2
- LRAC ;SLC/DCM/MILW/JMC - CUMULATIVE REPORTS DRIVER ;2/20/91 08:33 ;
- +1 ;;5.2;LAB SERVICE;**172**;Sep 27, 1994
- +2 ;Routine has been change to handle separate file room scheduling.
- +3 ;;Semi-automatic queuing of selected reports can occur by setting-up
- +4 ;;an action type option: S LRX(x)="" D CLOCK^LRAC
- +5 ;;Where 'x' is the internal number of the report desired.
- +6 ;;Fields 200,201,202 of OPTION file should then be filled in.
- +7 KILL DIC,LRX
- +8 ;
- +9 ;
- +10 ;---HOAK FOR PRINTER PROBLEMS
- DO ^LRPARAM
- +11 ;
- +12 READ !,"Print ALL or SELECTED reports? ALL// ",X:DTIME
- if X=""
- SET X="A"
- if ".^"[X
- QUIT
- +13 IF "AaSs"'[$EXTRACT(X)
- SET X="?"
- +14 IF X["?"
- WRITE !?5,"Enter 'S' for SELECTED reports ",!?18,"-or-",!?11,"'A' for ALL reports"
- GOTO LRAC
- +15 IF "Ss"[$EXTRACT(X,1)
- Begin DoDot:1
- +16 ; Allow user to select reports to print.
- WRITE !
- +17 SET DIC="^LAB(64.5,1,3,"
- SET DIC(0)="AEMQ"
- SET DIC("A")="Select REPORT NAME: "
- +18 ; Screen out file room reports if printing separate file room, use appropiate option.
- +19 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)"
- +20 FOR
- DO ^DIC
- if Y<1
- QUIT
- SET LRX(+Y)=""
- +21 KILL DIC
- WRITE !
- End DoDot:1
- if '$DATA(LRX)
- QUIT
- +22 SET U="^"
- DO DT^LRX
- +23 SET ZTRTN="CLOCK^LRAC"
- SET ZTIO=""
- SET ZTDESC="Laboratory cumulative report"
- if $DATA(LRX)
- SET ZTSAVE("LRX*")=""
- DO ^%ZTLOAD
- +24 KILL LRX,X,ZTSK,ZTSAVE,ZTDESC,ZTIO,ZTRTN
- +25 QUIT
- +26 ;
- 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