source: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRCAPR3A.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.8 KB
Line 
1LRCAPR3A ;DALISC/PAC/FHS/JBM - WKLD REP GENERATOR-PRINT 2 ;10/16/92 16:49
2 ;;5.2;LAB SERVICE;;Sep 27, 1994
3COND ;
4 D HDR1^LRCAPR4
5 D LOC Q:LREND
6 D LRMAC Q:LREND
7 D:LRCTL CONTROL Q:LREND
8 D WKLD Q:LREND
9 D STAT
10 Q
11LOC ;
12 Q:'$D(^TMP("LR",$J,"TST/LOC"))
13 S LRSUBH1="TOTAL TESTS BY LOCATION: % of GRAND TOTAL"_" ( "_LRSUM_" )"
14 W !!!?15,LRSUBH1,!?15,$E(LRDSH,1,$L(LRSUBH1)),!
15 S LRLOC=""
16 F I=0:1 S LRLOC=$O(^TMP("LR",$J,"TST/LOC",LRLOC)) Q:(LRLOC="")!(LREND) D
17 . S X=I#2 W:'X ! W ?X*40
18 . W $E(LRLOC_" ",1,20),"="
19 . W $J(^TMP("LR",$J,"TST/LOC",LRLOC),4)," "
20 . W $J($FN($S(LRSUM:^(LRLOC)/LRSUM,1:0)*100,"",2),5),"%"
21 . I X,$Y+6>IOSL D UP1^LRCAPR4 Q:LREND
22 Q
23LRMAC ;
24 Q:'$D(^TMP("LR",$J,"TST/LRM"))
25 S LRSUBH1="TOTAL TESTS by INSTRUMENTS: % of GRAND TOTAL"_" ( "_LRSUM_" )"
26 I $Y+9>IOSL D PAUSE^LRCAPR4 Q:LREND W @IOF D HDR1^LRCAPR4
27 W !!!?15,LRSUBH1,!?15,$E(LRDSH,1,$L(LRSUBH1))
28 S LRMAC=""
29 F S LRMAC=$O(^TMP("LR",$J,"TST/LRM",LRMAC)) Q:(LRMAC="")!(LREND) S LRLMAC=^(LRMAC) D
30 . I $Y+6>IOSL D UP1^LRCAPR4 Q:LREND
31 . W !!,LRMAC," =",$J(LRLMAC,5)," "
32 . W $J($FN($S(LRSUM:LRLMAC/LRSUM,1:0)*100,"",2),5),"%"
33 . S LRTEST=""
34 . F I=0:1 S LRTEST=$O(^TMP("LR",$J,"TST/LRM",LRMAC,LRTEST)) Q:(LRTEST="")!(LREND) D
35 . . S X=I#2 W:'X ! W ?X*40+1
36 . . W LRTEST," = ",$J(^TMP("LR",$J,"TST/LRM",LRMAC,LRTEST),5)
37 . . W " ",$J($FN($S(LRLMAC:^(LRTEST)/LRLMAC,1:0)*100,"",2),5),"%"
38 . . I X,$Y+6>IOSL D UP1^LRCAPR4 Q:LREND
39 Q
40CONTROL ;
41 Q:'$D(^TMP("LR",$J,"TST/CTL"))
42 S LRSUBH1="Total CONTROL TESTS by INSTRUMENTS: % of GRAND TOTAL"_" ( "_LRSUM_" )"
43 I $Y+9>IOSL D PAUSE^LRCAPR4 Q:LREND W @IOF D HDR1^LRCAPR4
44 W !!!?15,LRSUBH1,!?15,$E(LRDSH,1,$L(LRSUBH1))
45 S LRMAC=""
46 F S LRMAC=$O(^TMP("LR",$J,"TST/CTL",LRMAC)) Q:(LRMAC="")!(LREND) S LRLMAC=^(LRMAC) D
47 . I $Y+6>IOSL D UP1^LRCAPR4 Q:LREND
48 . W !!,LRMAC," =",$J(LRLMAC,5)," "
49 . W $J($FN($S(LRSUM:LRLMAC/LRSUM,1:0)*100,"",2),5),"%"
50 . S LRTEST=""
51 . F I=0:1 S LRTEST=$O(^TMP("LR",$J,"TST/CTL",LRMAC,LRTEST)) Q:(LRTEST="")!(LREND) D
52 . . S X=I#2 W:'X ! W ?X*40+1
53 . . W LRTEST," = ",$J(^TMP("LR",$J,"TST/CTL",LRMAC,LRTEST),5)
54 . . W " ",$J($FN($S(LRLMAC:^(LRTEST)/LRLMAC,1:0)*100,"",2),5),"%"
55 . . I X,$Y+6>IOSL D UP1^LRCAPR4 Q:LREND
56 Q
57WKLD ;
58 Q:'$D(^TMP("LR",$J,"TST"))
59 S LRSUBH1="TOTAL WKLD by TESTS: % of GRAND TOTAL"_" ( "_LRSUM_" )"
60 I $Y+9>IOSL D PAUSE^LRCAPR4 Q:LREND W @IOF D HDR1^LRCAPR4
61 W !!!,?15,LRSUBH1,!?15,$E(LRDSH,1,$L(LRSUBH1)),!
62 S LRTEST=""
63 F I=0:1 S LRTEST=$O(^TMP("LR",$J,"TST",LRTEST)) Q:(LRTEST="")!(LREND) D
64 . I 'I#2,$Y+6>IOSL D UP1^LRCAPR4 Q:LREND
65 . S X=I#2 W:'X ! W ?X*40+1
66 . W $E(LRTEST_" ",1,8)," = ",$J(^TMP("LR",$J,"TST",LRTEST),5)
67 . W " ",$J($FN($S(LRSUM:^(LRTEST)/LRSUM,1:0)*100,"",2),5),"% "
68 Q
69STAT ;
70 Q:'$D(^TMP("LR",$J,"TST/URG"))
71 D:(LRIOPAT["A")!($L(LRIOPAT)>1) STAT1
72 D:'LREND STAT2
73 Q
74STAT1 ; Combined patient type totals
75 S LRPTYP="A"
76 S LRSUBH1="TOTAL TESTS by 'STAT' URGENCY for ALL PATIENTS: % of GRAND TOTAL"_" ( "_LRSUM_" )"
77 I $Y+9>IOSL D PAUSE^LRCAPR4 Q:LREND W @IOF D HDR1^LRCAPR4
78 W !!!?((80-$L(LRSUBH1))/2),LRSUBH1
79 W !?((80-$L(LRSUBH1))/2),$E(LRDSH,1,$L(LRSUBH1))
80 I '$D(^TMP("LR",$J,"TST/URG",LRPTYP)) W !!,?30,"NONE FOUND" Q
81 S LRURG=""
82 F S LRURG=$O(^TMP("LR",$J,"TST/URG",LRPTYP,LRURG)) Q:(LRURG="")!(LREND) S LRURGCNT=^(LRURG) D
83 . I $Y+6>IOSL D UP1^LRCAPR4 Q:LREND
84 . W !!,LRURG," =",$J(LRURGCNT,5)," "
85 . W $J($FN($S(LRSUM:LRURGCNT/LRSUM,1:0)*100,"",2),5)_"%"
86 . S LRTEST=""
87 . F I=0:1 S LRTEST=$O(^TMP("LR",$J,"TST/URG",LRPTYP,LRURG,LRTEST)) Q:(LRTEST="")!(LREND) D
88 . . S X=I#2 W:'X !
89 . . W ?X*40+1,$E(LRTEST_" ",1,8)," = "
90 . . W $J(^TMP("LR",$J,"TST/URG",LRPTYP,LRURG,LRTEST),5)," "
91 . . W $J($FN($S(LRURGCNT:^(LRTEST)/LRURGCNT,1:0)*100,"",2),5)_"%"
92 . . I X,$Y+6>IOSL D UP1^LRCAPR4 Q:LREND
93 Q
94STAT2 ; Individual patient type totals
95 F LRPTYP="I","O","R" Q:LREND D
96 . S LRSUBH1="TOTAL TESTS by 'STAT' URGENCY for "_$S(LRPTYP="I":"INPATIENTS",LRPTYP="O":"OUTPATIENTS",LRPTYP="R":"OTHER PATIENTS",1:"UNKNOWN PATIENTS")_": % of GRAND TOTAL"_" ( "_LRSUM_" )"
97 . I $Y+9>IOSL D PAUSE^LRCAPR4 Q:LREND W @IOF D HDR1^LRCAPR4
98 . W !!!?((80-$L(LRSUBH1))/2),LRSUBH1
99 . W !?((80-$L(LRSUBH1))/2),$E(LRDSH,1,$L(LRSUBH1))
100 . I '$D(^TMP("LR",$J,"TST/URG",LRPTYP)) W !!,?30,"NONE FOUND" Q
101 . S LRURG=""
102 . F S LRURG=$O(^TMP("LR",$J,"TST/URG",LRPTYP,LRURG)) Q:(LRURG="")!(LREND) S LRURGCNT=^(LRURG) D
103 . . I $Y+6>IOSL D UP1^LRCAPR4 Q:LREND
104 . . W !!,LRURG," =",$J(LRURGCNT,5)," "
105 . . W $J($FN($S(LRSUM:LRURGCNT/LRSUM,1:0)*100,"",2),5)_"%"
106 . . S LRTEST=""
107 . . F I=0:1 S LRTEST=$O(^TMP("LR",$J,"TST/URG",LRPTYP,LRURG,LRTEST)) Q:(LRTEST="")!(LREND) D
108 . . . S X=I#2 W:'X !
109 . . . W ?X*40+1,$E(LRTEST_" ",1,8)," = "
110 . . . W $J(^TMP("LR",$J,"TST/URG",LRPTYP,LRURG,LRTEST),5)," "
111 . . . W $J($FN($S(LRURGCNT:^(LRTEST)/LRURGCNT,1:0)*100,"",2),5)_"%"
112 . . . I X,$Y+6>IOSL D UP1^LRCAPR4 Q:LREND
113 Q
Note: See TracBrowser for help on using the repository browser.