source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRCAPMA2.m@ 648

Last change on this file since 648 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.2 KB
Line 
1LRCAPMA2 ;SLC/AM/DALISC/FHS/J0 - WKLD REPORT BY MAJOR SECTION; 2/6/91
2 ;;5.2;LAB SERVICE;;Sep 27, 1994
3EN ;
4TOP ;
5 N LRCCNT,LRICNT,LROCNT,LRNCNT,LRACNT,LRCST,LRIST,LROST,LRNST,LRAST
6 S LRHDR="WORKLOAD STATISTICS BY MAJOR SECTION"
7 S LRHDR2="REPORT DATE RANGE: "_LRDT1_" - "_LRDT2
8 D PRTINIT^LRCAPU
9 S (LRCGT,LRIGT,LROGT,LRNGT,LRAGT)=0
10 S LRGTREC=$G(^TMP("LR-WL",$J,0))
11 I $L(LRGTREC) D
12 . S LRCGT=+$P(LRGTREC,U),LRIGT=+$P(LRGTREC,U,2),LROGT=+$P(LRGTREC,U,3)
13 . S LRNGT=+$P(LRGTREC,U,4),LRAGT=LRCGT+LRIGT+LROGT+LRNGT
14 I $E(IOST,1,2)="C-" W @IOF
15 D:'LRSUMM DET
16 D:'LREND SUM^LRCAPMA3
17 D:'LREND PRNTMAN^LRCAPMR1
18 D:'LREND COMM^LRCAPMR2
19 Q
20DET ;Detailed section
21 F LRLDIV="AP","CP" D Q:LREND
22 . S LRHDR3=$S(LRLDIV="AP":"ANATOMIC PATHOLOGY",1:"CLINICAL PATHOLOGY")
23 . S LRIN=0
24 . F S LRIN=$O(^TMP("LR-WL",$J,"DIV",LRLDIV,LRIN)) Q:('LRIN)!(LREND) D
25 . . S LRINN=$S($L($G(^DIC(4,LRIN,0))):$P(^(0),U),1:LRIN)
26 . . S (LRICGT,LRIIGT,LRIOGT,LRINGT,LRIAGT)=0
27 . . S LRGTREC=$G(^TMP("LR-WL",$J,"DIV",LRLDIV,LRIN,0))
28 . . I $L(LRGTREC) D
29 . . . S LRICGT=+$P(LRGTREC,U),LRIIGT=+$P(LRGTREC,U,2)
30 . . . S LRIOGT=+$P(LRGTREC,U,3),LRINGT=+$P(LRGTREC,U,4)
31 . . . S LRIAGT=LRICGT+LRIIGT+LRIOGT+LRINGT
32 . . D PRTDET
33 . . D:('LREND)&(LRIAGT) INSTSUM
34 Q
35PRTDET ;Print details
36 D HDR^LRCAPU
37 W !,?(80-$L(LRINN)\2),LRINN,!
38 S LRMAA=0
39 F S LRMAA=$O(^TMP("LR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA)) Q:(LRMAA="")!($G(LREND)) D
40 . S LRLSSA=""
41 . F S LRLSSA=$O(^TMP("LR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA)) Q:(LRLSSA="")!($G(LREND)) D LSS
42 Q:LREND
43 I $Y>(IOSL-5) D NPG^LRCAPU Q:LREND W !,?(80-$L(LRINN)\2),LRINN,!!
44 I 'LRIAGT D
45 . W !!!,"NO DATA FOR THIS INSTITUTION AND DATE RANGE",!
46 E D
47 . W !!!,"GRAND TOTAL",?43,$J(LRICGT,5),?50,$J(LRIIGT,5)
48 . W ?57,$J(LRIOGT,5),?65,$J(LRINGT,5),?73,$J(LRIAGT,7),!
49 D:($E(IOST,1,2)="C-")&('LREND) PAUSE^LRCAPU W @IOF
50 Q
51INSTSUM ;
52 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"",!"
53 D HDR^LRCAPU W @LRLAB
54 S LRMAA=""
55 F S LRMAA=$O(^TMP("LR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA)) Q:(LRMAA="")!(LREND) D
56 . S LRLSSA=""
57 . F S LRLSSA=$O(^TMP("LR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA)) Q:(LRLSSA="")!(LREND) D PSUM
58 I $Y>(IOSL-4) D NPG^LRCAPU Q:LREND W @LRLAB
59 W !!,"GRAND TOTAL",?43,$J(LRICGT,5),?50,$J(LRIIGT,5),?57,$J(LRIOGT,5)
60 W ?65,$J(LRINGT,5),?73,$J(LRIAGT,7),!
61 D:($E(IOST,1,2)="C-")&('LREND) PAUSE^LRCAPU W @IOF
62 Q
63PSUM ;
64 Q:LREND
65 Q:'$D(^TMP("LR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA,0))#2 S LRX=^(0)
66 I $Y>(IOSL-3) D NPG^LRCAPU Q:LREND W @LRLAB
67 S LRCCNT=+$P(LRX,U),LRICNT=+$P(LRX,U,2),LROCNT=+$P(LRX,U,3)
68 S LRNCNT=+$P(LRX,U,4),LRACNT=LRCCNT+LRICNT+LROCNT+LRNCNT
69 W !,$E(LRMAN(LRMAA),1,14),?15,$E(LRLSSN(LRLSSA),1,14),?31,"NUMBER :"
70 W ?43,$J(LRCCNT,5),?50,$J(LRICNT,5),?57,$J(LROCNT,5)
71 W ?65,$J(LRNCNT,5),?73,$J(LRACNT,7)
72 W !,?31,"PERCENT :"
73 W ?43,$J($S(LRIAGT:LRCCNT/LRIAGT,1:0)*100,5,1),?50,$J($S(LRIAGT:LRICNT/LRIAGT,1:0)*100,5,1)
74 W ?57,$J($S(LRIAGT:LROCNT/LRIAGT,1:0)*100,5,1),?65,$J($S(LRIAGT:LRNCNT/LRIAGT,1:0)*100,5,1)
75 W ?73,$J($S(LRIAGT:LRACNT/LRIAGT,1:0)*100,7,1)
76 W !
77 Q
78LSS ;
79 S LRLAB="!!,""MAJOR SECTION: "",LRMAN(LRMAA),!,""LAB SUBSECTION: "",LRLSSN(LRLSSA),!!,""CODE"",?11,""PROCEDURE"",?43,""CNTRL"",?50,""INPAT"",?56,""OUTPAT"",?64,""OTHERS"",?73,"" TOTAL"",!"
80 I $Y>(IOSL-7) D NPG^LRCAPU Q:LREND W !,?(80-$L(LRINN)\2),LRINN,!
81 W @LRLAB
82 S (LRCST,LRIST,LROST,LRNST,LRAST,LRCC)=0
83 F S LRCC=$O(^TMP("LR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA,LRCC)) Q:(LRCC="")!(LREND) D PCC
84 Q:LREND
85 S LRX=$G(^TMP("LR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA,0))
86 S LRCST=+$P(LRX,U),LRIST=+$P(LRX,U,2),LROST=+$P(LRX,U,3)
87 S LRNST=+$P(LRX,U,4),LRAST=LRCST+LRIST+LROST+LRNST
88 I $Y+4>IOSL D NPG^LRCAPU Q:LREND W !,?(80-$L(LRINN)\2),LRINN,!,@LRLAB
89 W !,?11,"SUB TOTAL",?43,$J(LRCST,5),?50,$J(LRIST,5)
90 W ?57,$J(LROST,5),?65,$J(LRNST,5),?73,$J(LRAST,7),!
91 Q
92PCC ;
93 S LRX=$G(^TMP("LR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA,LRCC))
94 I $Y+3>IOSL D NPG^LRCAPU Q:LREND W !,?(80-$L(LRINN)\2),LRINN,!,@LRLAB
95 S LRCCNT=+$P(LRX,U),LRICNT=+$P(LRX,U,2),LROCNT=+$P(LRX,U,3)
96 S LRNCNT=+$P(LRX,U,4),LRACNT=LRCCNT+LRICNT+LROCNT+LRNCNT
97 W $P(LRX,U,5),?11,$E(LRCC,1,30),?43,$J(LRCCNT,5),?50,$J(LRICNT,5)
98 W ?57,$J(LROCNT,5),?65,$J(LRNCNT,5),?73,$J(LRACNT,7),!
99 Q
Note: See TracBrowser for help on using the repository browser.