LAPERD.m

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