source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRARCMA2.m@ 846

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

initial load of WorldVistAEHR

File size: 3.1 KB
RevLine 
[613]1LRARCMA2 ;DALISC/CKA - ARCHIVED WKLD REPORT BY MAJOR SECTION; 6/1/95
2 ;;5.2;LAB SERVICE;**59**;Aug 31, 1995
3 ;same as LRCAPMA2 except archived wkld file
4EN ;
5TOP ;
6 N LRCCNT,LRICNT,LROCNT,LRNCNT,LRACNT,LRCST,LRIST,LROST,LRNST,LRAST
7 S LRHDR="ARCHIVED WORKLOAD STATISTICS BY MAJOR SECTION"
8 S LRHDR2="REPORT DATE RANGE: "_LRDT1_" - "_LRDT2
9 D PRTINIT^LRARCU
10 S LRAGT=0
11 S LRGTREC=$G(^TMP("LRAR-WL",$J,0))
12 I $L(LRGTREC) D
13 . S LRAGT=+$P(LRGTREC,U)
14 I $E(IOST,1,2)="C-" W @IOF
15 D:'LRSUMM DET
16 D:'LREND SUM^LRARCMA3
17 D:'LREND PRNTMAN^LRARCMR1
18 D:'LREND COMM^LRARCMR2
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("LRAR-WL",$J,"DIV",LRLDIV,LRIN)) Q:('LRIN)!(LREND) D
25 . . S LRINN=$S($L($G(^LAR(64.19999,LRIN,0))):$P(^(0),U),1:LRIN)
26 . . S LRIAGT=0
27 . . S LRGTREC=$G(^TMP("LRAR-WL",$J,"DIV",LRLDIV,LRIN,0))
28 . . I $L(LRGTREC) D
29 . . . S LRIAGT=+$P(LRGTREC,U)
30 . . D PRTDET
31 . . D:('LREND)&(LRIAGT) INSTSUM
32 Q
33PRTDET ;Print details
34 D HDR^LRARCU
35 W !,?(80-$L(LRINN)\2),LRINN,!
36 S LRMAA=0
37 F S LRMAA=$O(^TMP("LRAR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA)) Q:(LRMAA="")!($G(LREND)) D
38 . S LRLSSA=""
39 . F S LRLSSA=$O(^TMP("LRAR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA)) Q:(LRLSSA="")!($G(LREND)) D LSS
40 Q:LREND
41 I $Y>(IOSL-5) D NPG^LRARCU Q:LREND W !,?(80-$L(LRINN)\2),LRINN,!!
42 I 'LRIAGT D
43 . W !!!,"NO DATA FOR THIS INSTITUTION AND DATE RANGE",!
44 E D
45 . W !!!,"GRAND TOTAL",?43,$J(LRIAGT,7)
46 D:($E(IOST,1,2)="C-")&('LREND) PAUSE^LRARCU W @IOF
47 Q
48INSTSUM ;
49 S LRLAB="!!,?(80-7\2),""SUMMARY"",!,?(80-$L(LRINN)\2),LRINN,!!,""MAJOR SECTION"",?15,""LAB SUBSECTION"",?43,"" TOTAL"",!"
50 D HDR^LRARCU W @LRLAB
51 S LRMAA=""
52 F S LRMAA=$O(^TMP("LRAR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA)) Q:(LRMAA="")!(LREND) D
53 . S LRLSSA=""
54 . F S LRLSSA=$O(^TMP("LRAR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA)) Q:(LRLSSA="")!(LREND) D PSUM
55 I $Y>(IOSL-4) D NPG^LRARCU Q:LREND W @LRLAB
56 W !!,"GRAND TOTAL",?43,$J(LRIAGT,7)
57 D:($E(IOST,1,2)="C-")&('LREND) PAUSE^LRARCU W @IOF
58 Q
59PSUM ;
60 Q:LREND
61 Q:'$D(^TMP("LRAR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA,0))#2 S LRX=^(0)
62 I $Y>(IOSL-3) D NPG^LRARCU Q:LREND W @LRLAB
63 S LRACNT=$P(LRX,U)
64 W !,$E(LRMAN(LRMAA),1,14),?15,$E(LRLSSN(LRLSSA),1,14),?31,"NUMBER :"
65 W ?43,$J(LRACNT,7)
66 W !,?31,"PERCENT :"
67 W ?43,$J($S(LRIAGT:LRACNT/LRIAGT,1:0)*100,7,1)
68 W !
69 Q
70LSS ;
71 S LRLAB="!!,""MAJOR SECTION: "",LRMAN(LRMAA),!,""LAB SUBSECTION: "",LRLSSN(LRLSSA),!!,""CODE"",?11,""PROCEDURE"",?43,"" TOTAL"",!"
72 I $Y>(IOSL-7) D NPG^LRARCU Q:LREND W !,?(80-$L(LRINN)\2),LRINN,!
73 W @LRLAB
74 S (LRAST,LRCC)=0
75 F S LRCC=$O(^TMP("LRAR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA,LRCC)) Q:(LRCC="")!(LREND) D PCC
76 Q:LREND
77 S LRX=$G(^TMP("LRAR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA,0))
78 S LRAST=+$P(LRX,U)
79 I $Y+4>IOSL D NPG^LRARCU Q:LREND W !,?(80-$L(LRINN)\2),LRINN,!,@LRLAB
80 W !,?11,"SUB TOTAL",?43,$J(LRAST,7),!
81 Q
82PCC ;
83 S LRX=$G(^TMP("LRAR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA,LRCC))
84 I $Y+3>IOSL D NPG^LRARCU Q:LREND W !,?(80-$L(LRINN)\2),LRINN,!,@LRLAB
85 S LRACNT=+$P(LRX,U)
86 W $P(LRX,U,2),?11,$E(LRCC,1,30),?43,$J(LRACNT,7),!
87 Q
Note: See TracBrowser for help on using the repository browser.