LAPERD ;SLC/DLG - AMERICAN MONITOR PERSPECTIVE BUILD DOWNLOAD FILE. ;7/20/90 09:58 ;
;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
;Call with LRLL = load list to build
;Call with LRTRAY = 'A'll or a tray number
;Call with LRINST = Auto Instrument pointer
;Call with LRFORCE=1 if send tray and cup.
I '$D(^LA(LRINST,"I")) S T=LRINST D SET^LASET
A S:$D(ZTQUEUED) ZTREQ="@" I LRTRAY D TRAY G Q
F LRTRAY=0:0 S LRTRAY=$O(^LRO(68.2,LRLL,1,LRTRAY)) Q:LRTRAY'>0 D TRAY
Q S LREND=0 L ^LA("Q") S Q=^LA("Q")+1,^("Q")=Q,^("Q",Q)=LRINST L
Q
TRAY S LRECORD="+" F LRCUP=0:0 S LRCUP=$O(^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP)) Q:LRCUP'>0 D SAMPLE S LRECORD="+"
Q
SAMPLE S LRL=^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP,0),LRAA=+LRL,LRAD=$P(LRL,"^",2),LRAN=$P(LRL,"^",3) D PNM S LRECORD=LRECORD_PNM_" 10 9 11 12" D SEN
S LRECORD=$E(10000+LRAN,2,5) D SEN
D TEST S LRECORD=X D SEN S LRECORD=LRTRAY D SEN S LRECORD=LRCUP D SEN
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
S:$E(X,$L(X))=" " X=$E(X,1,($L(X)-1)) Q
T2 Q:'$D(^TMP($J,LRTEST)) F I=0:0 S I=$O(^TMP($J,LRTEST,I)) Q:I'>0 S X=X_^(I)_" "
Q
PNM ;Get patient ssn for sample id.
S X=^LRO(68,LRAA,1,LRAD,1,LRAN,0),X=^LR(+X,0),PNM="" S:$P(X,"^",2)=2 DFN=$P(X,"^",3) D:DFN]"" PT^LRX S:PNM="" PNM=$S(LRCUP=1:"0302",LRCUP=2:"0303",1:"111111111")
Q
SEN S CNT=^LA(LRINST,"O")+1,^("O")=CNT,^("O",CNT)=LRECORD Q
ACK I $D(NCNT),NCNT>3 K NCNT Q ;TO MANY ERRORS JUST QUIT
I IN[$C(6)!IN["~F" S O=^LA(LRINST,"O",0)+1,^(0)=O,OUT=^(O),T=T-BASE K NCNT
E S O=^LA(T,"O",0),OUT=^(O),T=T-BASE S:'$D(NCNT) NCNT=0 S NCNT=NCNT+1
I $D(^LA("TP")) L ^LA("TP") S O=^LA("TP",0)+1,^(0)=O,^(O)="SENT: "_LRINST_"^"_OUT L
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLAPERD 1718 printed Dec 13, 2024@01:43:57 Page 2
LAPERD ;SLC/DLG - AMERICAN MONITOR PERSPECTIVE BUILD DOWNLOAD FILE. ;7/20/90 09:58 ;
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
+2 ;Call with LRLL = load list to build
+3 ;Call with LRTRAY = 'A'll or a tray number
+4 ;Call with LRINST = Auto Instrument pointer
+5 ;Call with LRFORCE=1 if send tray and cup.
+6 IF '$DATA(^LA(LRINST,"I"))
SET T=LRINST
DO SET^LASET
A if $DATA(ZTQUEUED)
SET ZTREQ="@"
IF LRTRAY
DO TRAY
GOTO Q
+1 FOR LRTRAY=0:0
SET LRTRAY=$ORDER(^LRO(68.2,LRLL,1,LRTRAY))
if LRTRAY'>0
QUIT
DO TRAY
Q SET LREND=0
LOCK ^LA("Q")
SET Q=^LA("Q")+1
SET ^("Q")=Q
SET ^("Q",Q)=LRINST
LOCK
+1 QUIT
TRAY SET LRECORD="+"
FOR LRCUP=0:0
SET LRCUP=$ORDER(^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP))
if LRCUP'>0
QUIT
DO SAMPLE
SET LRECORD="+"
+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)
DO PNM
SET LRECORD=LRECORD_PNM_" 10 9 11 12"
DO SEN
+1 SET LRECORD=$EXTRACT(10000+LRAN,2,5)
DO SEN
+2 DO TEST
SET LRECORD=X
DO SEN
SET LRECORD=LRTRAY
DO SEN
SET LRECORD=LRCUP
DO SEN
+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 if $EXTRACT(X,$LENGTH(X))=" "
SET X=$EXTRACT(X,1,($LENGTH(X)-1))
QUIT
T2 if '$DATA(^TMP($JOB,LRTEST))
QUIT
FOR I=0:0
SET I=$ORDER(^TMP($JOB,LRTEST,I))
if I'>0
QUIT
SET X=X_^(I)_" "
+1 QUIT
PNM ;Get patient ssn for sample id.
+1 SET X=^LRO(68,LRAA,1,LRAD,1,LRAN,0)
SET X=^LR(+X,0)
SET PNM=""
if $PIECE(X,"^",2)=2
SET DFN=$PIECE(X,"^",3)
if DFN]""
DO PT^LRX
if PNM=""
SET PNM=$SELECT(LRCUP=1:"0302",LRCUP=2:"0303",1:"111111111")
+2 QUIT
SEN SET CNT=^LA(LRINST,"O")+1
SET ^("O")=CNT
SET ^("O",CNT)=LRECORD
QUIT
ACK ;TO MANY ERRORS JUST QUIT
IF $DATA(NCNT)
IF NCNT>3
KILL NCNT
QUIT
+1 IF IN[$CHAR(6)!IN["~F"
SET O=^LA(LRINST,"O",0)+1
SET ^(0)=O
SET OUT=^(O)
SET T=T-BASE
KILL NCNT
+2 IF '$TEST
SET O=^LA(T,"O",0)
SET OUT=^(O)
SET T=T-BASE
if '$DATA(NCNT)
SET NCNT=0
SET NCNT=NCNT+1
+3 IF $DATA(^LA("TP"))
LOCK ^LA("TP")
SET O=^LA("TP",0)+1
SET ^(0)=O
SET ^(O)="SENT: "_LRINST_"^"_OUT
LOCK
+4 QUIT
