LAH717D.m

LAH717D ; IHS/DIR/FJE - HITATCHI 717 BUILD DOWNLOAD FILE. 7/20/90 08:38 ;

 ;;5.2;LA;;NOV 01, 1997

 ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994

 ;Call with LRLL = load list to build

 ;Call with LRTRAY1 = Starting tray number

 ;Call with LRLL = Auto Instrument pointer

 ;Call with LRFORCE=1 if send tray and cup.

 S:$D(ZTQUEUED) ZTREQ="@" S (LRECORD,BLK)="" F I=1:1:42 S BLK=BLK_" "

A F LRTRAY=LRTRAY1:0 D:$D(^LRO(68.2,LRLL,1,LRTRAY)) TRAY S LRTRAY=$O(^LRO(68.2,LRLL,1,LRTRAY)),LRCUP1=1 Q:LRTRAY'>0

 S LREND=0 Q

TRAY F LRCUP=(LRCUP1-1):0 S LRCUP=$O(^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP)) Q:LRCUP'>0  D SAMPLE I $L(LRECORD)>99 D SEND S LRECORD=""

 I $L(LRECORD),$L(LRECORD)<100 D PAD

 I C#2 D PAD1

 Q

SAMPLE S LRL=^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP,0),LRAA=+LRL,LRAD=$P(LRL,"^",2),LRAN=$P(LRL,"^",3) D TEST

 I $L(LRECORD)=0 S LRECORD="K"_$E(BLK,1,15)_$E(100000+LRAN,2,6)_$E(BLK,1,42)_X

 E  S LRECORD=LRECORD_"K"_$E(BLK,1,15)_$E(100000+LRAN,2,6)_$E(BLK,1,42)_X

 Q

SEND S:'$D(^LA(LRINST,"C")) ^LA(LRINST,"C")=0,^("C",0)=0

 S (C,^LA(LRINST,"C"))=^LA(LRINST,"C")+1,^("C",C)=LRECORD

 Q

TEST S X="" D ZERO

 F LRTEST=0:0 S LRTEST=$O(^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP,1,LRTEST)) Q:LRTEST'>0  D T2

 Q

T2 Q:'$D(^TMP($J,LRTEST))

 S X1="" F I=0:0 S I=$O(^TMP($J,LRTEST,I)) Q:I'>0  S Y=^(I) S X=$E(X,1,(Y-1))_"1"_$E(X,(Y+1),35)

 Q

PAD S X="" D ZERO S LRECORD=LRECORD_"K" F I=$L(LRECORD)+1:1:196 S LRECORD=LRECORD_" "

 S LRECORD=$E(LRECORD,1,115)_"0000"_$E(LRECORD,120,161)_X D SEND Q

PAD1 S X="" D ZERO S LRECORD="" F I=1:1:196 S LRECORD=LRECORD_" "

 S LRECORD="K"_$E(LRECORD,2,17)_"0000"_$E(LRECORD,22,63)_X_"K"_$E(LRECORD,100,115)_"0000"_$E(LRECORD,120,161)_X D SEND Q

 Q

ZERO F I=1:1:34 S X=X_"0"

 S X=X_" " Q

LAH717D   ; IHS/DIR/FJE - HITATCHI 717 BUILD DOWNLOAD FILE. 7/20/90 08:38 ;

 +1       ;;5.2;LA;;NOV 01, 1997

 +2       ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994

 +3       ;Call with LRLL = load list to build

 +4       ;Call with LRTRAY1 = Starting tray number

 +5       ;Call with LRLL = Auto Instrument pointer

 +6       ;Call with LRFORCE=1 if send tray and cup.

 +7        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

           SET (LRECORD,BLK)=""

           FOR I=1:1:42

               SET BLK=BLK_" "

A          FOR LRTRAY=LRTRAY1:0

               IF $DATA(^LRO(68.2,LRLL,1,LRTRAY))

                   DO TRAY

               SET LRTRAY=$ORDER(^LRO(68.2,LRLL,1,LRTRAY))

               SET LRCUP1=1

               IF LRTRAY'>0

                   QUIT 

 +1        SET LREND=0

           QUIT 

TRAY       FOR LRCUP=(LRCUP1-1):0

               SET LRCUP=$ORDER(^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP))

               IF LRCUP'>0

                   QUIT 

               DO SAMPLE

               IF $LENGTH(LRECORD)>99

                   DO SEND

                   SET LRECORD=""

 +1        IF $LENGTH(LRECORD)

               IF $LENGTH(LRECORD)<100

                   DO PAD

 +2        IF C#2

               DO PAD1

 +3        QUIT 

SAMPLE     SET LRL=^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP,0)

           SET LRAA=+LRL

           SET LRAD=$PIECE(LRL,"^",2)

           SET LRAN=$PIECE(LRL,"^",3)

           DO TEST

 +1        IF $LENGTH(LRECORD)=0

               SET LRECORD="K"_$EXTRACT(BLK,1,15)_$EXTRACT(100000+LRAN,2,6)_$EXTRACT(BLK,1,42)_X

 +2       IF '$TEST

               SET LRECORD=LRECORD_"K"_$EXTRACT(BLK,1,15)_$EXTRACT(100000+LRAN,2,6)_$EXTRACT(BLK,1,42)_X

 +3        QUIT 

SEND       IF '$DATA(^LA(LRINST,"C"))

               SET ^LA(LRINST,"C")=0

               SET ^("C",0)=0

 +1        SET (C,^LA(LRINST,"C"))=^LA(LRINST,"C")+1

           SET ^("C",C)=LRECORD

 +2        QUIT 

TEST       SET X=""

           DO ZERO

 +1        FOR LRTEST=0:0

               SET LRTEST=$ORDER(^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP,1,LRTEST))

               IF LRTEST'>0

                   QUIT 

               DO T2

 +2        QUIT 

T2         IF '$DATA(^TMP($JOB,LRTEST))

               QUIT 

 +1        SET X1=""

           FOR I=0:0

               SET I=$ORDER(^TMP($JOB,LRTEST,I))

               IF I'>0

                   QUIT 

               SET Y=^(I)

               SET X=$EXTRACT(X,1,(Y-1))_"1"_$EXTRACT(X,(Y+1),35)

 +2        QUIT 

PAD        SET X=""

           DO ZERO

           SET LRECORD=LRECORD_"K"

           FOR I=$LENGTH(LRECORD)+1:1:196

               SET LRECORD=LRECORD_" "

 +1        SET LRECORD=$EXTRACT(LRECORD,1,115)_"0000"_$EXTRACT(LRECORD,120,161)_X

           DO SEND

           QUIT 

PAD1       SET X=""

           DO ZERO

           SET LRECORD=""

           FOR I=1:1:196

               SET LRECORD=LRECORD_" "

 +1        SET LRECORD="K"_$EXTRACT(LRECORD,2,17)_"0000"_$EXTRACT(LRECORD,22,63)_X_"K"_$EXTRACT(LRECORD,100,115)_"0000"_$EXTRACT(LRECORD,120,161)_X

           DO SEND

           QUIT 

 +2        QUIT 

ZERO       FOR I=1:1:34

               SET X=X_"0"

 +1        SET X=X_" "

           QUIT