source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRSORA2.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: 3.6 KB
Line 
1LRSORA2 ;DALOI/KCM/DRH/RLM-SEARCH LAB DATA AND PRINT REPORT ;8/28/89 12:07
2 ;;5.2;LAB SERVICE;**2,62,201,272,369**;Sep 27, 1994;Build 2
3 ; Reference to $$FMTE^XLFDT supported by IA #10103
4 ; Reference to DD^%DT supported by IA #10003
5 ; Reference to ^DIR supported by IA #10026
6 ; Reference to $$FMTE^XLFDT supported by IA #10103
7 ; Reference to $$NOW^XLFDT supported by IA #10103
8START ;
9 D BUILD^LRSORA3
10 S (LRTSTCK,LRSPCK,LRPATCK)="",NEWPG=1
11 W:$E(IOST,1,2)="C-" @IOF
12 D MAINLOOP I LREND=1 D END QUIT
13 D:'LREND SUMMARY
14 D END
15 Q
16MAINLOOP ;
17 S (LROLD,LRTOP,LRSPCK,REFCK,LRTSTCK)=""
18 S LRSORTI="^TMP(""LR"","_$J_")"
19 F S LRSORTI=$Q(@LRSORTI) Q:LRSORTI'[$J!(LREND=1) D
20 . D SET Q:LREND=1
21 . D PRTCONT Q:LREND=1
22 Q
23END ;
24 K DIR
25 K LROLD,LRTOP,LRSPCK,REFCK,LRTSTK,LRCOMX,LRSORTI
26 K LRPREC,PNM,LRCHNG,LRLO,LRHI,LRAN,LRMRK,LRWRD,LRVAL
27 K LRTEST,LRPREC,LRCDT,LRUNITS,LRCOUNT,NEWPG
28 Q
29SET ;
30 S LRCOMX=0
31 I LRSORTI["""COM""" W " COMMENT: ",@LRSORTI,! S LRCOMX=1 QUIT
32 S LRPREC=@LRSORTI
33 S PNM=$P(LRPREC,U),SSN=$P(LRPREC,U,2),LRLOC=$P(LRPREC,U,3)
34 S LRSPEC=$P(LRPREC,U,5)
35 S LRCHNG=LRSPEC D CHNCASE S LRSPEC=LRCHNG
36 S LRLO=$P(LRPREC,U,7),LRHI=$P(LRPREC,U,8),LRVAL=$P(LRPREC,U,9)
37 S LRMRK=$P(LRPREC,U,10),LRTHER=$P(LRPREC,U,11)
38 S LRAN=$P(LRPREC,U,13),LRCDT=$P(LRPREC,U,14)
39 S LRWRD=$P($G(LRPREC),U,12)
40 S LRWRD=$S(""[LRWRD:"**No Entry**",1:LRWRD)
41 S LRTEST=$P(LRPREC,U,15)
42 S:SSN'=LROLD LROLD=SSN,LRTOP=1
43 S LRUNITS=$P(LRPREC,U,16)
44 S Y=LRCDT D DD^%DT S LRCDT=$E(Y,1,18)
45 Q
46PRTCONT ;
47 Q:$G(LREND)
48 S LRCOUNT=0
49 D CHKPG Q:LREND=1
50 I NEWPG=1 D COND1 Q
51 I LRPATCK'=SSN D COND2 Q
52 I LRSPCK'=LRSPEC D COND3 Q
53 I LRTSTCK'=LRTEST D COND3 Q
54 I LRTSTCK=LRTEST D COND4 Q
55 Q
56COND1 ;
57 D PAGE S NEWPG=""
58 D NEWPAT
59 D NEWSPEC
60 D NEWTST S LRCOUNT=1
61 Q
62COND2 ;
63 D NEWPAT
64 D NEWSPEC
65 D NEWTST S LRCOUNT=1
66 Q
67COND3 ;
68 D NEWSPEC
69 D NEWTST S LRCOUNT=1
70 Q
71COND4 ;
72 D NEWTST S LRCOUNT=1
73 Q
74PAGE ;
75 W:$E(IOST,1,2)="C-" @IOF
76 D HDR1 S LRTOP=1
77 Q
78NEWPAT ;
79 D HDR2 S LRPATCK=SSN
80 Q
81NEWSPEC ;
82 D PRSPEC S LRSPCK=LRSPEC
83 Q
84NEWTST ;
85 D PRTEST S LRTSTCK=LRTEST
86 Q
87SAMETST ;
88 D PRTEST
89 Q
90CHKPG ;
91 S:LRCNT<1 LRCNT=1
92 Q:$G(LREND)
93 I $Y>(IOSL-7-LRCNT) S NEWPG=1 D
94 . D LEGEND W:$E(IOST,1,2)'="C-" @IOF
95 . D:$E(IOST,1,2)="C-" WAIT Q:LREND S LRTOP=1
96 Q
97PRSPEC ;
98 W ?2,$E(LRSPEC,1,10)
99 W ?14,$S(LRTHER:"Th. Range ",1:"Ref. Range: "),LRLO
100 W "-",LRHI," ",LRUNITS,!
101 Q
102PRTEST ;
103 Q:$G(LRCOMX)
104 Q:$G(LREND)
105 S LRCOMX=0
106 W ?4,$E(LRTEST,1,12),?14,LRAN,?30,$J(LRVAL,4)
107 W ?33,LRMRK,?40,$E(LRCDT,1,6)_" "_$E($P(LRCDT,",",2),2,5)
108 W " at ",$P(LRCDT,"@",2)
109 W ?64,LRLOC,!
110 Q:$G(LREND)!(LRTOP)
111 Q
112COM ;Print comments on specimen
113 Q:$G(LREND) W !," COMMENT(S): "
114 S C=""
115 F S C=$O(^TMP("LR",$J,LRSUB1,LRSUB2,LRSUB3,LRAN,"COM",C)) Q:(C="")!(LREND) D
116 .I $Y+7>IOSL D
117 ..D:$E(IOST,1,2)="C-" WAIT Q:LREND=1 D CHKPG
118 ..W !,"COMMENT(S): "
119 .Q:LREND
120 Q
121SUMMARY ;
122 I ($Y>(IOSL-7-LRCNT)) D:$E(IOST,1,2)="C-" WAIT Q:LREND=1 D CHKPG
123 D LEGEND
124 F I=$Y:1:(IOSL-6) W !
125 W !,?20,"END OF SPECIAL REPORT" QUIT
126 Q
127HDR1 ;
128 S LRTST(0)=$E(LRTST(0),1,30)
129 S %=32-$L(LRTST(0))\2+15
130 S LRPAG=LRPAG+1
131 W "SPECIAL REPORT",?31
132 W "Report Date: "
133 W $$FMTE^XLFDT($$NOW^XLFDT,"")
134 W !,LRHDR2,?71,"Pg ",$J(LRPAG,3)
135 W ! D LRGLIN^LRX
136 S LRTOP=""
137 S LRCHKSP=0
138 Q
139HDR2 ;
140 W !,PNM,?28,SSN,?61,$E(LRWRD,1,16),!
141 Q
142WAIT W ! K DIR S DIR(0)="E" D ^DIR S:($D(DUOUT))!($D(DTOUT)) LREND=1
143 Q
144CHNCASE ;
145 S LRCHNG=$E(LRCHNG)_$$LOWCASE^LRAFUNC($E(LRCHNG,2,$L(LRCHNG)))
146 Q
147LEGEND ;
148 D LRGLIN^LRX
149 W !,"Search Criteria:"
150 F %=1:1:LRTST D
151 . W !,%,") " S LRCHNG=$E($P(LRTST(%,2),U,1),1,10) D CHNCASE
152 . W LRCHNG," "
153 . W $P(LRTST(%,2),U,3)," Specimen: "
154 . W $S($P(LRTST(%,2),U,2)'="":$E($P(LRTST(%,2),U,2),1,79-$X),1:"Any")
155 Q
Note: See TracBrowser for help on using the repository browser.