- LAPMAXD ; IHS/DIR/FJE - PARAMAX BUILD DOWNLOAD FILE. 7/20/90 10:01 ;
- ;;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 LRCUP = a starting sequence number (for SEQ/BAT only)
- ;Call with LRINST = Auto Instrument pointer
- I '$D(^LA(LRINST,"O")) S T=LRINST D SETO^LASET
- A S:$D(ZTQUEUED) ZTREQ="@" S:LRTRAY="A" LRTRAY=0
- F LRTRAY=(LRTRAY1-.5):0 S LRTRAY=$O(^LRO(68.2,LRLL,1,LRTRAY)) Q:LRTRAY'>0 D TRAY S LRCUP=1
- Q S LREND=0 L ^LA("Q") S Q=^LA("Q")+1,^("Q")=Q,^("Q",Q)=LRINST L Q
- TRAY F LRCUP=(LRCUP1-1):0 S LRCUP=$O(^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP)) Q:LRCUP'>0 D SAMPLE
- Q
- SAMPLE S LRL=^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP,0),LRAA=+LRL,LRAD=$P(LRL,"^",2),LRAN=$P(LRL,"^",3),LRPMD=$P(X,"^",8) D PNM
- I LRPMD]"" S X=LRPMD D DOC^LRX S LRPMD=$S(Y]"":Y,1:"UNKNOWN") I LRPMD]"" S LRPMD=$P(LRPMD,"^",1)_" "_$P(LRPMD,"^",2)
- S LRECORD="#&6,"_SSN_","_PNM_","_AGE_",Y,"_SEX_","_LRPMD_","_LRWRD D CSUM S LRECORD=LRECORD_"%"_Y_"%" D SEN
- D TEST Q:X']"" S LRECORD="#"_LRAN_"$"_(10000+LRAN)_X_"&5,"_SSN D CSUM S LRECORD=LRECORD_"%"_Y_"%" 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
- CSUM F I=0:0 Q:$E(LRECORD,$L(LRECORD))'="," S LRECORD=$E(LRECORD,1,$L(LRECORD)-1)
- S Y=0 F I=1:1:$L(LRECORD) S Y=Y+$A(LRECORD,I)
- S Y=Y#256,Y=$E("0123456789ABCDEF",(Y\16+1))_$E("0123456789ABCDEF",(Y#16+1)) Q
- SEN S CNT=^LA(LRINST,"O")+1,^("O")=CNT,^("O",CNT)=LRECORD Q
- ACK Q:IN["=" S:'$D(LRC) LRC=0 S LRCNT=^LA(T,"O",0),LRECORD=$P(IN,"%",1),CKSM=$P(IN,"%",2) D CSUM G:Y'=CKSM RETRY
- S LRECORD=$E(LRECORD,2,255) G:(LRECORD="&"!(LRECORD?1N.N1"$"1N.N)) ADV
- S X=+$P(LRECORD,"$",2) ; ERROR CODE
- I (X=-2)!(X=-5)!(X=-6),LRC=0,+$P(^LA(T,"O",LRCNT),"#",2)=+$P(^(LRCNT),"$",2)-10000 S LRECORD=$P($P(^(LRCNT),"$",1)_","_$P(^(LRCNT),",",2,255),"%",1),LRINST=T D CSUM S LRECORD=LRECORD_"%"_Y_"%" D SEN,ADV Q ;REQUEUE WITH NO BARCODE
- RETRY I LRC'>3 S OUT=^(LRCNT),LRC=LRC+1 Q ;IF LRC<=3 NOT MAX RETRIES RESEND
- ;OTHERWISE (TOO MANY RETRIES ALREADY), WE GO ON BY DROPPING THROUGH
- ADV S LRCNT=LRCNT+1 I $D(^(LRCNT)) S ^(0)=LRCNT,OUT=^(LRCNT),LRC=0 Q
- I '$D(^LA("LOCK",T)),$D(^LAB(62.4,T,2)) X ^(2)
- Q
- PNM ;Get patient name and SSN from an accession.
- S X=^LRO(68,LRAA,1,LRAD,1,LRAN,0),X=^LR(+X,0),LRDPF=$P(X,"^",2)
- S DFN=$P(X,"^",3) D PT^LRX
- I $D(AGE) S:AGE="??" AGE=""
- Q
- LAPMAXD ; IHS/DIR/FJE - PARAMAX BUILD DOWNLOAD FILE. 7/20/90 10:01 ;
- +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 LRCUP = a starting sequence number (for SEQ/BAT only)
- +6 ;Call with LRINST = Auto Instrument pointer
- +7 IF '$DATA(^LA(LRINST,"O"))
- SET T=LRINST
- DO SETO^LASET
- A IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- IF LRTRAY="A"
- SET LRTRAY=0
- +1 FOR LRTRAY=(LRTRAY1-.5):0
- SET LRTRAY=$ORDER(^LRO(68.2,LRLL,1,LRTRAY))
- IF LRTRAY'>0
- QUIT
- DO TRAY
- SET LRCUP=1
- Q SET LREND=0
- LOCK ^LA("Q")
- SET Q=^LA("Q")+1
- SET ^("Q")=Q
- SET ^("Q",Q)=LRINST
- LOCK
- QUIT
- TRAY FOR LRCUP=(LRCUP1-1):0
- SET LRCUP=$ORDER(^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP))
- IF LRCUP'>0
- QUIT
- DO SAMPLE
- +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 LRPMD=$PIECE(X,"^",8)
- DO PNM
- +1 IF LRPMD]""
- SET X=LRPMD
- DO DOC^LRX
- SET LRPMD=$SELECT(Y]"":Y,1:"UNKNOWN")
- IF LRPMD]""
- SET LRPMD=$PIECE(LRPMD,"^",1)_" "_$PIECE(LRPMD,"^",2)
- +2 SET LRECORD="#&6,"_SSN_","_PNM_","_AGE_",Y,"_SEX_","_LRPMD_","_LRWRD
- DO CSUM
- SET LRECORD=LRECORD_"%"_Y_"%"
- DO SEN
- +3 DO TEST
- IF X']""
- QUIT
- SET LRECORD="#"_LRAN_"$"_(10000+LRAN)_X_"&5,"_SSN
- DO CSUM
- SET LRECORD=LRECORD_"%"_Y_"%"
- DO SEN
- +4 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
- CSUM FOR I=0:0
- IF $EXTRACT(LRECORD,$LENGTH(LRECORD))'=","
- QUIT
- SET LRECORD=$EXTRACT(LRECORD,1,$LENGTH(LRECORD)-1)
- +1 SET Y=0
- FOR I=1:1:$LENGTH(LRECORD)
- SET Y=Y+$ASCII(LRECORD,I)
- +2 SET Y=Y#256
- SET Y=$EXTRACT("0123456789ABCDEF",(Y\16+1))_$EXTRACT("0123456789ABCDEF",(Y#16+1))
- QUIT
- SEN SET CNT=^LA(LRINST,"O")+1
- SET ^("O")=CNT
- SET ^("O",CNT)=LRECORD
- QUIT
- ACK IF IN["="
- QUIT
- IF '$DATA(LRC)
- SET LRC=0
- SET LRCNT=^LA(T,"O",0)
- SET LRECORD=$PIECE(IN,"%",1)
- SET CKSM=$PIECE(IN,"%",2)
- DO CSUM
- IF Y'=CKSM
- GOTO RETRY
- +1 SET LRECORD=$EXTRACT(LRECORD,2,255)
- IF (LRECORD="&"!(LRECORD?1N.N1"$"1N.N))
- GOTO ADV
- +2 ; ERROR CODE
- SET X=+$PIECE(LRECORD,"$",2)
- +3 ;REQUEUE WITH NO BARCODE
- IF (X=-2)!(X=-5)!(X=-6)
- IF LRC=0
- IF +$PIECE(^LA(T,"O",LRCNT),"#",2)=+$PIECE(^(LRCNT),"$",2)-10000
- SET LRECORD=$PIECE($PIECE(^(LRCNT),"$",1)_","_$PIECE(^(LRCNT),",",2,255),"%",1)
- SET LRINST=T
- DO CSUM
- SET LRECORD=LRECORD_"%"_Y_"%"
- DO SEN
- DO ADV
- QUIT
- RETRY ;IF LRC<=3 NOT MAX RETRIES RESEND
- IF LRC'>3
- SET OUT=^(LRCNT)
- SET LRC=LRC+1
- QUIT
- +1 ;OTHERWISE (TOO MANY RETRIES ALREADY), WE GO ON BY DROPPING THROUGH
- ADV SET LRCNT=LRCNT+1
- IF $DATA(^(LRCNT))
- SET ^(0)=LRCNT
- SET OUT=^(LRCNT)
- SET LRC=0
- QUIT
- +1 IF '$DATA(^LA("LOCK",T))
- IF $DATA(^LAB(62.4,T,2))
- XECUTE ^(2)
- +2 QUIT
- PNM ;Get patient name and SSN from an accession.
- +1 SET X=^LRO(68,LRAA,1,LRAD,1,LRAN,0)
- SET X=^LR(+X,0)
- SET LRDPF=$PIECE(X,"^",2)
- +2 SET DFN=$PIECE(X,"^",3)
- DO PT^LRX
- +3 IF $DATA(AGE)
- IF AGE="??"
- SET AGE=""
- +4 QUIT
