source: WorldVistAEHR/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LAMIVTL0.m@ 1000

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

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1LAMIVTL0 ;DAL/HOAK 1st routine for Vitek Literal Verification ;1/22/96 08:30 ;
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**12,37,42**;Sep 27,1994
3INIT ;
4 S OK=1
5 D CONTROL
6 D END
7 Q
8CONTROL ;
9 D INTRO I 'OK D END QUIT
10 Q
11END ;
12 K LRNOTO,LRBUG,LRBUX,LRTIC,LRTAC,LRTAD,LRPIC,LRNODE,LRSUM,LRIFN
13 K LRQUANT,LAMIAUTO,LRINST
14 ;LR*5.2*37___/\______/\ added to fix undef in LRCAPVM
15 Q
16INTRO ;FROM LAMIAUT0 BY FHS
17 ;-----------------------------------------------------------------
18 D ^LRPARAM
19 S LRMIDEF=$P(^LAB(69.9,1,1),U,10) S LRMIOTH=$P(^(1),U,11)
20 S LRINI=$P(^VA(200,DUZ,0),U,2)
21 S LRMICOM=$S($D(^DD(63.31,.01,0)):$P(^(0),U,5,99),1:"S Q9=""1,68,KM"" D COM^LRNUM")
22 S LRMICOMS=$P($P(LRMICOM,",",3),"""",1)
23 S LRTEC=LRINI
24 ;
25MACHINE ;
26 K DIC
27 W @IOF
28 D S1
29 S DIC="^LAB(62.4,"
30 S DIC(0)="AEMQZ"
31 S DIC("A")="Select auto instrument here: "
32 D ^DIC I Y=-1 S OK=0 QUIT ;------------------Back to Control
33 S LRINST=+Y
34 S LRNODE=Y(0)
35 S LRAA=$P(LRNODE,U,11)
36 ;----------------------------------------------------------------------
37 S LRLL=$P(LRNODE,U,4) ;-----------> load/work list
38 I '$G(LRLL) S OK=0 QUIT ;--------------------Back to Control
39 ;----------------------------------------------------------------------
40AREA ;
41 K DIC("A") K Y(0)
42 S DIC="^LRO(68,"
43 S DIC("B")=$P(^LRO(68,LRAA,0),U)
44 D ^DIC ;----------------->ACCESSION AREA
45 I Y=-1 S OK=0 QUIT ;-------------------------Back to Control
46 I +Y'=LRAA S LRAA=+Y
47 ;-----------------------------------------------------------------------
48LRAD ;
49 S %DT="AEP"
50 S %DT("A")=" Accession date: "
51 S %DT("B")=$$FMTE^XLFDT($$CADT^LA7UTIL(LRAA),"1D")
52 D DATE^LRWU I Y=-1 S OK=0 QUIT ;--------------Back to Control
53 S LRAD=+Y
54 ;-----------------------------------------------------------------------
55LMIP ;
56 S LRVT=$P(LRNODE,U,15) I '$G(LRVT) S LRVT="VS"
57 S LRFMT=$P(^LAB(69.9,1,0),U,11),LRFMT=$S(LRFMT="":"I",1:LRFMT)
58 D AUTO^LRCAPV ;--------------->Work Load
59 I Y=-1 S OK=0 QUIT ;--------------------------Back to Control
60 ;-----------------------------------------------------------------------
61ACCN ;
62 I '$D(^LAH(LRLL,1,"C")) S OK=0 D NODATA QUIT ;no data in LAH
63 S OK=1
64 K DIR
65 S LRAN=0
66 F S LRAN=$O(^LAH(LRLL,1,"C",LRAN)) Q:LRAN'>0 D Q:'OK
67 . S DIR(0)="N"
68 . S DIR("A")="Enter the number portion of the Accession"
69 . S DIR("B")=LRAN
70 . S DIR("?")="^D LIST^LAMIVTL0"
71 . D ^DIR
72 . I $D(DUOUT)!($D(DTOUT)) S OK=0 QUIT ;---------Back to Control
73 . I Y'=LRAN S LRAN=+Y
74 . S LRANX=LRAN
75 . ;LA*5.2*37 Check for accns not in Vista
76 . I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) D REMOVE QUIT
77 . ;
78 . ;^LAH(65,1,"C",3,32)
79 . D LRIFN
80 Q:'OK D:$G(OK1)'>0 LIST
81 G:$G(OK1)'>0 ACCN
82 Q
83S1 ;
84 W !!," Vitek Literal verification screen 1",!
85 Q
86 ;---------------------------------------------------------------------
87LIST ;
88 W !!
89 S LRLIST=0
90 W !,"Choose from: "
91 F S LRLIST=$O(^LAH(LRLL,1,"C",LRLIST)) Q:LRLIST="" D
92 . W !,LRLIST
93 Q
94REMOVE ;
95 ;
96 ;--^LAH(65,1,"C",3659,69) =
97 ;_____________________/\
98 ; \/
99 ;--^LAH(65,1,69,0) = 1^1^^^3659^^VITEK^3659
100 ;--^LAH(65,1,69,2,2) = CARD^gni
101 ;--^LAH(65,1,69,3,1,0) = 1^^gni
102 ;
103 ;
104 S DIR("A")=$P(^LRO(68,12,0),U)_" "_LRAN_" is not in Vista data base. I've removed the C x-ref Shall I remove ^LAH Data?"
105 S DIR(0)="Y" S DIR("B")="YES"
106 D ^DIR
107 I $D(DTOUT)!($D(DUOUT)) S OK=0 QUIT
108 ;
109 I Y=1 D
110 . S LRTIC=0
111 . F S LRTIC=$O(^LAH(LRLL,1,"C",LRAN,LRTIC)) Q:+LRTIC'>0 D
112 .. I $D(^LAH(LRLL,1,LRTIC,0)) K ^LAH(LRLL,1,LRTIC)
113 K ^LAH(LRLL,1,"C",LRAN)
114 K ^LAH(LRLL,1,"E",LRAN)
115 ;
116 ;
117 W !,"Please continue...",!
118 Q
119LRIFN ;
120 S OK1=1
121 S LRIFN=0,LRCNT=0
122 F S LRIFN=$O(^LAH(LRLL,1,"C",LRAN,LRIFN)) Q:LRIFN'>0 D Q:'OK1
123 . S LRCNT=LRCNT+1
124 . S LRIFN(LRCNT)=LRIFN
125 I '$G(LRCNT) W !!,"There is no data in LAH for accession ",LRAN S OK1=0 QUIT
126 Q:'OK1
127 D ^LAMIVTL5 ;check for zero isolate
128 Q:'OK
129 D ^LAMIVTL1 ;continue processing
130 D END
131 Q
132NODATA ;
133 W !!," There is no data in LAH. Run another upload "
134 Q
Note: See TracBrowser for help on using the repository browser.