1 | LAPMAXD ;SLC/DLG - PARAMAX BUILD DOWNLOAD FILE. ;7/20/90 10:01 ;
|
---|
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 | I '$D(^LA(LRINST,"O")) S T=LRINST D SETO^LASET
|
---|
8 | A S:$D(ZTQUEUED) ZTREQ="@" S:LRTRAY="A" LRTRAY=0
|
---|
9 | F LRTRAY=(LRTRAY1-.5):0 S LRTRAY=$O(^LRO(68.2,LRLL,1,LRTRAY)) Q:LRTRAY'>0 D TRAY S LRCUP=1
|
---|
10 | Q S LREND=0 L ^LA("Q") S Q=^LA("Q")+1,^("Q")=Q,^("Q",Q)=LRINST L Q
|
---|
11 | TRAY F LRCUP=(LRCUP1-1):0 S LRCUP=$O(^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP)) Q:LRCUP'>0 D SAMPLE
|
---|
12 | Q
|
---|
13 | 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
|
---|
14 | 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)
|
---|
15 | S LRECORD="#&6,"_SSN_","_PNM_","_AGE_",Y,"_SEX_","_LRPMD_","_LRWRD D CSUM S LRECORD=LRECORD_"%"_Y_"%" D SEN
|
---|
16 | D TEST Q:X']"" S LRECORD="#"_LRAN_"$"_(10000+LRAN)_X_"&5,"_SSN D CSUM S LRECORD=LRECORD_"%"_Y_"%" D SEN
|
---|
17 | Q
|
---|
18 | 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
|
---|
19 | S:$E(X,$L(X))="," X=$E(X,1,($L(X)-1)) Q
|
---|
20 | T2 Q:'$D(^TMP($J,LRTEST)) F I=0:0 S I=$O(^TMP($J,LRTEST,I)) Q:I'>0 S X=X_^(I)_","
|
---|
21 | Q
|
---|
22 | CSUM F I=0:0 Q:$E(LRECORD,$L(LRECORD))'="," S LRECORD=$E(LRECORD,1,$L(LRECORD)-1)
|
---|
23 | S Y=0 F I=1:1:$L(LRECORD) S Y=Y+$A(LRECORD,I)
|
---|
24 | S Y=Y#256,Y=$E("0123456789ABCDEF",(Y\16+1))_$E("0123456789ABCDEF",(Y#16+1)) Q
|
---|
25 | SEN S CNT=^LA(LRINST,"O")+1,^("O")=CNT,^("O",CNT)=LRECORD Q
|
---|
26 | 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
|
---|
27 | S LRECORD=$E(LRECORD,2,255) G:(LRECORD="&"!(LRECORD?1N.N1"$"1N.N)) ADV
|
---|
28 | S X=+$P(LRECORD,"$",2) ; ERROR CODE
|
---|
29 | 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
|
---|
30 | RETRY I LRC'>3 S OUT=^(LRCNT),LRC=LRC+1 Q ;IF LRC<=3 NOT MAX RETRIES RESEND
|
---|
31 | ;OTHERWISE (TOO MANY RETRIES ALREADY), WE GO ON BY DROPPING THROUGH
|
---|
32 | ADV S LRCNT=LRCNT+1 I $D(^(LRCNT)) S ^(0)=LRCNT,OUT=^(LRCNT),LRC=0 Q
|
---|
33 | I '$D(^LA("LOCK",T)),$D(^LAB(62.4,T,2)) X ^(2)
|
---|
34 | Q
|
---|
35 | PNM ;Get patient name and SSN from an accession.
|
---|
36 | S X=^LRO(68,LRAA,1,LRAD,1,LRAN,0),X=^LR(+X,0),LRDPF=$P(X,"^",2)
|
---|
37 | S DFN=$P(X,"^",3) D PT^LRX
|
---|
38 | I $D(AGE) S:AGE="??" AGE=""
|
---|
39 | Q
|
---|