LRCAPA12 ;SLC/RJS/FHS - LAB WORKLOAD DIVISION REPORT;8/23/91 1039;
;;5.2;LAB SERVICE;**201**;Sep 27, 1994
EN ;
;
K ^TMP($J),ZTSK
ASK1 ;
S %DT="E" W !!,"Beginning Date: " R X:$S($D(DTIME):DTIME,1:999) E G EXIT
G:(X["^") EXIT D ^%DT G:(Y<0) ASK1 S LRDT1=+Y
ASK2 ;
S %DT="E" W !!,"Ending Date: " R X:$S($D(DTIME):DTIME,1:999) E G EXIT
G:(X["^") EXIT D ^%DT G:(Y<0) ASK2 S LRDT2=+Y I LRDT1>LRDT2 S Y=LRDT1,LRDT1=LRDT2,LRDT2=Y
W !! S %ZIS="NQ" D ^%ZIS G:'$L(IO) EXIT
G:IO'=IO(0)!($D(IO("Q"))) QUEUE
DQ ;
I $D(ZTQUEUED) S ZTREQ="@"
U IO S LRPG=0 D LOOP W:TOT !!,?35,"Total for the Report: ",$J(TOT,10,2)
I '$D(^TMP($J)) W !!?10,"No Data for " S X=LRDT1P D DD W " - " S X=LRDT2P D DD W !!
W:IOST["P-" @IOF
EXIT ;
D ^%ZISC
K LRPG,TOT,LRDT,LRDT1,LRDT2,LRDV1,LRDV2,LRLN,^TMP($J),LRTXT,ZTSK,%DT,%ZIS,ZTRTN,ZTDESC,ZTIO,ZTSAVE,LRDT1P,LRDT2P,IO("Q")
Q
QUEUE ;
S ZTRTN="DQ^LRCAPA12",ZTSAVE("LRDT*")="",ZTDESC="Lab Workload Division Report",ZTIO=ION
K ZTDTH,ZTCPU,ZTUCI
D ^%ZTLOAD
G EXIT
Q
LOOP ;
S (LRLN,LRDV1,LRDV2,TOT)=0,LRDT1P=LRDT1,LRDT2P=LRDT2,LRDT1=LRDT1-.0001,LRDT2=LRDT2+.00001 D DT^LRX
W !! D WAIT^DICD W:IOST["P-" @IOF
F S LRLN=$O(^TMP("WL",LRLN)) Q:'LRLN S LRTXT=^(LRLN) D LOOP1
D HEADER
S LRDV1=0 F S LRDV1=$O(^TMP($J,LRDV1)) Q:'LRDV1 D LOOP2
Q
LOOP1 ;
I ($E(LRTXT,1,2)="$$") S LRDV2=+$E(LRTXT,3,99),LRDT=$E(LRTXT,10,16) Q
I ($E(LRTXT,1)="$") S LRDV1=+$E(LRTXT,2,99) Q
Q:'LRDV1!('LRDV2)
I LRDT>LRDT1,LRDT<LRDT2 D DATES S ^TMP($J,LRDV1,LRDV2,"TOT WRK")=^TMP($J,LRDV1,LRDV2,"TOT WRK")+(+$E(LRTXT,28,99)*(+$E(LRTXT,34,99)))
Q
LOOP2 ;
S LRDV2=0 F S LRDV2=$O(^TMP($J,LRDV1,LRDV2)) Q:'LRDV2 D LOOP3
Q
LOOP3 ;
I IOST["P-"&($Y>(IOSL-6)) D HEADER
W !,"Division: ",LRDV2
S X=^TMP($J,LRDV1,LRDV2,"LO DT") W ?20,"From: " D DD S X=^("HI DT") W ?35,"To: " D DD
W ?50,"Total: ",$J(^("TOT WRK"),10,2) S TOT=TOT+^("TOT WRK")
Q
DATES ;
D:'$D(^TMP($J,LRDV1,LRDV2,"HI DT"))#2 NEW
S:'(LRDT<^TMP($J,LRDV1,LRDV2,"HI DT")) ^TMP($J,LRDV1,LRDV2,"HI DT")=LRDT
S:'(LRDT>^TMP($J,LRDV1,LRDV2,"LO DT")) ^TMP($J,LRDV1,LRDV2,"LO DT")=LRDT
Q
NEW ;
S ^TMP($J,LRDV1,LRDV2,"HI DT")=0
S ^TMP($J,LRDV1,LRDV2,"LO DT")=9999999
S ^TMP($J,LRDV1,LRDV2,"TOT WRK")=0
Q
S LRPG=LRPG+1 W:IOST["P-"&($Y>(IOSL-6)) @IOF W !!," Lab Workload Division Report for Site: ",LRDV1," Printed: ",LRDT0,!!,?60,"Pg: ",LRPG,!
Q
DD ;
W $$FMTE^XLFDT(X,"1D") Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRCAPA12 2429 printed Sep 23, 2025@19:48:13 Page 2
LRCAPA12 ;SLC/RJS/FHS - LAB WORKLOAD DIVISION REPORT;8/23/91 1039;
+1 ;;5.2;LAB SERVICE;**201**;Sep 27, 1994
EN ;
+1 ;
+2 KILL ^TMP($JOB),ZTSK
ASK1 ;
+1 SET %DT="E"
WRITE !!,"Beginning Date: "
READ X:$SELECT($DATA(DTIME):DTIME,1:999)
IF '$TEST
GOTO EXIT
+2 if (X["^")
GOTO EXIT
DO ^%DT
if (Y<0)
GOTO ASK1
SET LRDT1=+Y
ASK2 ;
+1 SET %DT="E"
WRITE !!,"Ending Date: "
READ X:$SELECT($DATA(DTIME):DTIME,1:999)
IF '$TEST
GOTO EXIT
+2 if (X["^")
GOTO EXIT
DO ^%DT
if (Y<0)
GOTO ASK2
SET LRDT2=+Y
IF LRDT1>LRDT2
SET Y=LRDT1
SET LRDT1=LRDT2
SET LRDT2=Y
+3 WRITE !!
SET %ZIS="NQ"
DO ^%ZIS
if '$LENGTH(IO)
GOTO EXIT
+4 if IO'=IO(0)!($DATA(IO("Q")))
GOTO QUEUE
DQ ;
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 USE IO
SET LRPG=0
DO LOOP
if TOT
WRITE !!,?35,"Total for the Report: ",$JUSTIFY(TOT,10,2)
+3 IF '$DATA(^TMP($JOB))
WRITE !!?10,"No Data for "
SET X=LRDT1P
DO DD
WRITE " - "
SET X=LRDT2P
DO DD
WRITE !!
+4 if IOST["P-"
WRITE @IOF
EXIT ;
+1 DO ^%ZISC
+2 KILL LRPG,TOT,LRDT,LRDT1,LRDT2,LRDV1,LRDV2,LRLN,^TMP($JOB),LRTXT,ZTSK,%DT,%ZIS,ZTRTN,ZTDESC,ZTIO,ZTSAVE,LRDT1P,LRDT2P,IO("Q")
+3 QUIT
QUEUE ;
+1 SET ZTRTN="DQ^LRCAPA12"
SET ZTSAVE("LRDT*")=""
SET ZTDESC="Lab Workload Division Report"
SET ZTIO=ION
+2 KILL ZTDTH,ZTCPU,ZTUCI
+3 DO ^%ZTLOAD
+4 GOTO EXIT
+5 QUIT
LOOP ;
+1 SET (LRLN,LRDV1,LRDV2,TOT)=0
SET LRDT1P=LRDT1
SET LRDT2P=LRDT2
SET LRDT1=LRDT1-.0001
SET LRDT2=LRDT2+.00001
DO DT^LRX
+2 WRITE !!
DO WAIT^DICD
if IOST["P-"
WRITE @IOF
+3 FOR
SET LRLN=$ORDER(^TMP("WL",LRLN))
if 'LRLN
QUIT
SET LRTXT=^(LRLN)
DO LOOP1
+4 DO HEADER
+5 SET LRDV1=0
FOR
SET LRDV1=$ORDER(^TMP($JOB,LRDV1))
if 'LRDV1
QUIT
DO LOOP2
+6 QUIT
LOOP1 ;
+1 IF ($EXTRACT(LRTXT,1,2)="$$")
SET LRDV2=+$EXTRACT(LRTXT,3,99)
SET LRDT=$EXTRACT(LRTXT,10,16)
QUIT
+2 IF ($EXTRACT(LRTXT,1)="$")
SET LRDV1=+$EXTRACT(LRTXT,2,99)
QUIT
+3 if 'LRDV1!('LRDV2)
QUIT
+4 IF LRDT>LRDT1
IF LRDT<LRDT2
DO DATES
SET ^TMP($JOB,LRDV1,LRDV2,"TOT WRK")=^TMP($JOB,LRDV1,LRDV2,"TOT WRK")+(+$EXTRACT(LRTXT,28,99)*(+$EXTRACT(LRTXT,34,99)))
+5 QUIT
LOOP2 ;
+1 SET LRDV2=0
FOR
SET LRDV2=$ORDER(^TMP($JOB,LRDV1,LRDV2))
if 'LRDV2
QUIT
DO LOOP3
+2 QUIT
LOOP3 ;
+1 IF IOST["P-"&($Y>(IOSL-6))
DO HEADER
+2 WRITE !,"Division: ",LRDV2
+3 SET X=^TMP($JOB,LRDV1,LRDV2,"LO DT")
WRITE ?20,"From: "
DO DD
SET X=^("HI DT")
WRITE ?35,"To: "
DO DD
+4 WRITE ?50,"Total: ",$JUSTIFY(^("TOT WRK"),10,2)
SET TOT=TOT+^("TOT WRK")
+5 QUIT
DATES ;
+1 if '$DATA(^TMP($JOB,LRDV1,LRDV2,"HI DT"))#2
DO NEW
+2 if '(LRDT<^TMP($JOB,LRDV1,LRDV2,"HI DT"))
SET ^TMP($JOB,LRDV1,LRDV2,"HI DT")=LRDT
+3 if '(LRDT>^TMP($JOB,LRDV1,LRDV2,"LO DT"))
SET ^TMP($JOB,LRDV1,LRDV2,"LO DT")=LRDT
+4 QUIT
NEW ;
+1 SET ^TMP($JOB,LRDV1,LRDV2,"HI DT")=0
+2 SET ^TMP($JOB,LRDV1,LRDV2,"LO DT")=9999999
+3 SET ^TMP($JOB,LRDV1,LRDV2,"TOT WRK")=0
+4 QUIT
+1 SET LRPG=LRPG+1
if IOST["P-"&($Y>(IOSL-6))
WRITE @IOF
WRITE !!," Lab Workload Division Report for Site: ",LRDV1," Printed: ",LRDT0,!!,?60,"Pg: ",LRPG,!
+2 QUIT
DD ;
+1 WRITE $$FMTE^XLFDT(X,"1D")
QUIT
