source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRGP.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.8 KB
Line 
1LRGP ;DALOI/CJS/RWF - INSTRUMENT GROUP DELTA CHECK DISPLAY ;2/5/91 13:19
2 ;;5.2;LAB SERVICE;**153,269**;Sep 27, 1994
3 ;
4 N LASQ,LRPAGE,LRVBY
5 ;
6 S LASQ=0,LRGVP="",LRDCNT=0
7 K ^TMP("LR",$J)
8 D ^LRPARAM
9 I $G(LREND) D CLOSE Q
10 D ^LRGP1
11 I $G(LREND) D CLOSE Q
12 ;
13 S LRDCNT=0,%ZIS="Q"
14 D ^%ZIS
15 I POP D CLOSE Q
16 I $D(IO("Q")) D Q
17 . N ZTDTH,ZTRTN,ZTSAVE,ZTDESC
18 . K IO("Q")
19 . S ZTRTN="DQ^LRGP",ZTSAVE("LR*")="",ZTSAVE("^TMP(""LR"",$J,")="",ZTDESC="Group unverified review (EA, EL, EW)"
20 . D ^%ZTLOAD
21 . U IO(0) W !,"Task ",$S($G(ZTSK):ZTSK,1:"NOT")," Queued"
22 . D CLOSE
23 ;
24 ;
25DQ ;
26 U IO
27 S LRNOW=$$NOW^XLFDT,LRDT=$$FMTE^XLFDT(LRNOW,"5MZ"),LRPAGE=0
28 D ACC:LRWT="A",LRTRAY:LRWT="T",MACHSQ:LRWT="M",WRKLST:LRWT="W"
29 W:'LRDCNT !!,"No data to report",!!
30 W:$E(IOST,1,2)="P-" @IOF
31 ;
32CLOSE ;
33 I $D(ZTQUEUED) S ZTREQ="@"
34 E D ^%ZISC
35 D ^LRGVK
36 Q
37 ;
38 ;
39ACC ;
40 S LRHED="By Accession list: "_LRNAME D LRHED
41 S LRAN=LRFAN
42 F S LRAN=$O(^LRO(68,LRAA,1,LRAD,1,LRAN)) Q:LRAN<1!(LRAN>LRLIX) D Q:$G(ZTSTOP)
43 . S LASQ=0
44 . D WRK2 Q:$G(ZTSTOP)
45 . D LRHED:$E(IOST,1,2)'="C-"&($Y+3>IOSL)
46 . I 'LASQ D
47 . . W !,"No Unverified instrument Data for Acc#: ",LRAN
48 . . D DASH^LRX
49 Q
50 ;
51 ;
52LRHED ;
53 S LRPAGE=LRPAGE+1
54 W @IOF
55 W !,"Group unverified review listing",?50,"Page: ",LRPAGE
56 W !,LRHED,?50,"Date: ",LRDT,!!
57 Q
58 ;
59 ;
60LRTRAY ;
61 S LRHED="By Tray. Load list: "_$P(^LRO(68.2,LRLL,0),U,1)
62 D LRHED
63 ;
64 F LRTRAY=LRFTRAY:1:LRLTRAY W !!,"Start LRTRAY: ",LRTRAY D Q:$G(ZTSTOP)
65 . F LRCUP=LRFCUP:1:$S(LRTRAY=LRLTRAY:LRLCUP,1:LRMAXCUP) D Q:$G(ZTSTOP)
66 . . S LRITC=LRTRAY_";"_LRCUP,LRSQ=0
67 . . F S LRSQ=$O(^LAH(LRLL,1,"B",LRITC,LRSQ)) Q:LRSQ<1 D PRINT Q:$G(ZTSTOP)
68 Q
69 ;
70 ;
71MACHSQ ;
72 S LRHED="By Machine Sequence number. Load/Work list: "_$P(^LRO(68.2,LRLL,0),U,1)
73 D LRHED
74 ;
75 S LRSQ=LRSQ-1
76 F S LRSQ=$O(^LAH(LRLL,1,LRSQ)) Q:LRSQ<1!(LRSQ>LRESEQ) D PRINT Q:$G(ZTSTOP)
77 ;
78 Q
79 ;
80 ;
81WRKLST ;
82 S LRHED="By Work list: "_$P(^LRO(68.2,LRLL,0),U,1)
83 D LRHED
84 S LRC=LRCUP-1
85 F S LRC=$O(^LRO(68.2,LRLL,1,1,1,LRC)) Q:LRC<1!(LRC>LRECUP) D Q:$G(ZTSTOP)
86 . N LRX
87 . S LRX=$G(^LRO(68.2,LRLL,1,1,1,LRC,0))
88 . I LRX="" Q
89 . S LRAA=$P(LRX,"^"),LRAD=$P(LRX,"^",2),LRAN=$P(LRX,"^",3)
90 . D WRK2
91 Q
92 ;
93 ;
94WRK2 ; Display results for each accession number.
95 ;
96 S LRSQ=0
97 F S LRSQ=$O(^LAH(LRLL,1,"C",LRAN,LRSQ)) Q:LRSQ<1 D PRINT Q:$G(ZTSTOP)
98 Q
99 ;
100 ;
101PRINT ;
102 ; Check that results belong to same accession area and date since
103 ; results can belong to different accession areas and dates but have
104 ; the same acession number.
105 ;
106 ; Check if task has been asked to stop.
107 I $D(ZTQUEUED),$$S^%ZTLOAD D Q
108 . S ZTSTOP=1
109 . W !!,"*** Report requested to stop by TaskMan ***"
110 . W !,"*** Task #",$G(ZTQUEUED,"UNKNOWN")," stopped at ",$$HTE^XLFDT($H)," ***"
111 ;
112 Q:'$D(^LAH(LRLL,1,LRSQ,0))
113 ;
114 S LRSQ(0)=^LAH(LRLL,1,LRSQ,0)
115 ;
116 ; Different accession area
117 I $P(LRSQ(0),"^",3),LRAA'=$P(LRSQ(0),"^",3) Q
118 ; Different accession date
119 I $P(LRSQ(0),"^",4),LRAD'=$P(LRSQ(0),"^",4) Q
120 ;
121 D LRHED:$E(IOST,1,2)'="C-"&($Y+LRVTS>IOSL)
122 W !!,?4,"Seq #: ",LRSQ
123 S LRTRAY=$P(LRSQ(0),"^",1),LRCUP=$P(LRSQ(0),"^",2)
124 I $L(LRTRAY) W ?43,"Tray: ",LRTRAY
125 I $L(LRCUP) W ?51," Cup: ",LRCUP
126 ;
127 ;
128 Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0))
129 ;
130 S LRDFN=+^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRORD=$S($D(^(.1)):^(.1),1:0),LRODT=$S($P(^(0),U,4):$P(^(0),U,4),1:$P(^(0),U,3)),LRSN=$P(^(0),U,5)
131 Q:LRSN<1
132 ;
133 S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3)
134 D PT^LRX
135 D DISPLAY
136 D VER^LRVR1
137 D DASH^LRX
138 S LRDCNT=LRDCNT+1,LASQ=1
139 Q
140 ;
141 ;
142DISPLAY ; Display accession info/results
143 W !,?5,"Name: ",PNM,?44,"SSN: ",SSN
144 W:LRORD !," Order #: ",LRORD
145 ;
146 W !,"Accession: ",$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,.2)),"^")
147 I $P(LRSQ(0),"^",10) W ?30," Results received: ",$$FMTE^XLFDT($P(LRSQ(0),"^",10),"1M")
148 W !,?6,"UID: ",$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3),"UNKNOWN"),"^")
149 I $P(LRSQ(0),"^",11) W ?34," Last updated: ",$$FMTE^XLFDT($P(LRSQ(0),"^",11),"1M")
150 ;
151 Q
Note: See TracBrowser for help on using the repository browser.