source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRCAPR3.m@ 619

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

initial load of WorldVistAEHR
File size: 3.2 KB
Line 
1LRCAPR3 ;DALISC/PAC/FHS/JBM - WKLD REP GENERATOR-PRINT 1 ;10/16/92 16:49
2 ;;5.2;LAB SERVICE;**201**;Sep 27, 1994
3EN ;
4 D INIT1
5 D:('LREND)&(LRANS="D") DET
6 D:('LREND)&(LRANS="D") INIT2
7 D:'LREND COND^LRCAPR3A
8 D:'LREND TOTAL
9 D CLEAN^LRCAPR4
10 Q
11INIT1 ;
12 W:$E(IOST,1,2)="C-" @IOF
13 S (LREND,LRCONT)=0,(LRPG,LRFL)=1
14 K LRSTR,LRDSH
15 S LRDT=$$FMTE^XLFDT($$NOW^XLFDT,"1M")
16 S $P(LRSTR,"*",80)="*",$P(LRDSH,"-",80)="-"
17 D BLDHDR^LRCAPR4 I 'LRHDRFIT D REPHDR^LRCAPR4 Q:LREND
18 I '$D(^TMP("LR",$J,"TST/TOT")) D
19 . W !!,"*** NO DATA TO REPORT ***"
20 . D PAUSE^LRCAPR4 Q:LREND
21 . S LREND=1
22 Q:LREND
23 S LRSUM=^TMP("LR",$J,"TST/TOT")
24 S LRDT=$$FMTE^XLFDT($$NOW^XLFDT,"1M")
25 K %H,%I,X
26 Q
27INIT2 ;
28 S LRANS="C" ; condense rpt
29 I $E(IOST,1,2)="C-" D
30 . S DY=IOSL-3,DX=0
31 . X:$D(IOXY) IOXY
32 . W $C(7),!?60,"*** new heading ***"
33 . D PAUSE^LRCAPR4 Q:LREND
34 W @IOF
35 Q
36DET ;
37 S LRTST="",K=0
38 F S LRTST=$O(^TMP("LR",$J,"TST",LRTST)) Q:(LRTST="")!(LREND) D
39 . S LRLC="",LRSUBH=1
40 . F S LRLC=$O(^TMP("LR",$J,"TST",LRTST,LRLC)) Q:(LRLC="")!(LREND) D
41 . . S LRSUBH=1
42 . . S LRCAP=""
43 . . F S LRCAP=$O(^TMP("LR",$J,"TST",LRTST,LRLC,LRCAP)) Q:(LRCAP="")!(LREND) S LRCPT=^(LRCAP) D
44 . . . S LRAA="",J=0,LRSUBH=1
45 . . . F S LRAA=$O(^TMP("LR",$J,"TST",LRTST,LRLC,LRCAP,LRAA)) Q:(LRAA="")!(LREND) D
46 . . . . S LRCNT=""
47 . . . . F S LRCNT=$O(^TMP("LR",$J,"TST",LRTST,LRLC,LRCAP,LRAA,LRCNT)) Q:(LRCNT="")!(LREND) D
48 . . . . . S J=J+1
49 . . . . . I LRFL D HDR^LRCAPR4 S LRFL=0
50 . . . . . S X=^TMP("LR",$J,"TST",LRTST,LRLC,LRCAP,LRAA,LRCNT)
51 . . . . . S LRCODE=$P(X,U,2),LRURGNAM=$S($P(X,U,3)="":"",1:"**")
52 . . . . . S Y=$P(X,U,1) D DD^%DT S LRVD=Y
53 . . . . . I LRSUBH D SUBH^LRCAPR4 S LRSUBH=0
54 . . . . . W !,LRURGNAM,?3,LRAA,?36,LRVD
55 . . . . . S K=K+1 Q:K=LRSUM
56 . . . . . I $Y+6>IOSL D
57 . . . . . . D UP^LRCAPR4 Q:LREND
58 . . . . . . W @IOF D HDR^LRCAPR4
59 . . . . . . I J<LRCPT D SUBH^LRCAPR4
60 Q:LREND
61 I $E(IOST,1,2)="C-" D
62 . S DY=IOSL-2,DX=0
63 . X:$D(IOXY) IOXY
64 . W $C(7),!?56,"*** new sub-heading ***"
65 . D PAUSE^LRCAPR4
66 Q:LREND
67 W @IOF D HDR1^LRCAPR4
68 D DATE
69 Q
70DATE ;
71 S LRSUBH1="TOTAL TESTS by METHODOLOGY by DAY"_" ( "_LRSUM_" )"
72 W:$D(^TMP("LR",$J,"DAY")) !!?15,LRSUBH1,!?15,$E(LRDSH,1,$L(LRSUBH1))
73 S LRDAT=0
74 F S LRDAT=$O(^TMP("LR",$J,"DAY",LRDAT)) Q:('LRDAT)!(LREND) D
75 . S LRDATX=^TMP("LR",$J,"DAY",LRDAT)
76 . I $Y+6>IOSL D UP1^LRCAPR4 Q:LREND
77 . S Y=LRDAT D DD^%DT S LRDATD=Y W !!,">>>",?15,LRDATD," = ",LRDATX
78 . W ?35,$J($FN($S(LRSUM:LRDATX/LRSUM,1:0)*100,"",2),5),"% of Grand Total"
79 . S LRMAC=""
80 . F S LRMAC=$O(^TMP("LR",$J,"DAY",LRDAT,LRMAC)) Q:(LRMAC="")!(LREND) S LRMCT=^(LRMAC) D
81 . . I $Y+6>IOSL D UP1^LRCAPR4 Q:LREND
82 . . W !?1,"by ",LRMAC," = ",LRMCT," "
83 . . W $J($FN($S(LRDATX:LRMCT/LRDATX,1:0)*100,"",2),5)_"% of days workload"
84 . . S LRTEST=""
85 . . F I=0:1 S LRTEST=$O(^TMP("LR",$J,"DAY",LRDAT,LRMAC,LRTEST)) Q:(LRTEST="")!(LREND) S LRTMTOT=^(LRTEST) D
86 . . . S X=I#2 W:'X ! W ?X*40+1,LRTEST," = "
87 . . . W $J(LRTMTOT,4)_" "_$J($FN($S(LRMCT:LRTMTOT/LRMCT,1:0)*100,"",2),5)_"%"
88 . . . I X,$Y+6>IOSL D UP1^LRCAPR4 Q:LREND
89 Q
90TOTAL ;
91 I $Y+6>IOSL D
92 . W $C(7)
93 . D PAUSE^LRCAPR4 Q:LREND
94 . W @IOF D HDR1^LRCAPR4
95 Q:LREND
96 W !!!?10,"GRAND TOTAL of TESTS DONE = "_LRSUM_" 100.00%"
97 W !!,?25," ***** end of report *****"
98 Q
Note: See TracBrowser for help on using the repository browser.