- LAH717D ;SLC/DLG - HITATCHI 717 BUILD DOWNLOAD FILE. ;7/20/90 08:38 ;
- ;;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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLAH717D 1695 printed Jan 18, 2025@02:43:48 Page 2
- LAH717D ;SLC/DLG - HITATCHI 717 BUILD DOWNLOAD FILE. ;7/20/90 08:38 ;
- +1 ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
- +2 ;Call with LRLL = load list to build
- +3 ;Call with LRTRAY1 = Starting tray number
- +4 ;Call with LRLL = Auto Instrument pointer
- +5 ;Call with LRFORCE=1 if send tray and cup.
- +6 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