source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRARCR3.m@ 1258

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

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