LAEKT7D ;SLC/RWF/DLG - KODAK EKTACHEM 700 BUILD DOWNLOAD FILE. ;8/15/90 15:10 ;
;;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.
A S:$D(ZTQUEUED) ZTREQ="@" S F=$O(^LAB(61,"B","CSF",0)) ;Get CSF pointer value.
S X=^LAB(69.9,1,1),LRFLUID=$P(X,"^",3)_"^"_F_"^"_$P(X,"^",2)
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
Q
TEST S X="" 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)) F I=0:0 S I=$O(^TMP($J,LRTEST,I)) Q:I'>0 S Y=^(I) S:X'[Y X=X_^(I) ;Don't repete a test
Q
SAMPLE S LRL=^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP,0),LRAA=+LRL,LRAD=$P(LRL,"^",2),LRAN=$P(LRL,"^",3),LRECORD=LRECORD_$E(LRAN_" ",1,15) D PNM
S F=$P(LRL,"^",5),F=$S($P(LRFLUID,"^",1)=F:1,$P(LRFLUID,"^",3)=F:3,$P(LRFLUID,"^",2)=F:2,1:0) ;If not one of the 3 fluids don't send
I 'F W:'$D(ZTSK) !,"Accession not correct collection sample: ",LRACC Q
S LRECORD=LRECORD_F_"0"_$S($G(LRFORCE):$C(LRCUP+32),1:" ")_"1.000" D TEST S LRECORD=LRECORD_X_PNM_"]"
S ^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP,2)=LRECORD
Q
TRAY S LRECORD=$S($G(LRFORCE):$E("|"_"TRAY "_LRTRAY_" ",1,16),1:"")
F LRCUP=(LRCUP1-1):0 S LRCUP=$O(^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP)) Q:LRCUP'>0 D SAMPLE S LRECORD=""
Q
PNM ;Get patient name and last 4 from an accession.
S PNM="" Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) S X=^(0),LRACC=^(.2),X=^LR(+X,0) I $P(X,"^",2)=2 S DFN=$P(X,"^",3) D PT^LRX S PNM=$E("|"_$E(PNM,1,20)_" "_$P(SSN,"-",3)_$J(" ",26),1,26)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLAEKT7D 1730 printed Apr 09, 2024@20:47:48 Page 2
LAEKT7D ;SLC/RWF/DLG - KODAK EKTACHEM 700 BUILD DOWNLOAD FILE. ;8/15/90 15:10 ;
+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.
A ;Get CSF pointer value.
if $DATA(ZTQUEUED)
SET ZTREQ="@"
SET F=$ORDER(^LAB(61,"B","CSF",0))
+1 SET X=^LAB(69.9,1,1)
SET LRFLUID=$PIECE(X,"^",3)_"^"_F_"^"_$PIECE(X,"^",2)
+2 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
+3 QUIT
TEST SET X=""
FOR LRTEST=0:0
SET LRTEST=$ORDER(^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP,1,LRTEST))
if LRTEST'>0
QUIT
DO T2
+1 QUIT
T2 ;Don't repete a test
if '$DATA(^TMP($JOB,LRTEST))
QUIT
FOR I=0:0
SET I=$ORDER(^TMP($JOB,LRTEST,I))
if I'>0
QUIT
SET Y=^(I)
if X'[Y
SET X=X_^(I)
+1 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)
SET LRECORD=LRECORD_$EXTRACT(LRAN_" ",1,15)
DO PNM
+1 ;If not one of the 3 fluids don't send
SET F=$PIECE(LRL,"^",5)
SET F=$SELECT($PIECE(LRFLUID,"^",1)=F:1,$PIECE(LRFLUID,"^",3)=F:3,$PIECE(LRFLUID,"^",2)=F:2,1:0)
+2 IF 'F
if '$DATA(ZTSK)
WRITE !,"Accession not correct collection sample: ",LRACC
QUIT
+3 SET LRECORD=LRECORD_F_"0"_$SELECT($GET(LRFORCE):$CHAR(LRCUP+32),1:" ")_"1.000"
DO TEST
SET LRECORD=LRECORD_X_PNM_"]"
+4 SET ^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP,2)=LRECORD
+5 QUIT
TRAY SET LRECORD=$SELECT($GET(LRFORCE):$EXTRACT("|"_"TRAY "_LRTRAY_" ",1,16),1:"")
+1 FOR LRCUP=(LRCUP1-1):0
SET LRCUP=$ORDER(^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP))
if LRCUP'>0
QUIT
DO SAMPLE
SET LRECORD=""
+2 QUIT
PNM ;Get patient name and last 4 from an accession.
+1 SET PNM=""
if '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,0))
QUIT
SET X=^(0)
SET LRACC=^(.2)
SET X=^LR(+X,0)
IF $PIECE(X,"^",2)=2
SET DFN=$PIECE(X,"^",3)
DO PT^LRX
SET PNM=$EXTRACT("|"_$EXTRACT(PNM,1,20)_" "_$PIECE(SSN,"-",3)_$JUSTIFY(" ",26),1,26)
+2 QUIT
