- LAPERD ; IHS/DIR/FJE - AMERICAN MONITOR PERSPECTIVE BUILD DOWNLOAD FILE. 7/20/90 09:58 ;
- ;;5.2;LA;;NOV 01, 1997
- ;;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
- LAPERD ; IHS/DIR/FJE - AMERICAN MONITOR PERSPECTIVE BUILD DOWNLOAD FILE. 7/20/90 09:58 ;
- +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 LRTRAY = 'A'll or a tray number
- +5 ;Call with LRINST = Auto Instrument pointer
- +6 ;Call with LRFORCE=1 if send tray and cup.
- +7 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
