| [613] | 1 | LADIMD ;SLC/DLG - DIMINESION BUILD DOWNLOAD FILE. ;10/17/90 12:51 ;
|
|---|
| 2 | ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
|
|---|
| 3 | ;Call with LRLL = load list to build
|
|---|
| 4 | ;Call with LRTRAY1 = Starting tray number
|
|---|
| 5 | ;Call with LRLL = Auto Instrument pointer
|
|---|
| 6 | ;Call with LRFORCE=1 if send tray and cup.
|
|---|
| 7 | S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 8 | I $D(^LA(LRINST,"C")),(^LA(LRINST,"C")=^LA(LRINST,"C",0)) K ^LA(LRINST,"C")
|
|---|
| 9 | I '$D(^LA(LRINST,"C")) D SETC
|
|---|
| 10 | A S F=$O(^LAB(61,"B","CSF",0)),X=^LAB(69.9,1,1),LRFLUID=$P(X,"^",3,4)_"^"_$P(X,"^",2)_"^"_F,FS=$C(28)
|
|---|
| 11 | ;S LRURG="" F I="ROUTINE","STAT","ASAP" S LRURG=LRURG_$O(^LAB(62.05,"B",I,0))
|
|---|
| 12 | S LRURG="" F I="ROUTINE","EMERGENCY","OUTPATIENT" S LRURG=LRURG_$O(^LAB(62.05,"B",I,0))
|
|---|
| 13 | F LRTRAY=LRTRAY1:0 D:$D(^LRO(68.2,LRLL,1,LRTRAY)) TRAY S LRTRAY=$O(^LRO(68.2,LRLL,1,LRTRAY)),LRCUP1=1 Q:LRTRAY'>0
|
|---|
| 14 | S LREND="" Q
|
|---|
| 15 | TRAY F LRCUP=(LRCUP1-1):0 S LRCUP=$O(^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP)) Q:LRCUP'>0 D SAMPLE S LRECORD=""
|
|---|
| 16 | Q
|
|---|
| 17 | SAMPLE S LRL=^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP,0),LRAA=+LRL,LRAD=$P(LRL,"^",2),LRAN=$P(LRL,"^",3) D PNM
|
|---|
| 18 | S F=$P(LRL,"^",5),F=$S($P(LRFLUID,"^",1)=F:1,$P(LRFLUID,"^",3)=F:3,$P(LRFLUID,"^",2)=F:2,$P(LRFLUID,"^",4)=F:4,1:0) ; not 4 fluids don't send
|
|---|
| 19 | I 'F W:'$D(ZTQUEUED) !,"Accession not correct collection sample: ",LRACC Q
|
|---|
| 20 | D TEST S LRECORD=$C(2)_"D"_FS_"0"_FS_"0"_FS_"A"_FS_$E(SSN_" "_$P(PNM,","),1,27)_FS_LRAN_FS_F_FS_FS_LRPRIO_FS_"1"_FS_"0"_FS_"1"_FS_LRTN_FS
|
|---|
| 21 | F I=1:1:LRTN S LRECORD=LRECORD_X(I) I I'=LRTN,((9+$L(LRECORD))>255) D OUT
|
|---|
| 22 | S LRECORD=LRECORD_"%^%" D OUT Q
|
|---|
| 23 | TEST K X S LRTN=0 F LRTEST=0:0 S LRTEST=$O(^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP,1,LRTEST)) Q:LRTEST'>0 S LRPRIO=$P(^(LRTEST,0),"^",2),LRPRIO=$F(LRURG,LRPRIO)-2 S:LRPRIO<0 LRPRIO=0 D T2
|
|---|
| 24 | Q
|
|---|
| 25 | T2 Q:'$D(^TMP($J,LRTEST)) F I=0:0 S I=$O(^TMP($J,LRTEST,I)) Q:I'>0 S Y=^(I) S LRTN=LRTN+1,X(LRTN)=Y_FS
|
|---|
| 26 | Q
|
|---|
| 27 | PNM ;Get patient name and last 4 from an accession.
|
|---|
| 28 | S PNM="" Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) S X=^(0),LRACC=^(.2),X=^LR(+X,0) I $P(X,"^",2)=2 S DFN=$P(X,"^",3) D PT^LRX S SSN=$E(SSN,1,3)_$E(SSN,5,6)_$E(SSN,8,11)
|
|---|
| 29 | Q
|
|---|
| 30 | OUT S Q=^LA(LRINST,"C")+1,^("C")=Q,^("C",Q)=LRECORD,LRECORD="" Q
|
|---|
| 31 | SETC L ^LA(LRINST) S ^LA(LRINST,"C")=0,^("C",0)=0 L Q
|
|---|
