source: FOIAVistA/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LADOWN.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: 4.1 KB
Line 
1LADOWN ;DALOI/RWF - TOP LEVEL OF DOWNLOAD OPTIONS ;7/20/90 08:06
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**17,57**;Sep 27, 1994
3 ;
4BUILD ;Build a download file for an Instrument
5 N DIR,LAQUIT,LAX,LRCUP1,LRCUP2,LRNEW,LRPROF,LRTRAY1,LRTYPE,TSK
6 ;
7 S LAQUIT=0
8 ;
9 D INIT
10 I LAQUIT D QUIT Q
11 ;
12BU2 ;
13 W !
14 S DIR(0)="YO"
15 S DIR("?")="If optional for this instrument, should I send the tray,cup locations."
16 S DIR("A")="Send TRAY/CUP locations"
17 S DIR("B")=$S($P(LRAUTO(9),"^",5)="N":"NO",1:"YES")
18 D ^DIR
19 I $D(DIRUT) D QUIT Q
20 S LRFORCE=Y
21 ;
22 K DIR("?")
23 S DIR("B")=$S($P(LRAUTO(9),"^",6)="N":"NO",1:"YES")
24 S DIR("A")="Queue work"
25 D ^DIR
26 I $D(DIRUT) D QUIT Q
27 ;
28 W !
29 I Y=1 D Q
30 . N ZTDESC,ZTRTN,ZTIO,ZTSAVE
31 . S ZTRTN="DQB^LADOWN",ZTIO="",ZTSAVE("LR*")=""
32 . S ZTDESC="AUTO-INSTRUMENT DOWNLOAD "
33 . D ^%ZTLOAD
34 . D QUIT
35 ;
36DQB ;
37 S:$D(ZTQUEUED) ZTREQ="@"
38 ; Now ready to build file.
39 D BUILD^LADOWN1
40 ;
41 ; Routine from auto instrument file.
42 S LRTRAY=LRTRAY1 D @$P(LRAUTO(9),U,3,4)
43 ;
44 ; Go send the records
45 G SE2:$G(LREND)<1,LAST
46 ;
47QUIT ; Clean up
48 K ^TMP($J)
49 K LRLL,LRINST,LRAUTO,LRFILE,LRI,LRTRAY,LRCUP,LRAA,LRAD,LRAN,LRTEST,LRECORD,LRFLUID,LRFORCE,LRL,LRPNM
50 K F,I,J,X,X5,LRRTN
51 Q
52 ;
53INIT ;
54 N %,DIC,DIR,DIRUT,DTOUT,DUOUT,ZTSK,LREND
55 ;
56 S LAQUIT=0
57 ;
58 S DIC="^LAB(62.4,",DIC(0)="AMEQZ"
59 D ^DIC
60 I Y<1 S LAQUIT=1 Q
61 ;
62 S LRINST=+Y,LRAUTO=Y(0),LRAUTO(9)=$G(^LAB(62.4,LRINST,9))
63 I LRAUTO(9)="" D Q
64 . S LAQUIT=1
65 . W !,"Sorry I don't know how to build for this Instrument"
66 ;
67 K DIC
68 S DIC="^LRO(68.2,",DIC(0)="AEMQZ"
69 S DIC("A")="Build using Load List: "
70 S DIC("B")=$P($G(^LRO(68.2,+$P(LRAUTO,"^",4),0)),"^",1)
71 D ^DIC
72 I Y<1 S LAQUIT=1 Q
73 ;
74 S LRLL=+Y,$P(LRAUTO,"^",4)=LRLL,LRTYPE=$P(Y(0),"^",3)
75 S (%,LRPROF)=0
76 F S %=$O(^LRO(68.2,LRLL,10,%)) Q:'% S LRPROF=LRPROF+1
77 I LRPROF>1 D Q:LAQUIT
78 . N DIC,DIR
79 . S DIR(0)="Y",DIR("A")="All Profiles",DIR("B")="YES" D ^DIR
80 . I $D(DIRUT) S LAQUIT=1
81 . S LRPROF=Y
82 . I 'LRPROF D
83 . . S DIC="^LRO(68.2,"_LRLL_",10,",DIC(0)="AEMQ"
84 . . D ^DIC
85 . . I Y<1 S LAQUIT=1
86 . . E S LRPROF=LRPROF_"^"_Y
87 ;
88 S LAX=$G(^LRO(68.2,LRLL,2))
89 I $P(LAX,"^",2)="" D Q
90 . W !,$C(7),"Load/work list not setup"
91 . S LAQUIT=1
92 ;
93 W !!,"Working on the download file for instrument ",$P(LRAUTO,"^",1)
94 W !,"from Load list ",$P(^LRO(68.2,LRLL,0),"^",1)
95 I 'LRPROF W " using profile ",$P(LRPROF,"^",3)
96 ;
97 S LRTRAY1=$P(LAX,"^",2)
98 ;
99 I LRTYPE D Q:LAQUIT
100 . N DIR,DIROUT,DIRUT,DTOUT,DUOUT
101 . W !
102 . S DIR(0)="NO^"_$P(LAX,"^",2)_":"_$P(LAX,"^",4)_":0"
103 . S DIR("A")="Starting Tray number"
104 . S DIR("B")=$P(LAX,"^",2)
105 . S DIR("?")="Enter a tray to start the build and sending at."
106 . D ^DIR
107 . I $D(DIRUT) S LAQUIT=1
108 . E S LRTRAY1=Y
109 ;
110 W !
111 K DIR,DIROUT,DIRUT,DTOUT,DUOUT
112 S DIR(0)="NO^1:9999:0"
113 S DIR("A")="Starting "_$S(LRTYPE:"CUP",1:"SEQUENCE")_" number"
114 S DIR("B")=$P(LAX,"^",3)
115 S DIR("?")="Enter a "_$S(LRTYPE:"cup",1:"sequence")_" to start the build and sending at."
116 D ^DIR
117 I $D(DIRUT) S LAQUIT=1
118 E S (LRCUP1,LRCUP2)=Y
119 Q
120 ;
121 ;
122PURGE ; Remove the download records from the Load List file, Should be removed when sent.
123 N C,T
124 D INIT
125 I Y'>0 D QUIT Q
126 S %=2 W !,"Is this OK" D YN^DICN G QUIT:%'=1
127 ;
128 S T=0
129 F S T=$O(^LRO(68.2,LRLL,1,T)) Q:T'>0 D
130 . S C=0
131 . F S C=$O(^LRO(68.2,LRLL,1,T,1,C)) Q:C'>0 K ^LRO(68.2,LRLL,1,T,1,C,2)
132 W !,"DONE"
133 D QUIT
134 Q
135 ;
136SEND D INIT
137 I Y'>0 D QUIT Q
138SE2 ;
139 K LRFILE
140 I '$D(ZTQUEUED) W !,"Now setting up to send."
141 S TSK=LRINST,LRRTN=$P(LRAUTO(9),"^",1,2),LRFILE=$P(^LRO(68.2,LRLL,0),"^",1),T=TSK
142 I '$P(LRAUTO,"^",8) D SETO^LAB
143 ;
144 ;Set-up call
145 D:$L($P(LRRTN,U,2)) @("START^"_$P(LRRTN,"^",2))
146 ;
147 S LRTRAY=LRTRAY1
148 F D Q:LRTRAY'>0
149 . I $D(^LRO(68.2,LRLL,1,LRTRAY)) D TRAY
150 . S LRTRAY=$O(^LRO(68.2,LRLL,1,LRTRAY)) Q:LRTRAY'>0 S LRCUP2=1
151 ;
152 ;
153SE3 ; Clean-up call
154 D:$L($P(LRRTN,U,2)) @("END^"_$P(LRRTN,"^",2))
155 ;
156LAST ;
157 I '$D(ZTQUEUED) W !,"DONE. Data should start moving now"
158 D QUIT
159 Q
160 ;
161NEW ;Start a new file for each tray.
162 D:$L($P(LRRTN,U,2)) @("NEXT^"_$P(LRRTN,"^",2)) Q
163 ;
164TRAY ;
165 S LRNEW=1 Q:LRTRAY'>0
166 S LRCUP=LRCUP2-.1
167 F S LRCUP=$O(^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP)) Q:LRCUP'>0 D
168 . I LRNEW D NEW
169 . S LRNEW=0
170 . I $D(^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP,2)) S X=^(2) D:$L($P(LRRTN,U,2)) @LRRTN
Note: See TracBrowser for help on using the repository browser.