source: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRCAPR4.m

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

initial load of FOIAVistA 6/30/08 version
File size: 4.6 KB
Line 
1LRCAPR4 ;DALOI/PAC/FHS/JBM - WKLD REP GENERATOR-UTILITIES ;10/16/92 16:49
2 ;;5.2;LAB SERVICE;**263**;Sep 27, 1994
3BLDHDR ;
4 S LRHDRLEN=0
5 ; ** Divisions **
6 S LRCODSTR="S LRDUMMY=""[ ""_LRSITSEL(A)_"" ] """
7 S LRTITLE=" Division(s) "
8 D ADDHDR(.LRSITSEL,LRTITLE,LRCODSTR)
9 ; ** Locations **
10 D
11 . I 'LRLOC N LRLOC S LRLOC(1)=" All "
12 . I $G(LRLOC)="1A" N LRLOC S LRLOC(1)=" Non Selected "
13 . S LRCODSTR="S LRDUMMY=""[ ""_LRLOC(A)_"" ] """
14 . S LRTITLE=" Location(s) "
15 . D ADDHDR(.LRLOC,LRTITLE,LRCODSTR)
16 ; ** LEDI Collecting Sites
17 D
18 . I 'LRLDIV N LRLDIV S LRLDIV(1)=" All "
19 . I $G(LRLDIV)="1A" N LRLDIV S LRLDIV(1)=" Non Selected "
20 . S LRCODSTR="S LRDUMMY=""[ ""_LRLDIV(A)_"" ] """
21 . S LRTITLE=" LEDI Location(s) "
22 . D ADDHDR(.LRLDIV,LRTITLE,LRCODSTR)
23 ; ** Specimens **
24 S LRCODSTR="S LRDUMMY=""[ ""_$P($G(^LAB(61,A,0)),U)_"" ] """
25 S LRTITLE=" Specimen(s) "
26 D ADDHDR(.LRSP,LRTITLE,LRCODSTR)
27 ; ** Collection Samples **
28 S LRCODSTR="S LRDUMMY=""[ ""_$P($G(^LAB(62,A,0)),U)_"" ] """
29 S LRTITLE=" Collection sample(s) "
30 D ADDHDR(.LRCOL,LRTITLE,LRCODSTR)
31 ; ** Tests **
32 S LRCODSTR="S LRDUMMY=""[ ""_$$TST^LRCAPR2(LRTSTS(A))_"" ] """
33 S LRTITLE=" Test(s) "
34 D ADDHDR(.LRTSTS,LRTITLE,LRCODSTR)
35 ; ** Wkld Codes **
36 S LRCODSTR="S LRDUMMY=""[ ""_LRCAPS(A)_"" ] """
37 S LRTITLE=" Workload code(s) "
38 D ADDHDR(.LRCAPS,LRTITLE,LRCODSTR)
39 ; ** Instruments **
40 S LRCODSTR="S LRDUMMY=""[ ""_$P($G(^LAB(64.2,LRCPSX(A),0)),U)_"" ] """
41 S LRTITLE=" Instrument(s) "
42 D ADDHDR(.LRCPSX,LRTITLE,LRCODSTR)
43 ; ** Patient type **
44 S LRHDRLEN=LRHDRLEN+1
45 S LRHDR(LRHDRLEN)=" Patients "
46 I LRIOPAT["A" S LRHDR(LRHDRLEN)=LRHDR(LRHDRLEN)_"[ ALL PATIENTS ] "
47 E D
48 . F I=1:1:$L(LRIOPAT) D
49 . . S LRPTYP=$E(LRIOPAT,I)
50 . . S LRHDR(LRHDRLEN)=LRHDR(LRHDRLEN)_$S(LRPTYP="I":"[ INPATIENTS ] ",LRPTYP="O":"[ OUTPATIENTS ] ",LRPTYP="R":"[ OTHER PATIENTS ] ",1:"[ UNKNOWN PATIENTS ] ")
51 ; ** STAT only? **
52 I $G(LRSTAT) D
53 . S LRHDRLEN=LRHDRLEN+1
54 . S LRHDR(LRHDRLEN)=" STAT tests only"
55 ;
56 S LRHDRFIT=$S(LRHDRLEN<12:1,1:0)
57 Q
58ADDHDR(LRARY,LRTITLE,LRCODSTR) ;
59 N A,LRDUMMY,I
60 I $O(LRARY(0)) D
61 . S LRHDRLEN=LRHDRLEN+1,LRHDR(LRHDRLEN)=LRTITLE
62 . S A=""
63 . F I=0:0 S A=$O(LRARY(A)) Q:A="" D
64 . . X LRCODSTR
65 . . I ($L(LRHDR(LRHDRLEN))+$L(LRDUMMY))>80 D
66 . . . S LRHDRLEN=LRHDRLEN+1
67 . . . S $P(LRHDR(LRHDRLEN)," ",$L(LRTITLE))=" "
68 . . S LRHDR(LRHDRLEN)=LRHDR(LRHDRLEN)_LRDUMMY
69 Q
70REPHDR ;
71 W !!!!!!,$E(LRSTR,1,30)_$S(LRANS="D":" D E T A I L E D *",1:" C-O-N-D-E-N-S-E-D ")_$E(LRSTR,1,31)
72 W !,LRSITE_"("_LRSITNUM_")",?33,"Workload Report"
73 W ?53,LRDT,?80-(6+$L(LRPG)),"page ",LRPG
74 W !,"ACCN AREA: ",LRX,?79-$L(LRDTH),LRDTH S LRPG=LRPG+1
75 D HDR2
76 W !,LRDSH
77 D PAUSE Q:LREND
78 W @IOF
79 Q
80HDR ;
81 W !!!,$E(LRSTR,1,31)_" D E T A I L E D "_$E(LRSTR,1,32)
82 W !,LRSITE_"("_LRSITNUM_")",?33,"Workload Report"
83 W ?53,LRDT,?80-(6+$L(LRPG)),"Page ",LRPG
84 W !,"ACCN AREA: ",LRX,?79-$L(LRDTH),LRDTH S LRPG=LRPG+1
85 I LRHDRFIT D HDR2
86 W !,LRDSH
87 W !,"Lab Test "_$S(LRCONT:" **cont.**",1:"")
88 W ?33,"Instrument",?59,"Location [File #]",!
89 Q
90SUBH ;
91 W !,LRTST,?33,LRCODE,?59,LRLC," = ",LRCPT
92 W !,?3,"Accession # ",?36,"Date verified",?59,"WKLD CODE: ",LRCAP
93 Q
94UP ;
95 S LRCONT=$S(J'=LRCPT:1,1:0)
96 W ?64,$S(LRCONT:"***continued***",1:"")
97 D PAUSE Q:LREND
98 Q
99UP1 ;
100 D PAUSE Q:LREND
101 W @IOF D HDR1 W !,"cont."
102 W !?((80-$L(LRSUBH1))\2),LRSUBH1
103 W !?((80-$L(LRSUBH1))\2),$E(LRDSH,1,$L(LRSUBH1))
104 Q
105HDR1 ;
106 W !!!,$E(LRSTR,1,30)_$S(LRANS="D":" D E T A I L E D *",1:" C-O-N-D-E-N-S-E-D ")_$E(LRSTR,1,31)
107 W !,LRSITE_"("_LRSITNUM_")",?33,"Workload Report"
108 W ?53,LRDT,?80-(6+$L(LRPG)),"page ",LRPG
109 W !,"ACCN AREA: ",LRX,?79-$L(LRDTH),LRDTH S LRPG=LRPG+1
110 I LRHDRFIT D HDR2
111 W !,LRDSH
112 Q
113HDR2 ;
114 Q:'LRHDRLEN N A
115 F A=1:1:LRHDRLEN W !,LRHDR(A)
116 Q
117PAUSE ;
118 Q:$E(IOST,1,2)'="C-"
119 K DIR S DIR(0)="E" D ^DIR
120 S:($D(DTOUT)#2)!($D(DUOUT)#2) LREND=1
121 Q
122CLEAN ;
123 D:'LREND PAUSE
124 W @IOF D:'$D(ZTQUEUED) ^%ZISC
125 K ^TMP("LR",$J)
126 K %,%DT,%ZIS,DIC,DIR,DTOUT,DUOUT,DIRUT,DIROUT,I,J,K,X,Y,POP,DX,DY
127 K ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,LRCODSTR,LRPTYP,LRPATOK,LRCONT,LRACCREC
128 K LRAA,LRAANO,LRANS,LRCAP,LRCAPS,LRCNT,LRCODE,LRCOL,LREND,LRMACN,LRTITLE
129 K LRCPSX,LRCPT,LRDA,LRDAT,LRDATD,LRDATX,LRDOT,LRDSH,LRDT,LRDTH,LRFL,LRTO
130 K LRFLG,LRFR,LRFRD,LRFRV,LRINST,LRLC,LRLMAC,LRLOC,LRMAC,LRTOD,LRCP,LRFIL
131 K LRNT,LRNX,LRNX5,LRNX5D,LRPG,LRSITE,LRSITNUM,LRSITSEL,LRSP,LRST,LRSTCS
132 K LRSTR,LRSTY,LRSUM,LRTEST,LRTESTCP,LRTMTOT,LRNODE,LRMCT,LRSTAT,LRCNTL
133 K LRTSTS,LRTYCSP,LRVD,LRVERD,LRX,LRSUBH,LRSUBH1,LRHDR,LRHDRFIT,LRHDRLEN
134 K LRIOPAT,LRLTYP,LRTST,LRURG,LRURGCNT,LRURGNAM,LRTOV,LRCTL,LRCPN,LRRTYP
135 D WKLDCLN^LRCAPU
136 Q
Note: See TracBrowser for help on using the repository browser.