LADOWN ;DALOI/RWF - TOP LEVEL OF DOWNLOAD OPTIONS ;7/20/90 08:06
;;5.2;AUTOMATED LAB INSTRUMENTS;**17,57**;Sep 27, 1994
;
BUILD ;Build a download file for an Instrument
N DIR,LAQUIT,LAX,LRCUP1,LRCUP2,LRNEW,LRPROF,LRTRAY1,LRTYPE,TSK
;
S LAQUIT=0
;
D INIT
I LAQUIT D QUIT Q
;
BU2 ;
W !
S DIR(0)="YO"
S DIR("?")="If optional for this instrument, should I send the tray,cup locations."
S DIR("A")="Send TRAY/CUP locations"
S DIR("B")=$S($P(LRAUTO(9),"^",5)="N":"NO",1:"YES")
D ^DIR
I $D(DIRUT) D QUIT Q
S LRFORCE=Y
;
K DIR("?")
S DIR("B")=$S($P(LRAUTO(9),"^",6)="N":"NO",1:"YES")
S DIR("A")="Queue work"
D ^DIR
I $D(DIRUT) D QUIT Q
;
W !
I Y=1 D Q
. N ZTDESC,ZTRTN,ZTIO,ZTSAVE
. S ZTRTN="DQB^LADOWN",ZTIO="",ZTSAVE("LR*")=""
. S ZTDESC="AUTO-INSTRUMENT DOWNLOAD "
. D ^%ZTLOAD
. D QUIT
;
DQB ;
S:$D(ZTQUEUED) ZTREQ="@"
; Now ready to build file.
D BUILD^LADOWN1
;
; Routine from auto instrument file.
S LRTRAY=LRTRAY1 D @$P(LRAUTO(9),U,3,4)
;
; Go send the records
G SE2:$G(LREND)<1,LAST
;
QUIT ; Clean up
K ^TMP($J)
K LRLL,LRINST,LRAUTO,LRFILE,LRI,LRTRAY,LRCUP,LRAA,LRAD,LRAN,LRTEST,LRECORD,LRFLUID,LRFORCE,LRL,LRPNM
K F,I,J,X,X5,LRRTN
Q
;
INIT ;
N %,DIC,DIR,DIRUT,DTOUT,DUOUT,ZTSK,LREND
;
S LAQUIT=0
;
S DIC="^LAB(62.4,",DIC(0)="AMEQZ"
D ^DIC
I Y<1 S LAQUIT=1 Q
;
S LRINST=+Y,LRAUTO=Y(0),LRAUTO(9)=$G(^LAB(62.4,LRINST,9))
I LRAUTO(9)="" D Q
. S LAQUIT=1
. W !,"Sorry I don't know how to build for this Instrument"
;
K DIC
S DIC="^LRO(68.2,",DIC(0)="AEMQZ"
S DIC("A")="Build using Load List: "
S DIC("B")=$P($G(^LRO(68.2,+$P(LRAUTO,"^",4),0)),"^",1)
D ^DIC
I Y<1 S LAQUIT=1 Q
;
S LRLL=+Y,$P(LRAUTO,"^",4)=LRLL,LRTYPE=$P(Y(0),"^",3)
S (%,LRPROF)=0
F S %=$O(^LRO(68.2,LRLL,10,%)) Q:'% S LRPROF=LRPROF+1
I LRPROF>1 D Q:LAQUIT
. N DIC,DIR
. S DIR(0)="Y",DIR("A")="All Profiles",DIR("B")="YES" D ^DIR
. I $D(DIRUT) S LAQUIT=1
. S LRPROF=Y
. I 'LRPROF D
. . S DIC="^LRO(68.2,"_LRLL_",10,",DIC(0)="AEMQ"
. . D ^DIC
. . I Y<1 S LAQUIT=1
. . E S LRPROF=LRPROF_"^"_Y
;
S LAX=$G(^LRO(68.2,LRLL,2))
I $P(LAX,"^",2)="" D Q
. W !,$C(7),"Load/work list not setup"
. S LAQUIT=1
;
W !!,"Working on the download file for instrument ",$P(LRAUTO,"^",1)
W !,"from Load list ",$P(^LRO(68.2,LRLL,0),"^",1)
I 'LRPROF W " using profile ",$P(LRPROF,"^",3)
;
S LRTRAY1=$P(LAX,"^",2)
;
I LRTYPE D Q:LAQUIT
. N DIR,DIROUT,DIRUT,DTOUT,DUOUT
. W !
. S DIR(0)="NO^"_$P(LAX,"^",2)_":"_$P(LAX,"^",4)_":0"
. S DIR("A")="Starting Tray number"
. S DIR("B")=$P(LAX,"^",2)
. S DIR("?")="Enter a tray to start the build and sending at."
. D ^DIR
. I $D(DIRUT) S LAQUIT=1
. E S LRTRAY1=Y
;
W !
K DIR,DIROUT,DIRUT,DTOUT,DUOUT
S DIR(0)="NO^1:9999:0"
S DIR("A")="Starting "_$S(LRTYPE:"CUP",1:"SEQUENCE")_" number"
S DIR("B")=$P(LAX,"^",3)
S DIR("?")="Enter a "_$S(LRTYPE:"cup",1:"sequence")_" to start the build and sending at."
D ^DIR
I $D(DIRUT) S LAQUIT=1
E S (LRCUP1,LRCUP2)=Y
Q
;
;
PURGE ; Remove the download records from the Load List file, Should be removed when sent.
N C,T
D INIT
I Y'>0 D QUIT Q
S %=2 W !,"Is this OK" D YN^DICN G QUIT:%'=1
;
S T=0
F S T=$O(^LRO(68.2,LRLL,1,T)) Q:T'>0 D
. S C=0
. 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)
W !,"DONE"
D QUIT
Q
;
SEND D INIT
I Y'>0 D QUIT Q
SE2 ;
K LRFILE
I '$D(ZTQUEUED) W !,"Now setting up to send."
S TSK=LRINST,LRRTN=$P(LRAUTO(9),"^",1,2),LRFILE=$P(^LRO(68.2,LRLL,0),"^",1),T=TSK
I '$P(LRAUTO,"^",8) D SETO^LAB
;
;Set-up call
D:$L($P(LRRTN,U,2)) @("START^"_$P(LRRTN,"^",2))
;
S LRTRAY=LRTRAY1
F D Q:LRTRAY'>0
. I $D(^LRO(68.2,LRLL,1,LRTRAY)) D TRAY
. S LRTRAY=$O(^LRO(68.2,LRLL,1,LRTRAY)) Q:LRTRAY'>0 S LRCUP2=1
;
;
SE3 ; Clean-up call
D:$L($P(LRRTN,U,2)) @("END^"_$P(LRRTN,"^",2))
;
LAST ;
I '$D(ZTQUEUED) W !,"DONE. Data should start moving now"
D QUIT
Q
;
NEW ;Start a new file for each tray.
D:$L($P(LRRTN,U,2)) @("NEXT^"_$P(LRRTN,"^",2)) Q
;
TRAY ;
S LRNEW=1 Q:LRTRAY'>0
S LRCUP=LRCUP2-.1
F S LRCUP=$O(^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP)) Q:LRCUP'>0 D
. I LRNEW D NEW
. S LRNEW=0
. I $D(^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP,2)) S X=^(2) D:$L($P(LRRTN,U,2)) @LRRTN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLADOWN 4352 printed Nov 22, 2024@16:52:27 Page 2
LADOWN ;DALOI/RWF - TOP LEVEL OF DOWNLOAD OPTIONS ;7/20/90 08:06
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**17,57**;Sep 27, 1994
+2 ;
BUILD ;Build a download file for an Instrument
+1 NEW DIR,LAQUIT,LAX,LRCUP1,LRCUP2,LRNEW,LRPROF,LRTRAY1,LRTYPE,TSK
+2 ;
+3 SET LAQUIT=0
+4 ;
+5 DO INIT
+6 IF LAQUIT
DO QUIT
QUIT
+7 ;
BU2 ;
+1 WRITE !
+2 SET DIR(0)="YO"
+3 SET DIR("?")="If optional for this instrument, should I send the tray,cup locations."
+4 SET DIR("A")="Send TRAY/CUP locations"
+5 SET DIR("B")=$SELECT($PIECE(LRAUTO(9),"^",5)="N":"NO",1:"YES")
+6 DO ^DIR
+7 IF $DATA(DIRUT)
DO QUIT
QUIT
+8 SET LRFORCE=Y
+9 ;
+10 KILL DIR("?")
+11 SET DIR("B")=$SELECT($PIECE(LRAUTO(9),"^",6)="N":"NO",1:"YES")
+12 SET DIR("A")="Queue work"
+13 DO ^DIR
+14 IF $DATA(DIRUT)
DO QUIT
QUIT
+15 ;
+16 WRITE !
+17 IF Y=1
Begin DoDot:1
+18 NEW ZTDESC,ZTRTN,ZTIO,ZTSAVE
+19 SET ZTRTN="DQB^LADOWN"
SET ZTIO=""
SET ZTSAVE("LR*")=""
+20 SET ZTDESC="AUTO-INSTRUMENT DOWNLOAD "
+21 DO ^%ZTLOAD
+22 DO QUIT
End DoDot:1
QUIT
+23 ;
DQB ;
+1 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 ; Now ready to build file.
+3 DO BUILD^LADOWN1
+4 ;
+5 ; Routine from auto instrument file.
+6 SET LRTRAY=LRTRAY1
DO @$PIECE(LRAUTO(9),U,3,4)
+7 ;
+8 ; Go send the records
+9 if $GET(LREND)<1
GOTO SE2
GOTO LAST
+10 ;
QUIT ; Clean up
+1 KILL ^TMP($JOB)
+2 KILL LRLL,LRINST,LRAUTO,LRFILE,LRI,LRTRAY,LRCUP,LRAA,LRAD,LRAN,LRTEST,LRECORD,LRFLUID,LRFORCE,LRL,LRPNM
+3 KILL F,I,J,X,X5,LRRTN
+4 QUIT
+5 ;
INIT ;
+1 NEW %,DIC,DIR,DIRUT,DTOUT,DUOUT,ZTSK,LREND
+2 ;
+3 SET LAQUIT=0
+4 ;
+5 SET DIC="^LAB(62.4,"
SET DIC(0)="AMEQZ"
+6 DO ^DIC
+7 IF Y<1
SET LAQUIT=1
QUIT
+8 ;
+9 SET LRINST=+Y
SET LRAUTO=Y(0)
SET LRAUTO(9)=$GET(^LAB(62.4,LRINST,9))
+10 IF LRAUTO(9)=""
Begin DoDot:1
+11 SET LAQUIT=1
+12 WRITE !,"Sorry I don't know how to build for this Instrument"
End DoDot:1
QUIT
+13 ;
+14 KILL DIC
+15 SET DIC="^LRO(68.2,"
SET DIC(0)="AEMQZ"
+16 SET DIC("A")="Build using Load List: "
+17 SET DIC("B")=$PIECE($GET(^LRO(68.2,+$PIECE(LRAUTO,"^",4),0)),"^",1)
+18 DO ^DIC
+19 IF Y<1
SET LAQUIT=1
QUIT
+20 ;
+21 SET LRLL=+Y
SET $PIECE(LRAUTO,"^",4)=LRLL
SET LRTYPE=$PIECE(Y(0),"^",3)
+22 SET (%,LRPROF)=0
+23 FOR
SET %=$ORDER(^LRO(68.2,LRLL,10,%))
if '%
QUIT
SET LRPROF=LRPROF+1
+24 IF LRPROF>1
Begin DoDot:1
+25 NEW DIC,DIR
+26 SET DIR(0)="Y"
SET DIR("A")="All Profiles"
SET DIR("B")="YES"
DO ^DIR
+27 IF $DATA(DIRUT)
SET LAQUIT=1
+28 SET LRPROF=Y
+29 IF 'LRPROF
Begin DoDot:2
+30 SET DIC="^LRO(68.2,"_LRLL_",10,"
SET DIC(0)="AEMQ"
+31 DO ^DIC
+32 IF Y<1
SET LAQUIT=1
+33 IF '$TEST
SET LRPROF=LRPROF_"^"_Y
End DoDot:2
End DoDot:1
if LAQUIT
QUIT
+34 ;
+35 SET LAX=$GET(^LRO(68.2,LRLL,2))
+36 IF $PIECE(LAX,"^",2)=""
Begin DoDot:1
+37 WRITE !,$CHAR(7),"Load/work list not setup"
+38 SET LAQUIT=1
End DoDot:1
QUIT
+39 ;
+40 WRITE !!,"Working on the download file for instrument ",$PIECE(LRAUTO,"^",1)
+41 WRITE !,"from Load list ",$PIECE(^LRO(68.2,LRLL,0),"^",1)
+42 IF 'LRPROF
WRITE " using profile ",$PIECE(LRPROF,"^",3)
+43 ;
+44 SET LRTRAY1=$PIECE(LAX,"^",2)
+45 ;
+46 IF LRTYPE
Begin DoDot:1
+47 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT
+48 WRITE !
+49 SET DIR(0)="NO^"_$PIECE(LAX,"^",2)_":"_$PIECE(LAX,"^",4)_":0"
+50 SET DIR("A")="Starting Tray number"
+51 SET DIR("B")=$PIECE(LAX,"^",2)
+52 SET DIR("?")="Enter a tray to start the build and sending at."
+53 DO ^DIR
+54 IF $DATA(DIRUT)
SET LAQUIT=1
+55 IF '$TEST
SET LRTRAY1=Y
End DoDot:1
if LAQUIT
QUIT
+56 ;
+57 WRITE !
+58 KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT
+59 SET DIR(0)="NO^1:9999:0"
+60 SET DIR("A")="Starting "_$SELECT(LRTYPE:"CUP",1:"SEQUENCE")_" number"
+61 SET DIR("B")=$PIECE(LAX,"^",3)
+62 SET DIR("?")="Enter a "_$SELECT(LRTYPE:"cup",1:"sequence")_" to start the build and sending at."
+63 DO ^DIR
+64 IF $DATA(DIRUT)
SET LAQUIT=1
+65 IF '$TEST
SET (LRCUP1,LRCUP2)=Y
+66 QUIT
+67 ;
+68 ;
PURGE ; Remove the download records from the Load List file, Should be removed when sent.
+1 NEW C,T
+2 DO INIT
+3 IF Y'>0
DO QUIT
QUIT
+4 SET %=2
WRITE !,"Is this OK"
DO YN^DICN
if %'=1
GOTO QUIT
+5 ;
+6 SET T=0
+7 FOR
SET T=$ORDER(^LRO(68.2,LRLL,1,T))
if T'>0
QUIT
Begin DoDot:1
+8 SET C=0
+9 FOR
SET C=$ORDER(^LRO(68.2,LRLL,1,T,1,C))
if C'>0
QUIT
KILL ^LRO(68.2,LRLL,1,T,1,C,2)
End DoDot:1
+10 WRITE !,"DONE"
+11 DO QUIT
+12 QUIT
+13 ;
SEND DO INIT
+1 IF Y'>0
DO QUIT
QUIT
SE2 ;
+1 KILL LRFILE
+2 IF '$DATA(ZTQUEUED)
WRITE !,"Now setting up to send."
+3 SET TSK=LRINST
SET LRRTN=$PIECE(LRAUTO(9),"^",1,2)
SET LRFILE=$PIECE(^LRO(68.2,LRLL,0),"^",1)
SET T=TSK
+4 IF '$PIECE(LRAUTO,"^",8)
DO SETO^LAB
+5 ;
+6 ;Set-up call
+7 if $LENGTH($PIECE(LRRTN,U,2))
DO @("START^"_$PIECE(LRRTN,"^",2))
+8 ;
+9 SET LRTRAY=LRTRAY1
+10 FOR
Begin DoDot:1
+11 IF $DATA(^LRO(68.2,LRLL,1,LRTRAY))
DO TRAY
+12 SET LRTRAY=$ORDER(^LRO(68.2,LRLL,1,LRTRAY))
if LRTRAY'>0
QUIT
SET LRCUP2=1
End DoDot:1
if LRTRAY'>0
QUIT
+13 ;
+14 ;
SE3 ; Clean-up call
+1 if $LENGTH($PIECE(LRRTN,U,2))
DO @("END^"_$PIECE(LRRTN,"^",2))
+2 ;
LAST ;
+1 IF '$DATA(ZTQUEUED)
WRITE !,"DONE. Data should start moving now"
+2 DO QUIT
+3 QUIT
+4 ;
NEW ;Start a new file for each tray.
+1 if $LENGTH($PIECE(LRRTN,U,2))
DO @("NEXT^"_$PIECE(LRRTN,"^",2))
QUIT
+2 ;
TRAY ;
+1 SET LRNEW=1
if LRTRAY'>0
QUIT
+2 SET LRCUP=LRCUP2-.1
+3 FOR
SET LRCUP=$ORDER(^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP))
if LRCUP'>0
QUIT
Begin DoDot:1
+4 IF LRNEW
DO NEW
+5 SET LRNEW=0
+6 IF $DATA(^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP,2))
SET X=^(2)
if $LENGTH($PIECE(LRRTN,U,2))
DO @LRRTN
End DoDot:1
