| [613] | 1 | LRCAPML2 ;SLC/AM/DALISC/FHS - WKLD COST REP BY MAJ SCTN; 2/6/91@16:04
|
|---|
| 2 | ;;5.2;LAB SERVICE;;Sep 27, 1994
|
|---|
| 3 | EN ;
|
|---|
| 4 | TOP ;
|
|---|
| 5 | N LRCCNT,LRICNT,LROCNT,LRNCNT,LRACNT,LRCST,LRIST,LROST,LRNST,LRAST
|
|---|
| 6 | S LRHDR="WORKLOAD COST REPORT BY MAJOR SECTION"
|
|---|
| 7 | S LRHDR2="REPORT DATE RANGE: "_LRDT1_" - "_LRDT2
|
|---|
| 8 | D PRTINIT^LRCAPU
|
|---|
| 9 | S (LRGT,LRGTU)=0
|
|---|
| 10 | S LRGTREC=$G(^TMP("LR-WL",$J,0))
|
|---|
| 11 | I $L(LRGTREC) S LRGT=+$P(LRGTREC,U),LRGTU=+$P(LRGTREC,U,2)
|
|---|
| 12 | I $E(IOST,1,2)="C-" W @IOF
|
|---|
| 13 | D:'LRSUMM DET
|
|---|
| 14 | D:'LREND SUM^LRCAPML3
|
|---|
| 15 | D:'LREND PRNTMAN^LRCAPMR1
|
|---|
| 16 | D:'LREND COMM^LRCAPMR2
|
|---|
| 17 | Q
|
|---|
| 18 | DET ;Detailed section
|
|---|
| 19 | F LRLDIV="AP","CP" D Q:LREND
|
|---|
| 20 | . S LRHDR3=$S(LRLDIV="AP":"ANATOMIC PATHOLOGY",1:"CLINICAL PATHOLOGY")
|
|---|
| 21 | . S LRIN=0
|
|---|
| 22 | . F S LRIN=$O(^TMP("LR-WL",$J,"DIV",LRLDIV,LRIN)) Q:('LRIN)!(LREND) D
|
|---|
| 23 | . . S LRINN=$S($L($G(^DIC(4,LRIN,0))):$P(^(0),U),1:LRIN)
|
|---|
| 24 | . . S (LRIGT,LRIGTU)=0
|
|---|
| 25 | . . S LRGTREC=$G(^TMP("LR-WL",$J,"DIV",LRLDIV,LRIN,0))
|
|---|
| 26 | . . I $L(LRGTREC) S LRIGT=+$P(LRGTREC,U),LRIGTU=+$P(LRGTREC,U,2)
|
|---|
| 27 | . . D PRTDET
|
|---|
| 28 | . . D:('LREND)&(LRIGTU) INSTSUM
|
|---|
| 29 | Q
|
|---|
| 30 | PRTDET ; PRINT THE REPORT
|
|---|
| 31 | D HDR^LRCAPU
|
|---|
| 32 | W !,?(80-$L(LRINN)\2),LRINN,!!
|
|---|
| 33 | S LRMAA=0
|
|---|
| 34 | F S LRMAA=$O(^TMP("LR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA)) Q:(LRMAA="")!($G(LREND)) D
|
|---|
| 35 | . S LRLSSA=""
|
|---|
| 36 | . F S LRLSSA=$O(^TMP("LR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA)) Q:(LRLSSA)=""!(LREND) D LSS Q:LREND
|
|---|
| 37 | Q:LREND
|
|---|
| 38 | I $Y>(IOSL-5) D NPG^LRCAPU Q:LREND W !,?(80-$L(LRINN)\2),LRINN,!!
|
|---|
| 39 | I 'LRIGTU D
|
|---|
| 40 | . W !!!,"NO DATA FOR THIS INSTITUTION AND DATE RANGE",!
|
|---|
| 41 | E D
|
|---|
| 42 | . W !!!,"GRAND TOTAL",?52,$J(LRIGTU,7),?65,$J(LRIGT,9,2),!
|
|---|
| 43 | D:($E(IOST,1,2)="C-")&('LREND) PAUSE^LRCAPU W @IOF
|
|---|
| 44 | Q
|
|---|
| 45 | INSTSUM ;
|
|---|
| 46 | S LRLAB="!!,?(80-7\2),""SUMMARY"",!,?(80-$L(LRINN)\2),LRINN,!!,""MAJOR SECTION"",?15,""LAB SUBSECTION"",?31,""UNIT COUNT"",?45,"" %"",?55,""TOTAL COST"",?70,"" %"",!"
|
|---|
| 47 | D HDR^LRCAPU W @LRLAB
|
|---|
| 48 | S LRMAA=""
|
|---|
| 49 | F S LRMAA=$O(^TMP("LR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA)) Q:(LRMAA="")!(LREND) D
|
|---|
| 50 | . S LRLSSA=""
|
|---|
| 51 | . F S LRLSSA=$O(^TMP("LR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA)) Q:(LRLSSA="")!(LREND) D PSUM
|
|---|
| 52 | I $Y>(IOSL-4) D NPG^LRCAPU Q:LREND W @LRLAB
|
|---|
| 53 | W !!,"GRAND TOTAL",?31,$J(LRIGTU,7),?55,$J(LRIGT,9,2)
|
|---|
| 54 | D:($E(IOST,1,2)="C-")&('LREND) PAUSE^LRCAPU W @IOF
|
|---|
| 55 | Q
|
|---|
| 56 | PSUM ;
|
|---|
| 57 | Q:LREND
|
|---|
| 58 | S LRX=$G(^TMP("LR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA,0))
|
|---|
| 59 | Q:'$L(LRX)
|
|---|
| 60 | I $Y>(IOSL-3) D NPG^LRCAPU Q:LREND W @LRLAB
|
|---|
| 61 | W !,$E(LRMAN(LRMAA),1,14),?15,$E(LRLSSN(LRLSSA),1,15)
|
|---|
| 62 | W ?31,$J($P(LRX,U,2),7),?45,$J($P(LRX,U,2)/LRIGTU*100,5,1)
|
|---|
| 63 | W ?55,$J($P(LRX,U,1),9,2)
|
|---|
| 64 | W ?70,$J($P(LRX,U)/$S(LRIGT=0:1,1:LRIGT)*100,5,1),!
|
|---|
| 65 | Q
|
|---|
| 66 | LSS ;
|
|---|
| 67 | S LRLAB="!!,""MAJOR SECTION: "",LRMAN(LRMAA),!,""LAB SUBSECTION: "",LRLSSN(LRLSSA),!!,""CODE"",?11,""PROCEDURE"",?42,""UNIT COST"",?53,""UNIT COUNT"",?65,""TOTAL COST"",?70,"" %"",!"
|
|---|
| 68 | I $Y>(IOSL-7) D NPG^LRCAPU Q:LREND W !,?(80-$L(LRINN)\2),LRINN,!
|
|---|
| 69 | W @LRLAB
|
|---|
| 70 | S LRX=$G(^TMP("LR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA,0))
|
|---|
| 71 | S LRST=$P(LRX,U),LRSTU=$P(LRX,U,2)
|
|---|
| 72 | S LRCC=0
|
|---|
| 73 | F S LRCC=$O(^TMP("LR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA,LRCC)) Q:(LRCC="")!(LREND) D PCC
|
|---|
| 74 | Q:LREND
|
|---|
| 75 | I $Y>(IOSL-4) D NPG^LRCAPU Q:LREND W !,?(80-$L(LRINN)\2),LRINN,!,@LRLAB
|
|---|
| 76 | W !,?40,"SUB TOTAL",?52,$J(LRSTU,7),?65,$J(LRST,9,2)
|
|---|
| 77 | Q
|
|---|
| 78 | PCC ;
|
|---|
| 79 | S LRX=$G(^TMP("LR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA,LRCC))
|
|---|
| 80 | I $Y+3>IOSL D NPG^LRCAPU Q:LREND W !,?(80-$L(LRINN)\2),LRINN,!,@LRLAB
|
|---|
| 81 | W $P(LRX,"^",4),?11,$E(LRCC,1,30),?43,$J(+$P(LRX,"^",3),6,2)_$S($P(LRX,"^",3)["*":"*",1:"")
|
|---|
| 82 | W ?52,$J(+$P(LRX,"^"),7),?65,$J(+$P(LRX,"^",2),9,2)
|
|---|
| 83 | W ?75,$J($P(LRX,U)/$S(LRSTU=0:1,1:LRSTU)*100,5,1),!
|
|---|
| 84 | Q
|
|---|
