- LRRP6B1 ;DALISC/J0 - WORKLOAD CODE SUMMARY REPORT-BUILD ;11/27/92
- ;;5.2;LAB SERVICE;**201**;Sep 27, 1994
- EN ;
- DQ ;
- D INIT S:$D(ZTQUEUED) ZTREQ="@" K ZTSK
- D PROCESS
- D PRINT
- D:$D(ZTQUEUED) WRAPUP^LRRP6
- Q
- INIT ;
- S:$D(ZTQUEUED) ZTREQ="@" K ZTSK U IO
- K ^TMP("LR",$J)
- S LRDAT=$$Y2K^LRX(DT),(LRPAG,LREND)=0
- S LRV657=$$WKLDNAME^LRCAPU(657)
- S:'$L(LRV657) LRV657="VENIPUNCTURE -- 657"
- S LRV658=$$WKLDNAME^LRCAPU(658)
- S:'$L(LRV658) LRV658="VENIPUNCTURE -- 658"
- Q
- PROCESS ;
- I $D(LRDIVSEL) D
- . S LRDIV=""
- . F S LRDIV=$O(LRDIVSEL(LRDIV)) Q:LRDIV="" D WKLD
- I '$D(LRDIVSEL) D
- . S LRDIV=0
- . F S LRDIV=$O(^LRO(64.1,LRDIV)) Q:'LRDIV D WKLD
- Q
- WKLD ;
- S LRDT=LRSDT
- F S LRDT=$O(^LRO(64.1,LRDIV,1,LRDT)) Q:('LRDT)!(LRDT>LREDT) D
- . S LRCPN=0
- . F S LRCPN=$O(^LRO(64.1,LRDIV,1,LRDT,1,LRCPN)) Q:'LRCPN D
- . . S LRCAPNAM=$E($$WKLDNAME^LRCAPU(LRCPN),1,60)
- . . Q:('$L(LRCAPNAM))!('LRCAPNUM)
- . . S LRCC(LRCAPNAM)=LRCAPNUM
- . . D TEST
- . D VENI
- Q
- TEST ;
- S LRTST=0
- F S LRTST=$O(^LRO(64.1,LRDIV,1,LRDT,1,LRCPN,1,LRTST)) Q:'LRTST D
- . S LRTSTREC=$G(^LRO(64.1,LRDIV,1,LRDT,1,LRCPN,1,LRTST,0))
- . Q:'$L(LRTSTREC)!($P(LRTSTREC,U,7)'=LRAA)
- . S LRTN=$P(LRTSTREC,U,2)
- . S LRTNAM=$P($G(^LAB(60,LRTN,0)),U) Q:'$L(LRTNAM)
- . S LRTMULT=$S(+$P(LRTSTREC,U,3):+$P(LRTSTREC,U,3),1:1)
- . S LRAN=$P(LRTSTREC,U,9)
- . D BMPTOTS
- Q
- BMPTOTS ;
- S:'$D(^TMP("LR",$J,"WKLD"))#2 ^("WKLD")=0
- S ^("WKLD")=^TMP("LR",$J,"WKLD")+LRTMULT
- S:'$D(^TMP("LR",$J,"WKLD",LRCAPNAM))#2 ^(LRCAPNAM)=0
- S ^(LRCAPNAM)=^TMP("LR",$J,"WKLD",LRCAPNAM)+LRTMULT
- S:'$D(^TMP("LR",$J,"TST"))#2 ^("TST")=0
- S ^("TST")=^TMP("LR",$J,"TST")+LRTMULT
- S:'$D(^TMP("LR",$J,"TST",LRTNAM))#2 ^(LRTNAM)=0
- S ^(LRTNAM)=^TMP("LR",$J,"TST",LRTNAM)+LRTMULT
- S:'$D(^TMP("LR",$J,"WKLD/TST",LRCAPNAM))#2 ^(LRCAPNAM)=0
- S ^(LRCAPNAM)=^TMP("LR",$J,"WKLD/TST",LRCAPNAM)+LRTMULT
- S:'$D(^TMP("LR",$J,"WKLD/TST",LRCAPNAM,LRTNAM))#2 ^(LRTNAM)=0
- S ^(LRTNAM)=^TMP("LR",$J,"WKLD/TST",LRCAPNAM,LRTNAM)+LRTMULT
- Q
- VENI ; ** VENIPUNCTURE SUMMARY **
- S LRSUM=+$P($G(^LRO(64.1,LRDIV,1,LRDT,1,657,"S")),U,4)
- I LRSUM S LRCAPNAM=LRV657 D BMPVENI
- S LRSUM=+$P($G(^LRO(64.1,LRDIV,1,LRDT,1,658,"S")),U,4)
- I LRSUM S LRCAPNAM=LRV658 D BMPVENI
- Q
- BMPVENI ;
- S:'$D(^TMP("LR",$J,"VENI"))#2 ^("VENI")=0
- S ^("VENI")=^TMP("LR",$J,"VENI")+LRSUM
- S:'$D(^TMP("LR",$J,"VENI",LRCAPNAM))#2 ^(LRCAPNAM)=0
- S ^(LRCAPNAM)=^TMP("LR",$J,"VENI",LRCAPNAM)+LRSUM
- Q
- PRINT ;
- W:$E(IOST,1,2)="C-" @IOF
- S $P(LRDASH,"-",IOM)="",$P(LRSTAR,"*",IOM)=""
- I '$D(^TMP("LR",$J)) D NOTHING Q
- D:LRREPTYP="D" DET^LRRP6B3 Q:LREND
- D COND^LRRP6B2
- Q
- NOTHING ;
- S LRPAG=LRPAG+1
- W LRDASH
- W !,"Workload Code Summary for ",LRDATRNG
- W ?62,LRDAT,?72,"PAGE ",$J(LRPAG,3)
- W !!,LRSTAR
- W !!?18,"*** NO DATA FOR REPORT OPTIONS SELECTED ***"
- I $D(LRDIVSEL) D
- . W !!,"DIVISIONS SELECTED",!,$E(LRDASH,1,18)
- . S LRDIV=""
- . F S LRDIV=$O(LRDIVSEL(LRDIV)) Q:LRDIV="" W !,LRDIVSEL(LRDIV)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRRP6B1 2968 printed Feb 18, 2025@23:45:52 Page 2
- LRRP6B1 ;DALISC/J0 - WORKLOAD CODE SUMMARY REPORT-BUILD ;11/27/92
- +1 ;;5.2;LAB SERVICE;**201**;Sep 27, 1994
- EN ;
- DQ ;
- +1 DO INIT
- if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- KILL ZTSK
- +2 DO PROCESS
- +3 DO PRINT
- +4 if $DATA(ZTQUEUED)
- DO WRAPUP^LRRP6
- +5 QUIT
- INIT ;
- +1 if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- KILL ZTSK
- USE IO
- +2 KILL ^TMP("LR",$JOB)
- +3 SET LRDAT=$$Y2K^LRX(DT)
- SET (LRPAG,LREND)=0
- +4 SET LRV657=$$WKLDNAME^LRCAPU(657)
- +5 if '$LENGTH(LRV657)
- SET LRV657="VENIPUNCTURE -- 657"
- +6 SET LRV658=$$WKLDNAME^LRCAPU(658)
- +7 if '$LENGTH(LRV658)
- SET LRV658="VENIPUNCTURE -- 658"
- +8 QUIT
- PROCESS ;
- +1 IF $DATA(LRDIVSEL)
- Begin DoDot:1
- +2 SET LRDIV=""
- +3 FOR
- SET LRDIV=$ORDER(LRDIVSEL(LRDIV))
- if LRDIV=""
- QUIT
- DO WKLD
- End DoDot:1
- +4 IF '$DATA(LRDIVSEL)
- Begin DoDot:1
- +5 SET LRDIV=0
- +6 FOR
- SET LRDIV=$ORDER(^LRO(64.1,LRDIV))
- if 'LRDIV
- QUIT
- DO WKLD
- End DoDot:1
- +7 QUIT
- WKLD ;
- +1 SET LRDT=LRSDT
- +2 FOR
- SET LRDT=$ORDER(^LRO(64.1,LRDIV,1,LRDT))
- if ('LRDT)!(LRDT>LREDT)
- QUIT
- Begin DoDot:1
- +3 SET LRCPN=0
- +4 FOR
- SET LRCPN=$ORDER(^LRO(64.1,LRDIV,1,LRDT,1,LRCPN))
- if 'LRCPN
- QUIT
- Begin DoDot:2
- +5 SET LRCAPNAM=$EXTRACT($$WKLDNAME^LRCAPU(LRCPN),1,60)
- +6 if ('$LENGTH(LRCAPNAM))!('LRCAPNUM)
- QUIT
- +7 SET LRCC(LRCAPNAM)=LRCAPNUM
- +8 DO TEST
- End DoDot:2
- +9 DO VENI
- End DoDot:1
- +10 QUIT
- TEST ;
- +1 SET LRTST=0
- +2 FOR
- SET LRTST=$ORDER(^LRO(64.1,LRDIV,1,LRDT,1,LRCPN,1,LRTST))
- if 'LRTST
- QUIT
- Begin DoDot:1
- +3 SET LRTSTREC=$GET(^LRO(64.1,LRDIV,1,LRDT,1,LRCPN,1,LRTST,0))
- +4 if '$LENGTH(LRTSTREC)!($PIECE(LRTSTREC,U,7)'=LRAA)
- QUIT
- +5 SET LRTN=$PIECE(LRTSTREC,U,2)
- +6 SET LRTNAM=$PIECE($GET(^LAB(60,LRTN,0)),U)
- if '$LENGTH(LRTNAM)
- QUIT
- +7 SET LRTMULT=$SELECT(+$PIECE(LRTSTREC,U,3):+$PIECE(LRTSTREC,U,3),1:1)
- +8 SET LRAN=$PIECE(LRTSTREC,U,9)
- +9 DO BMPTOTS
- End DoDot:1
- +10 QUIT
- BMPTOTS ;
- +1 if '$DATA(^TMP("LR",$JOB,"WKLD"))#2
- SET ^("WKLD")=0
- +2 SET ^("WKLD")=^TMP("LR",$JOB,"WKLD")+LRTMULT
- +3 if '$DATA(^TMP("LR",$JOB,"WKLD",LRCAPNAM))#2
- SET ^(LRCAPNAM)=0
- +4 SET ^(LRCAPNAM)=^TMP("LR",$JOB,"WKLD",LRCAPNAM)+LRTMULT
- +5 if '$DATA(^TMP("LR",$JOB,"TST"))#2
- SET ^("TST")=0
- +6 SET ^("TST")=^TMP("LR",$JOB,"TST")+LRTMULT
- +7 if '$DATA(^TMP("LR",$JOB,"TST",LRTNAM))#2
- SET ^(LRTNAM)=0
- +8 SET ^(LRTNAM)=^TMP("LR",$JOB,"TST",LRTNAM)+LRTMULT
- +9 if '$DATA(^TMP("LR",$JOB,"WKLD/TST",LRCAPNAM))#2
- SET ^(LRCAPNAM)=0
- +10 SET ^(LRCAPNAM)=^TMP("LR",$JOB,"WKLD/TST",LRCAPNAM)+LRTMULT
- +11 if '$DATA(^TMP("LR",$JOB,"WKLD/TST",LRCAPNAM,LRTNAM))#2
- SET ^(LRTNAM)=0
- +12 SET ^(LRTNAM)=^TMP("LR",$JOB,"WKLD/TST",LRCAPNAM,LRTNAM)+LRTMULT
- +13 QUIT
- VENI ; ** VENIPUNCTURE SUMMARY **
- +1 SET LRSUM=+$PIECE($GET(^LRO(64.1,LRDIV,1,LRDT,1,657,"S")),U,4)
- +2 IF LRSUM
- SET LRCAPNAM=LRV657
- DO BMPVENI
- +3 SET LRSUM=+$PIECE($GET(^LRO(64.1,LRDIV,1,LRDT,1,658,"S")),U,4)
- +4 IF LRSUM
- SET LRCAPNAM=LRV658
- DO BMPVENI
- +5 QUIT
- BMPVENI ;
- +1 if '$DATA(^TMP("LR",$JOB,"VENI"))#2
- SET ^("VENI")=0
- +2 SET ^("VENI")=^TMP("LR",$JOB,"VENI")+LRSUM
- +3 if '$DATA(^TMP("LR",$JOB,"VENI",LRCAPNAM))#2
- SET ^(LRCAPNAM)=0
- +4 SET ^(LRCAPNAM)=^TMP("LR",$JOB,"VENI",LRCAPNAM)+LRSUM
- +5 QUIT
- PRINT ;
- +1 if $EXTRACT(IOST,1,2)="C-"
- WRITE @IOF
- +2 SET $PIECE(LRDASH,"-",IOM)=""
- SET $PIECE(LRSTAR,"*",IOM)=""
- +3 IF '$DATA(^TMP("LR",$JOB))
- DO NOTHING
- QUIT
- +4 if LRREPTYP="D"
- DO DET^LRRP6B3
- if LREND
- QUIT
- +5 DO COND^LRRP6B2
- +6 QUIT
- NOTHING ;
- +1 SET LRPAG=LRPAG+1
- +2 WRITE LRDASH
- +3 WRITE !,"Workload Code Summary for ",LRDATRNG
- +4 WRITE ?62,LRDAT,?72,"PAGE ",$JUSTIFY(LRPAG,3)
- +5 WRITE !!,LRSTAR
- +6 WRITE !!?18,"*** NO DATA FOR REPORT OPTIONS SELECTED ***"
- +7 IF $DATA(LRDIVSEL)
- Begin DoDot:1
- +8 WRITE !!,"DIVISIONS SELECTED",!,$EXTRACT(LRDASH,1,18)
- +9 SET LRDIV=""
- +10 FOR
- SET LRDIV=$ORDER(LRDIVSEL(LRDIV))
- if LRDIV=""
- QUIT
- WRITE !,LRDIVSEL(LRDIV)
- End DoDot:1
- +11 QUIT