| 1 | LRCAPACC ;SLC/RJS/FHS - LAB WORKLOAD DIVISION REPORT BY CAP CODE  ;8/23/91 1039; | 
|---|
| 2 | ;;5.2;LAB SERVICE;**201**;Sep 27, 1994 | 
|---|
| 3 | EN ; | 
|---|
| 4 | K ^TMP($J),ZTSK | 
|---|
| 5 | ASK1 S %DT="E" W !!,"Beginning Date: " R X:$S($D(DTIME):DTIME,1:999) E  G EXIT | 
|---|
| 6 | G:(X["^") EXIT D ^%DT G:(Y<0) ASK1 S LRDT1=+Y | 
|---|
| 7 | ASK2 ; | 
|---|
| 8 | S %DT="E" W !!,"Ending Date: " R X:$S($D(DTIME):DTIME,1:999) E  G EXIT | 
|---|
| 9 | G:(X["^") EXIT D ^%DT G:(Y<0) ASK2 S LRDT2=+Y I LRDT1>LRDT2 S Y=LRDT1,LRDT1=LRDT2,LRDT2=Y | 
|---|
| 10 | SEL ; | 
|---|
| 11 | F  S %=2 W !?10,"Would you like a complete report " D YN^DICN Q:%'=0 | 
|---|
| 12 | G:%=-1 EXIT G:%=2 ZIS F  S %=2 W !?10,"All WKLD Codes " D YN^DICN Q:%'=0 | 
|---|
| 13 | G:%=-1 EXIT I %=1 S LRCAP("A")="" G ZIS | 
|---|
| 14 | K DIC S DIC=64,DIC(0)="AZQMEN" F  D ^DIC Q:X="^"!('+Y)!(X="")  S LRCAP(+$P(Y(0),U,2))="" | 
|---|
| 15 | I '$O(LRCAP(0)) W !!?10,"Nothing Selected ",! G EXIT | 
|---|
| 16 | ZIS W !! S %ZIS="NQ" D ^%ZIS G:'$L(IO) EXIT G:IO'=IO(0)!($D(IO("Q"))) QUEUE | 
|---|
| 17 | DQ ; | 
|---|
| 18 | I $D(ZTQUEUED) S ZTREQ="@" | 
|---|
| 19 | S LRPG=0 D LOOP W:TOT !!,?35,"Total for the Report: ",$J(TOT,10,2) | 
|---|
| 20 | I '$D(^TMP($J)) W !!?10,"No Data for " S X=LRDT1P D DD W " - " S X=LRDT2P D DD W !! | 
|---|
| 21 | W:IOST["P-" @IOF | 
|---|
| 22 | EXIT ; | 
|---|
| 23 | D ^%ZISC K %,TT,I,C,CP,CODE,Y,LRCAP,LRPG,TOT,LRDT,LRDT1,LRDT2,LRDV1,LRDV2,LRLN,^TMP($J),LRTXT,ZTSK,%DT,%ZIS,ZTRTN,ZTDESC,ZTIO,ZTSAVE,LRDT1P,LRDT2P,IO("Q") | 
|---|
| 24 | Q | 
|---|
| 25 | QUEUE ; | 
|---|
| 26 | S ZTRTN="DQ^LRCAPACC",ZTSAVE("LRDT*")="",ZTSAVE("LRCAP*")="",ZTDESC="Lab Workload Division Report",ZTIO=ION K ZTDTH,ZTCPU,ZTUCI D ^%ZTLOAD G EXIT | 
|---|
| 27 | LOOP ; | 
|---|
| 28 | S (LRLN,LRDV1,LRDV2,TOT)=0,LRDT1P=LRDT1,LRDT2P=LRDT2,LRDT1=LRDT1-.0001,LRDT2=LRDT2+.00001 D DT^LRX | 
|---|
| 29 | W !! D WAIT^DICD W:IOST["P-" @IOF F  S LRLN=$O(^TMP("WL",LRLN)) Q:'LRLN  S LRTXT=^(LRLN) D LOOP1 | 
|---|
| 30 | D HEADER S LRDV1=0 F  S LRDV1=$O(^TMP($J,LRDV1)) Q:'LRDV1  D LOOP2 D:IOST["P-"&($Y>(IOSL-10)) HEADER | 
|---|
| 31 | Q | 
|---|
| 32 | LOOP1 ; | 
|---|
| 33 | I $E(LRTXT,1,2)="$$" S LRDV2=+$E(LRTXT,3,99),LRDT=$E(LRTXT,10,16) Q | 
|---|
| 34 | I $E(LRTXT)="$" S LRDV1=+$E(LRTXT,2,99) Q | 
|---|
| 35 | Q:'LRDV1!('LRDV2)  S CODE=+$E(LRTXT,17,26) Q:LRDT>LRDT2!(LRDT<LRDT1)  D:'$D(LRCAP)!($D(LRCAP("A"))#2)!($D(LRCAP(CODE))) DATES | 
|---|
| 36 | Q | 
|---|
| 37 | LOOP2 ; | 
|---|
| 38 | S LRDV2=0 F  S LRDV2=$O(^TMP($J,LRDV1,LRDV2)) Q:'LRDV2  D LOOP3 | 
|---|
| 39 | Q | 
|---|
| 40 | LOOP3 ; | 
|---|
| 41 | I IOST["P-"&($Y>(IOSL-10)) D HEADER | 
|---|
| 42 | W !,"Division: ",LRDV2 | 
|---|
| 43 | S X=^TMP($J,LRDV1,LRDV2,"LO DT") W ?20,"From: " D DD S X=^("HI DT") W ?35,"To: " D DD | 
|---|
| 44 | W ?50,"Total: ",$J(^("TOT WRK"),10,2) S TOT=TOT+^("TOT WRK") | 
|---|
| 45 | S I=0 F  S I=$O(^TMP($J,LRDV1,LRDV2,I)) Q:'I  S CP=^(I),C=I D:IOST["P-"&($Y>(IOSL-10)) HEADER D SUB | 
|---|
| 46 | W ! Q | 
|---|
| 47 | SUB S:C'["." C=C_".000" S C=$S($L(C)=9:C,1:C_$E("000",($L(C)-5),3)),C=$O(^LAM("E",C,0)) Q:'C | 
|---|
| 48 | S C=^LAM(C,0) W !?2,$P(C,U,2),?12,$J(CP,10,2),"   ",$P(C,U) | 
|---|
| 49 | Q | 
|---|
| 50 | HEADER ; | 
|---|
| 51 | S LRPG=LRPG+1 W:IOST["P-"&($Y>(IOSL-10)) @IOF W !!,"   Lab Workload Division Report for Site: ",LRDV1,"    Printed: ",LRDT0,!!,?60,"Pg: ",LRPG,! | 
|---|
| 52 | Q | 
|---|
| 53 | DD ; | 
|---|
| 54 | W $$FMTE^XLFDT(X,"1D") Q | 
|---|
| 55 | DATES ; | 
|---|
| 56 | I '$D(^TMP($J,LRDV1,LRDV2,"HI DT")) S ^TMP($J,LRDV1,LRDV2,"HI DT")=0,^TMP($J,LRDV1,LRDV2,"LO DT")=9999999,^TMP($J,LRDV1,LRDV2,"TOT WRK")=0 | 
|---|
| 57 | S TT=(+$E(LRTXT,28,99)*(+$E(LRTXT,34,99))),^TMP($J,LRDV1,LRDV2,"TOT WRK")=^TMP($J,LRDV1,LRDV2,"TOT WRK")+TT | 
|---|
| 58 | I $D(LRCAP("A"))!($D(LRCAP(CODE))) S:'$D(^TMP($J,LRDV1,LRDV2,CODE)) ^(CODE)=0 S ^(CODE)=^(CODE)+TT | 
|---|
| 59 | S:'(LRDT<^TMP($J,LRDV1,LRDV2,"HI DT")) ^TMP($J,LRDV1,LRDV2,"HI DT")=LRDT | 
|---|
| 60 | S:'(LRDT>^TMP($J,LRDV1,LRDV2,"LO DT")) ^TMP($J,LRDV1,LRDV2,"LO DT")=LRDT | 
|---|
| 61 | Q | 
|---|