source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRARCR4.m@ 823

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

initial load of WorldVistAEHR

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