| [613] | 1 | LAHTCCAD ;SLC/DLG - HITATCHI 717 THRU CCA SYSTEM BUILD DOWNLOAD FILE. ;7/20/90 09:17 ;
|
|---|
| 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="@" S T=LRINST S:'$D(^LA(T,"O")) ^("O")=0,^("O",0)=0
|
|---|
| 8 | S (BLKN,BLK)="" F I=1:1:34 S BLK=BLK_" ",BLKN=BLKN_"0"
|
|---|
| 9 | A 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
|
|---|
| 10 | S LREND=0,LRECORD=$C(4) D SEND Q
|
|---|
| 11 | TRAY F LRCUP=(LRCUP1-1):0 S LRCUP=$O(^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP)) Q:LRCUP'>0 D SAMPLE S LRECORD=""
|
|---|
| 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),X=^LRO(68,LRAA,1,LRAD,1,LRAN,0),LADOC=$P(X,"^",8),X=^LR(+X,0) I $P(X,"^",2)=2 S LRDPF=2,DFN=$P(X,"^",3) D PT^LRX,TEST
|
|---|
| 14 | S PNM=$E(PNM,1,20) S:$D(SSN) SSN="000000"_$E(SSN,1,3)_$E(SSN,5,6)_$E(SSN,8,11) S DOB=$E(DOB,4,5)_$E(DOB,6,7)_$E(DOB,2,3) S X=LADOC D:X]"" DOC^LRX S LADOC=Y S:LADOC="" LADOC="UNKNOWN" S:$L(LADOC)>20 LADOC=$E(LADOC,1,20)
|
|---|
| 15 | S LRAN1=$E(LRAD,4,5)_$E(LRAD,6,7)_$E(100000+LRAN,2,6),LRWRD=$E(LRWRD,1,10)
|
|---|
| 16 | S LRECORD=$C(2)_"O"_SSN_$E(BLK,1,(20-$L(PNM)))_PNM_$E(BLK,1,(10-$L(LRWRD)))_LRWRD_$E(10000+AGE,2,5)_"Y"_SEX_DOB_$E(BLK,1,(20-$L(LADOC)))_LADOC_$E(1000000000+LRAN1,2,10)_X_$C(3) D CSUM S LRECORD=LRECORD_CSUM
|
|---|
| 17 | SEND L ^LA(LRINST,"O") S Q=^LA(LRINST,"O")+1,^("O")=Q,^("O",Q)=LRECORD L Q
|
|---|
| 18 | TEST S X="" F I=1:1:68 S X=X_"0"
|
|---|
| 19 | F LRTEST=0:0 S LRTEST=$O(^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP,1,LRTEST)) Q:LRTEST'>0 D T2
|
|---|
| 20 | Q
|
|---|
| 21 | T2 Q:'$D(^TMP($J,LRTEST))
|
|---|
| 22 | F I=0:0 S I=$O(^TMP($J,LRTEST,I)) Q:I'>0 S Y=^(I),Y1=0 S:$L(Y)>2 Y1=$E(Y),Y=$E(Y,2,3) I Y<35 D T3
|
|---|
| 23 | Q
|
|---|
| 24 | T3 S:Y1=0 X=$E(X,1,(Y-1))_"1"_$E(X,(Y+1),68),X=$E(X,1,(Y+33))_"1"_$E(X,(Y+35),68) S:Y1=1 X=$E(X,1,(Y-1))_"1"_$E(X,(Y+1),68) S:Y1=2 X=$E(X,1,(Y+33))_"1"_$E(X,(Y+35),68)
|
|---|
| 25 | Q
|
|---|
| 26 | CSUM S CSUM=0 F I=2:1:($L(LRECORD)-1) S CSUM=CSUM+$A(LRECORD,I)
|
|---|
| 27 | S CSUM=$E(1000+(CSUM#256),2,4) Q
|
|---|
