- LRCAPA12 ; IHS/DIR/AAB - LAB WORKLOAD DIVISION REPORT 8/23/91 1039 ;
- ;;5.2;LR;**1006**;SEP 01, 1998
- ;
- ;;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
- LRCAPA12 ; IHS/DIR/AAB - LAB WORKLOAD DIVISION REPORT 8/23/91 1039 ;
- +1 ;;5.2;LR;**1006**;SEP 01, 1998
- +2 ;
- +3 ;;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
