- LRCAPMA2 ;SLC/AM/DALISC/FHS/J0 - WKLD REPORT BY MAJOR SECTION; 2/6/91
- ;;5.2;LAB SERVICE;;Sep 27, 1994
- EN ;
- TOP ;
- N LRCCNT,LRICNT,LROCNT,LRNCNT,LRACNT,LRCST,LRIST,LROST,LRNST,LRAST
- S LRHDR="WORKLOAD STATISTICS BY MAJOR SECTION"
- S LRHDR2="REPORT DATE RANGE: "_LRDT1_" - "_LRDT2
- D PRTINIT^LRCAPU
- S (LRCGT,LRIGT,LROGT,LRNGT,LRAGT)=0
- S LRGTREC=$G(^TMP("LR-WL",$J,0))
- I $L(LRGTREC) D
- . S LRCGT=+$P(LRGTREC,U),LRIGT=+$P(LRGTREC,U,2),LROGT=+$P(LRGTREC,U,3)
- . S LRNGT=+$P(LRGTREC,U,4),LRAGT=LRCGT+LRIGT+LROGT+LRNGT
- I $E(IOST,1,2)="C-" W @IOF
- D:'LRSUMM DET
- D:'LREND SUM^LRCAPMA3
- D:'LREND PRNTMAN^LRCAPMR1
- D:'LREND COMM^LRCAPMR2
- Q
- DET ;Detailed section
- F LRLDIV="AP","CP" D Q:LREND
- . S LRHDR3=$S(LRLDIV="AP":"ANATOMIC PATHOLOGY",1:"CLINICAL PATHOLOGY")
- . S LRIN=0
- . F S LRIN=$O(^TMP("LR-WL",$J,"DIV",LRLDIV,LRIN)) Q:('LRIN)!(LREND) D
- . . S LRINN=$S($L($G(^DIC(4,LRIN,0))):$P(^(0),U),1:LRIN)
- . . S (LRICGT,LRIIGT,LRIOGT,LRINGT,LRIAGT)=0
- . . S LRGTREC=$G(^TMP("LR-WL",$J,"DIV",LRLDIV,LRIN,0))
- . . I $L(LRGTREC) D
- . . . S LRICGT=+$P(LRGTREC,U),LRIIGT=+$P(LRGTREC,U,2)
- . . . S LRIOGT=+$P(LRGTREC,U,3),LRINGT=+$P(LRGTREC,U,4)
- . . . S LRIAGT=LRICGT+LRIIGT+LRIOGT+LRINGT
- . . D PRTDET
- . . D:('LREND)&(LRIAGT) INSTSUM
- Q
- PRTDET ;Print details
- D HDR^LRCAPU
- W !,?(80-$L(LRINN)\2),LRINN,!
- S LRMAA=0
- F S LRMAA=$O(^TMP("LR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA)) Q:(LRMAA="")!($G(LREND)) D
- . S LRLSSA=""
- . F S LRLSSA=$O(^TMP("LR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA)) Q:(LRLSSA="")!($G(LREND)) D LSS
- Q:LREND
- I $Y>(IOSL-5) D NPG^LRCAPU Q:LREND W !,?(80-$L(LRINN)\2),LRINN,!!
- I 'LRIAGT D
- . W !!!,"NO DATA FOR THIS INSTITUTION AND DATE RANGE",!
- E D
- . W !!!,"GRAND TOTAL",?43,$J(LRICGT,5),?50,$J(LRIIGT,5)
- . W ?57,$J(LRIOGT,5),?65,$J(LRINGT,5),?73,$J(LRIAGT,7),!
- D:($E(IOST,1,2)="C-")&('LREND) PAUSE^LRCAPU W @IOF
- Q
- INSTSUM ;
- S LRLAB="!!,?(80-7\2),""SUMMARY"",!,?(80-$L(LRINN)\2),LRINN,!!,""MAJOR SECTION"",?15,""LAB SUBSECTION"",?43,"" CTRL"",?50,""INPAT"",?56,""OUTPAT"",?64,""OTHERS"",?73,"" TOTAL"",!"
- D HDR^LRCAPU W @LRLAB
- S LRMAA=""
- F S LRMAA=$O(^TMP("LR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA)) Q:(LRMAA="")!(LREND) D
- . S LRLSSA=""
- . F S LRLSSA=$O(^TMP("LR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA)) Q:(LRLSSA="")!(LREND) D PSUM
- I $Y>(IOSL-4) D NPG^LRCAPU Q:LREND W @LRLAB
- W !!,"GRAND TOTAL",?43,$J(LRICGT,5),?50,$J(LRIIGT,5),?57,$J(LRIOGT,5)
- W ?65,$J(LRINGT,5),?73,$J(LRIAGT,7),!
- D:($E(IOST,1,2)="C-")&('LREND) PAUSE^LRCAPU W @IOF
- Q
- PSUM ;
- Q:LREND
- Q:'$D(^TMP("LR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA,0))#2 S LRX=^(0)
- I $Y>(IOSL-3) D NPG^LRCAPU Q:LREND W @LRLAB
- S LRCCNT=+$P(LRX,U),LRICNT=+$P(LRX,U,2),LROCNT=+$P(LRX,U,3)
- S LRNCNT=+$P(LRX,U,4),LRACNT=LRCCNT+LRICNT+LROCNT+LRNCNT
- W !,$E(LRMAN(LRMAA),1,14),?15,$E(LRLSSN(LRLSSA),1,14),?31,"NUMBER :"
- W ?43,$J(LRCCNT,5),?50,$J(LRICNT,5),?57,$J(LROCNT,5)
- W ?65,$J(LRNCNT,5),?73,$J(LRACNT,7)
- W !,?31,"PERCENT :"
- W ?43,$J($S(LRIAGT:LRCCNT/LRIAGT,1:0)*100,5,1),?50,$J($S(LRIAGT:LRICNT/LRIAGT,1:0)*100,5,1)
- W ?57,$J($S(LRIAGT:LROCNT/LRIAGT,1:0)*100,5,1),?65,$J($S(LRIAGT:LRNCNT/LRIAGT,1:0)*100,5,1)
- W ?73,$J($S(LRIAGT:LRACNT/LRIAGT,1:0)*100,7,1)
- W !
- Q
- LSS ;
- S LRLAB="!!,""MAJOR SECTION: "",LRMAN(LRMAA),!,""LAB SUBSECTION: "",LRLSSN(LRLSSA),!!,""CODE"",?11,""PROCEDURE"",?43,""CNTRL"",?50,""INPAT"",?56,""OUTPAT"",?64,""OTHERS"",?73,"" TOTAL"",!"
- I $Y>(IOSL-7) D NPG^LRCAPU Q:LREND W !,?(80-$L(LRINN)\2),LRINN,!
- W @LRLAB
- S (LRCST,LRIST,LROST,LRNST,LRAST,LRCC)=0
- F S LRCC=$O(^TMP("LR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA,LRCC)) Q:(LRCC="")!(LREND) D PCC
- Q:LREND
- S LRX=$G(^TMP("LR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA,0))
- S LRCST=+$P(LRX,U),LRIST=+$P(LRX,U,2),LROST=+$P(LRX,U,3)
- S LRNST=+$P(LRX,U,4),LRAST=LRCST+LRIST+LROST+LRNST
- I $Y+4>IOSL D NPG^LRCAPU Q:LREND W !,?(80-$L(LRINN)\2),LRINN,!,@LRLAB
- W !,?11,"SUB TOTAL",?43,$J(LRCST,5),?50,$J(LRIST,5)
- W ?57,$J(LROST,5),?65,$J(LRNST,5),?73,$J(LRAST,7),!
- Q
- PCC ;
- S LRX=$G(^TMP("LR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA,LRCC))
- I $Y+3>IOSL D NPG^LRCAPU Q:LREND W !,?(80-$L(LRINN)\2),LRINN,!,@LRLAB
- S LRCCNT=+$P(LRX,U),LRICNT=+$P(LRX,U,2),LROCNT=+$P(LRX,U,3)
- S LRNCNT=+$P(LRX,U,4),LRACNT=LRCCNT+LRICNT+LROCNT+LRNCNT
- W $P(LRX,U,5),?11,$E(LRCC,1,30),?43,$J(LRCCNT,5),?50,$J(LRICNT,5)
- W ?57,$J(LROCNT,5),?65,$J(LRNCNT,5),?73,$J(LRACNT,7),!
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRCAPMA2 4404 printed Jan 18, 2025@03:13:43 Page 2
- LRCAPMA2 ;SLC/AM/DALISC/FHS/J0 - WKLD REPORT BY MAJOR SECTION; 2/6/91
- +1 ;;5.2;LAB SERVICE;;Sep 27, 1994
- EN ;
- TOP ;
- +1 NEW LRCCNT,LRICNT,LROCNT,LRNCNT,LRACNT,LRCST,LRIST,LROST,LRNST,LRAST
- +2 SET LRHDR="WORKLOAD STATISTICS BY MAJOR SECTION"
- +3 SET LRHDR2="REPORT DATE RANGE: "_LRDT1_" - "_LRDT2
- +4 DO PRTINIT^LRCAPU
- +5 SET (LRCGT,LRIGT,LROGT,LRNGT,LRAGT)=0
- +6 SET LRGTREC=$GET(^TMP("LR-WL",$JOB,0))
- +7 IF $LENGTH(LRGTREC)
- Begin DoDot:1
- +8 SET LRCGT=+$PIECE(LRGTREC,U)
- SET LRIGT=+$PIECE(LRGTREC,U,2)
- SET LROGT=+$PIECE(LRGTREC,U,3)
- +9 SET LRNGT=+$PIECE(LRGTREC,U,4)
- SET LRAGT=LRCGT+LRIGT+LROGT+LRNGT
- End DoDot:1
- +10 IF $EXTRACT(IOST,1,2)="C-"
- WRITE @IOF
- +11 if 'LRSUMM
- DO DET
- +12 if 'LREND
- DO SUM^LRCAPMA3
- +13 if 'LREND
- DO PRNTMAN^LRCAPMR1
- +14 if 'LREND
- DO COMM^LRCAPMR2
- +15 QUIT
- DET ;Detailed section
- +1 FOR LRLDIV="AP","CP"
- Begin DoDot:1
- +2 SET LRHDR3=$SELECT(LRLDIV="AP":"ANATOMIC PATHOLOGY",1:"CLINICAL PATHOLOGY")
- +3 SET LRIN=0
- +4 FOR
- SET LRIN=$ORDER(^TMP("LR-WL",$JOB,"DIV",LRLDIV,LRIN))
- if ('LRIN)!(LREND)
- QUIT
- Begin DoDot:2
- +5 SET LRINN=$SELECT($LENGTH($GET(^DIC(4,LRIN,0))):$PIECE(^(0),U),1:LRIN)
- +6 SET (LRICGT,LRIIGT,LRIOGT,LRINGT,LRIAGT)=0
- +7 SET LRGTREC=$GET(^TMP("LR-WL",$JOB,"DIV",LRLDIV,LRIN,0))
- +8 IF $LENGTH(LRGTREC)
- Begin DoDot:3
- +9 SET LRICGT=+$PIECE(LRGTREC,U)
- SET LRIIGT=+$PIECE(LRGTREC,U,2)
- +10 SET LRIOGT=+$PIECE(LRGTREC,U,3)
- SET LRINGT=+$PIECE(LRGTREC,U,4)
- +11 SET LRIAGT=LRICGT+LRIIGT+LRIOGT+LRINGT
- End DoDot:3
- +12 DO PRTDET
- +13 if ('LREND)&(LRIAGT)
- DO INSTSUM
- End DoDot:2
- End DoDot:1
- if LREND
- QUIT
- +14 QUIT
- PRTDET ;Print details
- +1 DO HDR^LRCAPU
- +2 WRITE !,?(80-$LENGTH(LRINN)\2),LRINN,!
- +3 SET LRMAA=0
- +4 FOR
- SET LRMAA=$ORDER(^TMP("LR-WL",$JOB,"DIV",LRLDIV,LRIN,LRMAA))
- if (LRMAA="")!($GET(LREND))
- QUIT
- Begin DoDot:1
- +5 SET LRLSSA=""
- +6 FOR
- SET LRLSSA=$ORDER(^TMP("LR-WL",$JOB,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA))
- if (LRLSSA="")!($GET(LREND))
- QUIT
- DO LSS
- End DoDot:1
- +7 if LREND
- QUIT
- +8 IF $Y>(IOSL-5)
- DO NPG^LRCAPU
- if LREND
- QUIT
- WRITE !,?(80-$LENGTH(LRINN)\2),LRINN,!!
- +9 IF 'LRIAGT
- Begin DoDot:1
- +10 WRITE !!!,"NO DATA FOR THIS INSTITUTION AND DATE RANGE",!
- End DoDot:1
- +11 IF '$TEST
- Begin DoDot:1
- +12 WRITE !!!,"GRAND TOTAL",?43,$JUSTIFY(LRICGT,5),?50,$JUSTIFY(LRIIGT,5)
- +13 WRITE ?57,$JUSTIFY(LRIOGT,5),?65,$JUSTIFY(LRINGT,5),?73,$JUSTIFY(LRIAGT,7),!
- End DoDot:1
- +14 if ($EXTRACT(IOST,1,2)="C-")&('LREND)
- DO PAUSE^LRCAPU
- WRITE @IOF
- +15 QUIT
- INSTSUM ;
- +1 SET LRLAB="!!,?(80-7\2),""SUMMARY"",!,?(80-$L(LRINN)\2),LRINN,!!,""MAJOR SECTION"",?15,""LAB SUBSECTION"",?43,"" CTRL"",?50,""INPAT"",?56,""OUTPAT"",?64,""OTHERS"",?73,"" TOTAL"",!"
- +2 DO HDR^LRCAPU
- WRITE @LRLAB
- +3 SET LRMAA=""
- +4 FOR
- SET LRMAA=$ORDER(^TMP("LR-WL",$JOB,"DIV",LRLDIV,LRIN,LRMAA))
- if (LRMAA="")!(LREND)
- QUIT
- Begin DoDot:1
- +5 SET LRLSSA=""
- +6 FOR
- SET LRLSSA=$ORDER(^TMP("LR-WL",$JOB,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA))
- if (LRLSSA="")!(LREND)
- QUIT
- DO PSUM
- End DoDot:1
- +7 IF $Y>(IOSL-4)
- DO NPG^LRCAPU
- if LREND
- QUIT
- WRITE @LRLAB
- +8 WRITE !!,"GRAND TOTAL",?43,$JUSTIFY(LRICGT,5),?50,$JUSTIFY(LRIIGT,5),?57,$JUSTIFY(LRIOGT,5)
- +9 WRITE ?65,$JUSTIFY(LRINGT,5),?73,$JUSTIFY(LRIAGT,7),!
- +10 if ($EXTRACT(IOST,1,2)="C-")&('LREND)
- DO PAUSE^LRCAPU
- WRITE @IOF
- +11 QUIT
- PSUM ;
- +1 if LREND
- QUIT
- +2 if '$DATA(^TMP("LR-WL",$JOB,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA,0))#2
- QUIT
- SET LRX=^(0)
- +3 IF $Y>(IOSL-3)
- DO NPG^LRCAPU
- if LREND
- QUIT
- WRITE @LRLAB
- +4 SET LRCCNT=+$PIECE(LRX,U)
- SET LRICNT=+$PIECE(LRX,U,2)
- SET LROCNT=+$PIECE(LRX,U,3)
- +5 SET LRNCNT=+$PIECE(LRX,U,4)
- SET LRACNT=LRCCNT+LRICNT+LROCNT+LRNCNT
- +6 WRITE !,$EXTRACT(LRMAN(LRMAA),1,14),?15,$EXTRACT(LRLSSN(LRLSSA),1,14),?31,"NUMBER :"
- +7 WRITE ?43,$JUSTIFY(LRCCNT,5),?50,$JUSTIFY(LRICNT,5),?57,$JUSTIFY(LROCNT,5)
- +8 WRITE ?65,$JUSTIFY(LRNCNT,5),?73,$JUSTIFY(LRACNT,7)
- +9 WRITE !,?31,"PERCENT :"
- +10 WRITE ?43,$JUSTIFY($SELECT(LRIAGT:LRCCNT/LRIAGT,1:0)*100,5,1),?50,$JUSTIFY($SELECT(LRIAGT:LRICNT/LRIAGT,1:0)*100,5,1)
- +11 WRITE ?57,$JUSTIFY($SELECT(LRIAGT:LROCNT/LRIAGT,1:0)*100,5,1),?65,$JUSTIFY($SELECT(LRIAGT:LRNCNT/LRIAGT,1:0)*100,5,1)
- +12 WRITE ?73,$JUSTIFY($SELECT(LRIAGT:LRACNT/LRIAGT,1:0)*100,7,1)
- +13 WRITE !
- +14 QUIT
- LSS ;
- +1 SET LRLAB="!!,""MAJOR SECTION: "",LRMAN(LRMAA),!,""LAB SUBSECTION: "",LRLSSN(LRLSSA),!!,""CODE"",?11,""PROCEDURE"",?43,""CNTRL"",?50,""INPAT"",?56,""OUTPAT"",?64,""OTHERS"",?73,"" TOTAL"",!"
- +2 IF $Y>(IOSL-7)
- DO NPG^LRCAPU
- if LREND
- QUIT
- WRITE !,?(80-$LENGTH(LRINN)\2),LRINN,!
- +3 WRITE @LRLAB
- +4 SET (LRCST,LRIST,LROST,LRNST,LRAST,LRCC)=0
- +5 FOR
- SET LRCC=$ORDER(^TMP("LR-WL",$JOB,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA,LRCC))
- if (LRCC="")!(LREND)
- QUIT
- DO PCC
- +6 if LREND
- QUIT
- +7 SET LRX=$GET(^TMP("LR-WL",$JOB,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA,0))
- +8 SET LRCST=+$PIECE(LRX,U)
- SET LRIST=+$PIECE(LRX,U,2)
- SET LROST=+$PIECE(LRX,U,3)
- +9 SET LRNST=+$PIECE(LRX,U,4)
- SET LRAST=LRCST+LRIST+LROST+LRNST
- +10 IF $Y+4>IOSL
- DO NPG^LRCAPU
- if LREND
- QUIT
- WRITE !,?(80-$LENGTH(LRINN)\2),LRINN,!,@LRLAB
- +11 WRITE !,?11,"SUB TOTAL",?43,$JUSTIFY(LRCST,5),?50,$JUSTIFY(LRIST,5)
- +12 WRITE ?57,$JUSTIFY(LROST,5),?65,$JUSTIFY(LRNST,5),?73,$JUSTIFY(LRAST,7),!
- +13 QUIT
- PCC ;
- +1 SET LRX=$GET(^TMP("LR-WL",$JOB,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA,LRCC))
- +2 IF $Y+3>IOSL
- DO NPG^LRCAPU
- if LREND
- QUIT
- WRITE !,?(80-$LENGTH(LRINN)\2),LRINN,!,@LRLAB
- +3 SET LRCCNT=+$PIECE(LRX,U)
- SET LRICNT=+$PIECE(LRX,U,2)
- SET LROCNT=+$PIECE(LRX,U,3)
- +4 SET LRNCNT=+$PIECE(LRX,U,4)
- SET LRACNT=LRCCNT+LRICNT+LROCNT+LRNCNT
- +5 WRITE $PIECE(LRX,U,5),?11,$EXTRACT(LRCC,1,30),?43,$JUSTIFY(LRCCNT,5),?50,$JUSTIFY(LRICNT,5)
- +6 WRITE ?57,$JUSTIFY(LROCNT,5),?65,$JUSTIFY(LRNCNT,5),?73,$JUSTIFY(LRACNT,7),!
- +7 QUIT