source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRSORD1A.m@ 1259

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

initial load of WorldVistAEHR

File size: 4.0 KB
Line 
1LRSORD1A ;DALISC/DRH - LRSORC Continued ;07-22-93
2 ;;5.2;LAB SERVICE;**201,344**;Sep 27, 1994
3INIT ;
4 S U="^"
5 D CONTROL
6 Q
7CONTROL ;
8 D SORT
9 Q
10SORT ;
11 W:$E(IOST,1,2)="C-" @IOF
12 W:$E(IOST,1,2)="P-" !
13 D HDR
14 D PRINT
15 D:'LREND SUMMARY
16 D END
17 Q
18SUMMARY ;
19 I ($Y>(IOSL-7)) D:$E(IOST,1,2)="C-" WAIT Q:LREND W @IOF D HDR
20 F I=$Y:1:(IOSL-6) W !
21 W ?20,"END OF SPECIAL REPORT"
22 Q
23END ;
24 D:($E(IOST,1,2)="C-")&('LREND) WAIT
25 W @IOF D:'$D(ZTQUEUED) ^%ZISC
26 K ^TMP("LR",$J)
27 K ZTRTN,ZTIO,ZTDESC,ZTSAVE,ZTSK,ZTQUEUED,%ZIS,POP,%H,%DT,DTOUT,DUOUT
28 K DIR,DIC,I,T,C,X,Y,L0,SEX,AGE,DFN,DOB,PNM,SSN,VA("BID"),VA("PID"),VAERR
29 K LRAA,LRAD,LRDFN,LRDPF,LREND,LRFAN,LRIDT,LRLAN,LRLCS,LRSUB1,LRSUB2
30 K LRLLOC,LRTX,LRTST,LRTVAL,LRCRTFLG,LRAN,LRSRT,LRPAG,LRDATE,LRDASH,LRDAT
31 K LRLOC,LRPTS,LREDT,LRPDT,LRSDT,LRTREC,LRPREC,LREDAT,LRSDAT,LRSPDAT
32 K LRWRD,LRHDR2,LRSUB3,LRAAA
33 Q
34PRINT ;
35 S LRSUB1=""
36 I $O(^TMP("LR",$J,LRSUB1))="" W !!?30,"NO MATCHING DATA FOUND",!! Q
37 F S LRSUB1=$O(^TMP("LR",$J,LRSUB1)) Q:(LRSUB1="")!(LREND) D
38 .S LRSUB2=""
39 .F S LRSUB2=$O(^TMP("LR",$J,LRSUB1,LRSUB2)) Q:(LRSUB2="")!(LREND) D
40 ..S LRSUB3=""
41 ..F S LRSUB3=$O(^TMP("LR",$J,LRSUB1,LRSUB2,LRSUB3)) Q:(LRSUB3="")!(LREND) D
42 ...S LRAN=""
43 ...F S LRAN=$O(^TMP("LR",$J,LRSUB1,LRSUB2,LRSUB3,LRAN)) Q:(LRAN="")!(LREND) D
44 ....S LRPREC=^TMP("LR",$J,LRSUB1,LRSUB2,LRSUB3,LRAN)
45 ....S LRDPF=$P(LRPREC,U,4)
46 ....S PNM=$P(LRPREC,U),SSN=$P(LRPREC,U,2),LRLOC=$P(LRPREC,U,3)
47 ....S LRSPEC=$P(^LAB(61,$P(LRPREC,U,6),0),U)
48 ....S LRSPNUM=$P(LRPREC,U,6)
49 ....S LRSPDAT=$P(LRPREC,U,5)
50 ....I ($Y>(IOSL-8)) D:$E(IOST,1,2)="C-" WAIT Q:LREND W @IOF D HDR
51 ....;S PNM1=$P(PNM,","),PNM2=$P(PNM,",",2)
52 ....;S LRCHNG=PNM1 D CHNCASE^LRSORA2 S PNM1=LRCHNG
53 ....;S LRCHNG=PNM2 D CHNCASE^LRSORA2 S PNM2=LRCHNG
54 ....;S PNM=PNM1_","_PNM2
55 ....;S LRCHNG=LRSPEC D CHNCASE^LRSORA2 S LRSPEC=LRCHNG
56 ....W !,$E(PNM,1,23),?25,SSN W:LRDPF=2 " ",LRLOC,?50,$E(LRAN,1,14)
57 ....W ?63,LRSPDAT
58 ....W !," ",LRSPEC
59 ....D PRNTST
60 Q
61PRNTST ;
62 N LRRLO,LRRHI,LRCLO,LRCHI,LRTLO,LRTHI,LRFLAG,VAR
63 S I=""
64 F S I=$O(^TMP("LR",$J,LRSUB1,LRSUB2,LRSUB3,LRAN,"TST",I)) Q:(I="")!(LREND) D
65 .S LRTREC=^TMP("LR",$J,LRSUB1,LRSUB2,LRSUB3,LRAN,"TST",I)
66 .S LRTST=$P(LRTREC,U),LRTVAL=$P(LRTREC,U,2),LRCRTFLG=$P(LRTREC,U,3)
67 .I ($Y>(IOSL-7)) D
68 ..D CONT D:$E(IOST,1,2)="C-" WAIT Q:LREND
69 ..W @IOF D HDR
70 ..W !,$E(PNM,1,23),?25,SSN W:LRDPF=2 " ",LRLOC,?50,$E(LRAN,1,14)
71 ..W ?63,LRSPDAT
72 .Q:LREND
73 .S LRTX=$P(LRTREC,U,5)
74 .S LRFLAG=$P(LRTREC,U,6)
75 .S LRREF=$G(^LAB(60,LRTX,1,LRSPNUM,0))
76 .S LRRLO=$S(LRFLAG:$P(LRTREC,U,7),1:$P(LRREF,U,2))
77 .S LRRHI=$S(LRFLAG:$P(LRTREC,U,8),1:$P(LRREF,U,3))
78 .S LRCLO=$S(LRFLAG:$P(LRTREC,U,9),1:$P(LRREF,U,4))
79 .S LRCHI=$S(LRFLAG:$P(LRTREC,U,10),1:$P(LRREF,U,5))
80 .S LRTLO=$S(LRFLAG:$P(LRTREC,U,11),1:$P(LRREF,U,11))
81 .S LRTHI=$S(LRFLAG:$P(LRTREC,U,12),1:$P(LRREF,U,12))
82 .F VAR="LRRLO","LRRHI","LRCLO","LRCHI" I @VAR="" S @VAR="none"
83 .;
84 .S LRTST=$P($G(^LAB(60,LRTX,.1)),U)
85 .I 'LRTST S LRTST=$E($P(^LAB(60,LRTX,0),U),1,10)
86 .;I 'LRTST S LRTST=$E($P(^LAB(60,LRTX,0),U),1,10)
87 .;S LRCHNG=LRTST D CHNCASE^LRSORA2 S LRTST=LRCHNG
88 .W !,?2,$E(LRTST,1,7),?12,$J(LRTVAL,6)
89 .W ?19,$E($P(LRREF,U,7),1,10),?28,LRCRTFLG
90 . I 'LRTLO,('LRTHI) D RANGE
91 . I LRTLO W ?32,"Ther: ",LRTLO,"-"
92 . I LRTHI W LRTHI D CRITICL
93 I '$O(^TMP("LR",$J,LRSUB1,LRSUB2,LRSUB3,LRAN,"COM",0)) W !
94 E D COM
95 Q
96COM ;Print comments on specimen
97 W !,"COMMENT(S): "
98 S C=""
99 F S C=$O(^TMP("LR",$J,LRSUB1,LRSUB2,LRSUB3,LRAN,"COM",C)) Q:(C="")!(LREND) D
100 .I ($Y>(IOSL-7)) D
101 ..D CONT D:$E(IOST,1,2)="C-" WAIT Q:LREND
102 ..W @IOF D HDR
103 ..W !,$E(PNM,1,23),?25,SSN W:LRDPF=2 " ",LRLOC,?50,$E(LRAN,1,14)
104 ..W ?63,LRSPDAT
105 ..;W !,PNM,?35,SSN W:LRDPF=2 " ",LRLOC,?60,LRAN
106 ..;D HDR
107 ..W !,"COMMENT(S): "
108 .Q:LREND
109 .W ?12,^TMP("LR",$J,LRSUB1,LRSUB2,LRSUB3,LRAN,"COM",C),!
110 Q
111HDR ;
112 S LRPAG=LRPAG+1
113 W "SPECIAL REPORT: Search for Abnormal and Critical Results "
114 W LRDATE,?65,"Pg ",LRPAG,!,LRHDR2,!
115 D LRGLIN^LRX
116 Q
117RANGE ;
118 W ?31,"Ref. Range: ",LRRLO,"-",LRRHI
119 D CRITICL
120 Q
121CRITICL ;
122 W ?57,"Critical: ",LRCLO,"-",LRCHI
123 Q
124WAIT ;
125 K DIR S DIR(0)="E" D ^DIR
126 S:($D(DTOUT))!($D(DUOUT)) LREND=1
127 Q
128CONT W !?10,"CONTINUED NEXT PAGE",! Q
Note: See TracBrowser for help on using the repository browser.