source: FOIAVistA/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LAMIVTL1.m@ 711

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

initial load of FOIAVistA 6/30/08 version

File size: 3.2 KB
Line 
1LAMIVTL1 ;DAL/HOAK 2nd Vitek literal verify rtn
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**12,29**;Sep 27,1994
3INIT ;
4 S OK=1
5 S LREND=0
6 D CONTROL
7 Q
8CONTROL ;
9 W @IOF
10 D SETUP Q:'OK
11 D EXP Q:'OK
12 D ^LAMIVTL2
13 Q
14SETUP ;
15 ; Set up variables for PROCESSING
16 S LRAN=LRANX
17 ;I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN)) S OK=0 QUIT ;-----Back to Control
18 S LRNODE=^LRO(68,LRAA,1,LRAD,1,LRAN,0) S LRACCN=^(.2)
19 S LRDFN=+LRNODE
20 S LRDPF=$P(LRNODE,U,2)
21 S LRLLOC=$P(LRNODE,U,7)
22 S LRPHY=$P(LRNODE,U,8)
23 S LRODT=$P(LRNODE,U,4)
24 S LRSN=$P(LRNODE,U,5)
25 ;---------------------------------------------------------------------
26 ; Reset LRNODE----------------------------------------------\/
27 S LRIDT=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,3),U,5) S LRNODE=^(3)
28 S LRCDT=$P(LRNODE,U)
29 S LRDTR=$P(LRNODE,U,3)
30 S LREAL=$P(LRNODE,U,2)
31 S LRSUB=$P(^LRO(68,LRAA,0),U,2)
32 ;----------------------------------------------------------------------
33EN ; From LAMIAUT0 BY FHS
34 S LRI=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,5,0)) I $D(^(LRI,0)) D
35 . S LRSPEC=+^LRO(68,LRAA,1,LRAD,1,LRAN,5,LRI,0),LRSAMP=+$P(^(0),U,2)
36 S DFN=$P(^LR(LRDFN,0),U,3)
37 S LRPHYN=$S($D(^VA(200,+LRPHY,0)):$P(^(0),U),1:"Unknown")
38 ;----------------------------------------------------------------------
39PAT ;
40 D PT^LRX
41 W !,"ACC # (",LRAN,") "
42 W $$DTF^LRAFUNC1(LRCDT),!!?10,PNM," SSN: ",SSN," LOC: ",LRLLOC
43 W !?5,"Specimen: "
44 W $S($D(^LAB(61,+LRSPEC,0)):$P(^(0),U),1:"Unknown")
45 W " Sample: ",$S($D(^LAB(62,+LRSAMP,0)):$P(^(0),U),1:"Unknown"),!
46 I $D(^LRO(69,LRODT,1,LRSN,6,+$O(^LRO(69,LRODT,1,LRSN,6,0)),0)) D
47 . W !," Comment on Specimem "
48 S I=0
49 F A=0:0 S I=$O(^LRO(69,LRODT,1,LRSN,6,I)) Q:I="" W ?30,^(I,0),!
50 I $D(^LR(LRDFN,"MI",LRIDT,2,+$O(^LR(LRDFN,"MI",LRIDT,2,0)),0)) D
51 . W !,"GRAM STAIN "
52 . S I=0
53 . F A=0:0 S I=$O(^LR(LRDFN,"MI",LRIDT,2,I)) Q:I="" W ?15,^(I,0),!
54 I $D(^LR(LRDFN,"MI",LRIDT,99)) W !,"Comment on Specimen : ",^(99)
55 S %=1
56 W !!?10,"Is this the correct patient/specimen? "
57 D YN^DICN
58 I %'=1 S OK=0 QUIT
59 QUIT
60EXP ; From LAMIAUT4 BY FHS
61 ;---------------------------------------------------------------------
62 ;Get the list of tests for this ACC.
63 W !!,PNM," ",SSN,!,LRACCN
64 D INF^LRX
65 W !!?5,$P(^LAB(61,LRSPEC,0),U)," ",$P(^LAB(62,LRSAMP,0),U),!
66 K ^TMP("LR",$J),LRTEST,LRNAME,LRTS
67 S N=0
68 F I=0:0 S I=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,I)) Q:I<1 D
69 . S N=N+1,LRTEST(N)=+^(I,0)
70 S LRNTN=N
71 F I=1:1:N D
72 . S:$D(^LAB(60,+LRTEST(I),0)) LRTEST(I)=LRTEST(I)_U_^(0) D
73 .. S LRNAME(I)=$P(LRTEST(I),U,2)
74 .. S LRNAME(I,+LRTEST(I))=""
75 .. S LRTS(I)=LRNAME(I)
76 .. S LRTS(I,+LRTEST(I))=""
77 S LRALL=""
78 F I=1:1:LRNTN I $D(LRNAME(I)) D
79 . S LRTS=+$O(LRNAME(I,0))
80 . S LRALL=LRALL_","_I
81 . W !,I," ",LRNAME(I) D
82 .. I $D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,+$O(LRNAME(I,0)),0)),$P(^(0),U,5) W ?25," verified" S LRNOTO=1
83 ;-----------------------------------------------------------------------
84V9 ;
85 W !
86 S LRALL=$P(LRALL,",",2,99)
87 S DIR(0)="F"
88 S DIR("A")="Please enter the test number(s) or "
89 S DIR("B")="ALL"
90 S DIR("?")="Enter ALL, a number, or a range separated by `,' ie 1,2,3."
91 D ^DIR
92 S:$D(DUOUT)!($D(DTOUT)) OK=0 I 'OK S LREND=1
93 S:Y="ALL" Y=LRALL S:Y["A" Y=LRALL
94 D RANGE^LRWU2 Q:X9="" X (X9_"S:'$D(LRNAME(T1)) X=0") I X=0 W !!?7,"Incorrect test number ",$C(7) G EXP
95 Q
Note: See TracBrowser for help on using the repository browser.