source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRSORC1A.m@ 1005

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

initial load of WorldVistAEHR

File size: 4.1 KB
Line 
1LRSORC1A ;DALISC/DRH - LRSORC Continued ;07-22-93
2 ;;5.2;LAB SERVICE;**201,344,351**;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 ?62,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 ?62,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 .; set ranges LRFLAG on - from file 63 LRFLAG off - from file 60
77 .S LRRLO=$S(LRFLAG:$P(LRTREC,U,7),1:$P(LRREF,U,2))
78 .S LRRHI=$S(LRFLAG:$P(LRTREC,U,8),1:$P(LRREF,U,3))
79 .S LRCLO=$S(LRFLAG:$P(LRTREC,U,9),1:$P(LRREF,U,4))
80 .S LRCHI=$S(LRFLAG:$P(LRTREC,U,10),1:$P(LRREF,U,5))
81 .S LRTLO=$S(LRFLAG:$P(LRTREC,U,11),1:$P(LRREF,U,11))
82 .S LRTHI=$S(LRFLAG:$P(LRTREC,U,12),1:$P(LRREF,U,12))
83 .F VAR="LRRLO","LRRHI","LRCLO","LRCHI" I @VAR="" S @VAR="none"
84 .;
85 .S LRTST=$P($G(^LAB(60,LRTX,.1)),U)
86 .I LRTST="" S LRTST=$E($P(^LAB(60,LRTX,0),U),1,10)
87 .;I 'LRTST S LRTST=$E($P(^LAB(60,LRTX,0),U),1,10)
88 .;S LRCHNG=LRTST D CHNCASE^LRSORA2 S LRTST=LRCHNG
89 .W !,?2,$E(LRTST,1,9),?12,$J(LRTVAL,6)
90 .W ?19,$E($P(LRREF,U,7),1,10),?28,LRCRTFLG
91 . I 'LRTLO,('LRTHI) D RANGE
92 . I LRTLO W ?32,"Ther: ",LRTLO,"-"
93 . I LRTHI W LRTHI D CRITICL
94 I '$O(^TMP("LR",$J,LRSUB1,LRSUB2,LRSUB3,LRAN,"COM",0)) W !
95 E D COM
96 Q
97COM ;Print comments on specimen
98 W !,"COMMENT(S): "
99 S C=""
100 F S C=$O(^TMP("LR",$J,LRSUB1,LRSUB2,LRSUB3,LRAN,"COM",C)) Q:(C="")!(LREND) D
101 .I ($Y>(IOSL-7)) D
102 ..D CONT D:$E(IOST,1,2)="C-" WAIT Q:LREND
103 ..W @IOF D HDR
104 ..W !,$E(PNM,1,23),?25,SSN W:LRDPF=2 " ",LRLOC,?50,$E(LRAN,1,14)
105 ..W ?62,LRSPDAT
106 ..;W !,PNM,?35,SSN W:LRDPF=2 " ",LRLOC,?60,LRAN
107 ..;D HDR
108 ..W !,"COMMENT(S): "
109 .Q:LREND
110 .W ?12,^TMP("LR",$J,LRSUB1,LRSUB2,LRSUB3,LRAN,"COM",C),!
111 Q
112HDR ;
113 S LRPAG=LRPAG+1
114 W "SPECIAL REPORT: SEARCHING FOR CRITICAL FLAGS "
115 W LRDATE,?65,"Pg ",LRPAG,!,LRHDR2,!
116 D LRGLIN^LRX
117 Q
118RANGE ;
119 W ?31,"Ref. Range: ",LRRLO,"-",LRRHI
120 D CRITICL
121 Q
122CRITICL ;
123 W ?57,"Critical: ",LRCLO,"-",LRCHI
124 Q
125WAIT ;
126 K DIR S DIR(0)="E" D ^DIR
127 S:($D(DTOUT))!($D(DUOUT)) LREND=1
128 Q
129CONT W !?10,"CONTINUED NEXT PAGE",! Q
Note: See TracBrowser for help on using the repository browser.