| [613] | 1 | LAMIVTL1 ;DAL/HOAK 2nd Vitek literal verify rtn
|
|---|
| 2 | ;;5.2;AUTOMATED LAB INSTRUMENTS;**12,29**;Sep 27,1994
|
|---|
| 3 | INIT ;
|
|---|
| 4 | S OK=1
|
|---|
| 5 | S LREND=0
|
|---|
| 6 | D CONTROL
|
|---|
| 7 | Q
|
|---|
| 8 | CONTROL ;
|
|---|
| 9 | W @IOF
|
|---|
| 10 | D SETUP Q:'OK
|
|---|
| 11 | D EXP Q:'OK
|
|---|
| 12 | D ^LAMIVTL2
|
|---|
| 13 | Q
|
|---|
| 14 | SETUP ;
|
|---|
| 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 | ;----------------------------------------------------------------------
|
|---|
| 33 | EN ; 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 | ;----------------------------------------------------------------------
|
|---|
| 39 | PAT ;
|
|---|
| 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
|
|---|
| 60 | EXP ; 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 | ;-----------------------------------------------------------------------
|
|---|
| 84 | V9 ;
|
|---|
| 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
|
|---|
