| [613] | 1 | LAMIVTLG ;SLC/CJS/DAL/DRH - LAB AUTOMATED DATA ;7/20/90 08:28 ;
|
|---|
| 2 | ;;5.2;AUTOMATED LAB INSTRUMENTS;**12**;Sep 27, 1994
|
|---|
| 3 | ;Modified by Hoak for Vitek literal interface
|
|---|
| 4 | Q
|
|---|
| 5 | LOG S LINK="",LRDFN=0,DPF=2 I '$G(LOG) G LG2 ;Run by accession number.
|
|---|
| 6 | I LROVER S ISQN=+$O(^LAH(LWL,1,"C",+LOG,0)) Q:ISQN>0
|
|---|
| 7 | I '$D(^LRO(68,WL,1,LADT,1,LOG,0)) S LINK="^^"_+LOG G LG2
|
|---|
| 8 | S X=^(0),LINK=WL_U_LADT_U_LOG,LRDFN=+X,DPF=$P(X,U,2)
|
|---|
| 9 | LG2 D ISQN S:$G(LOG) ^LAH(LWL,1,"C",LOG,ISQN)="",$P(^LAH(LWL,1,ISQN,0),U,3,5)=LINK S:$G(CENUM) $P(^(0),U,6)=CENUM,^LAH(LWL,1,"D",+CENUM,ISQN)=""
|
|---|
| 10 | I $D(^LRO(68.2,LWL,1,+TRAY,1,+CUP,0)) S ^(4,ISQN)="" ;,^LAH(LWL,1,"E",+IDE,ISQN)=""
|
|---|
| 11 | Q
|
|---|
| 12 | ISQN ;
|
|---|
| 13 | L +^LAH(LWL)
|
|---|
| 14 | S (^LAH(LWL),ISQN)=1+$S($D(^LAH(+LWL))#2:^LAH(LWL),1:0)
|
|---|
| 15 | S:CUP="" TRAY=1,CUP=ISQN
|
|---|
| 16 | S ^LAH(LWL,1,ISQN,0)=TRAY_U_CUP_"^^^^^"_METH_"^"_+$G(IDE),^LAH(LWL,1,"B",(+TRAY)_";"_(+CUP),ISQN)=""
|
|---|
| 17 | ;
|
|---|
| 18 | S ^LAH(LWL,1,"E",+$G(IDE),ISQN)="" ;3/6/95 - LJA. Do-Dot Removed...
|
|---|
| 19 | ;
|
|---|
| 20 | L -^LAH(LWL)
|
|---|
| 21 | ;IDE XREF ADDED TO ENABLE CORRECT IDENTIFIER FOR CX4/CX5 INSTRUMENTS
|
|---|
| 22 | Q
|
|---|
| 23 | LLIST S LRDFN=0,DPF=2 I LROVER S ISQN=+$O(^LAH(LWL,1,"B",(+TRAY)_";"_(+CUP),0)) Q:ISQN>0
|
|---|
| 24 | D ISQN S LINK="^^" ;Run by load/work list number sent.
|
|---|
| 25 | I $D(^LRO(68.2,+LWL,1,+TRAY,1,+CUP,0)) S LINK=$P(^(0),"^",1,3),^(4,ISQN)=""
|
|---|
| 26 | S $P(^LAH(LWL,1,ISQN,0),U,3,5)=LINK
|
|---|
| 27 | S DPF=2 Q:LINK="^^" S WL=+$P(LINK,"^",1),WDT=+$P(LINK,"^",2),LOG=+$P(LINK,"^",3),^LAH(LWL,1,"C",LOG,ISQN)=""
|
|---|
| 28 | S X=$S($D(^LRO(68,+WL,1,+WDT,1,+LOG,0)):^(0),1:"0^2"),DPF=+$P(X,U,2),LRDFN=+X
|
|---|
| 29 | Q
|
|---|
| 30 | SEQN S CUP="" G LLIST ;Run by the order data receved
|
|---|
| 31 | CENUM S DPF=2,LRDFN=0,LOG=$O(^LRO(68,WL,1,DT,1,"D",+CENUM,0)) G LOG:LOG>0 ;for martinez only
|
|---|
| 32 | ;IF CENUM?1A.ANP S Y=CENUM D CEPACK I Y?.ANP S DFN=$O(^LAB(62.3,"B",Y,0)) I DFN S DPF=62.3
|
|---|
| 33 | D ISQN S ^LAH(LWL,1,"C",LOG,ISQN)="",^LAH(LWL,1,"D",+CENUM,ISQN)="",$P(^LAH(LWL,1,ISQN,0),U,6)=CENUM
|
|---|
| 34 | I $D(^LRO(68.2,+LWL,1,+TRAY,1,+CUP,0)) S ^(4,ISQN)=""
|
|---|
| 35 | Q
|
|---|
| 36 | IDENT S DPF=2,LRDFN=0,LOG=$O(^LRO(68,WL,1,DT,1,"C",IDENT,0)) G LOG:LOG>0
|
|---|
| 37 | D ISQN Q
|
|---|
| 38 | CONTROL ;VERIFY CONTROL'S
|
|---|
| 39 | Q:'$D(^LRO(68,+WL,1,DT,1,+LOG,0)) Q:$P(^(0),U,2)'=62.3
|
|---|
| 40 | S LRDFN=+^(0),IDT=9999999-$S($D(^(3)):^(3),1:0) Q:'$D(^LR(LRDFN,"CH",IDT,0)) S $P(^LRO(68,WL,1,DT,1,LOG,3),U,4)=NOW
|
|---|
| 41 | S $P(^LR(LRDFN,"CH",IDT,0),U,3)=NOW F I=1:0 S I=$O(^LAH(LWL,1,ISQN,I)) Q:I<1 S ^LR(LRDFN,"CH",IDT,I)=^LAH(LWL,1,ISQN,I)
|
|---|
| 42 | S:'$D(LRTEC) LRTEC=$P(^VA(200,DUZ,0),U,2)
|
|---|
| 43 | F I=0:0 S I=$O(^LRO(68,WL,1,DT,1,LOG,4,I)) Q:I<1 I +$P(^(I,0),U,3)[LWL,'$P(^(0),U,5) S $P(^(0),U,5)=NOW,$P(^(0),U,4)=LRTEC,^LRO(68,WL,1,DT,1,"AC",NOW,LOG)="",^LRO(68,WL,1,DT,1,"AD",NOW\1,LOG)=""
|
|---|
| 44 | D CONTXREF K:$D(LOG) ^LAH(LWL,1,"C",+LOG) K ^LAH(LWL,1,"B",(+TRAY)_";"_(+CUP)),^LAH(+LWL,1,ISQN) Q
|
|---|
| 45 | CEPACK S Y=$P(Y,"\",1),YY="" F I=1:1:$L(Y) S:$A(Y,I)>32 YY=YY_$E(Y,I)
|
|---|
| 46 | S Y=YY K YY Q
|
|---|
| 47 | CONTXREF ; Set up verification X-Ref for controls
|
|---|
| 48 | N DA,LRTEST,LRTN,I,LRGTN,X1,X,S1,J,J1
|
|---|
| 49 | S LRTEST="" F LRTN=0:0 S LRTN=$O(^LRO(68,WL,1,DT,1,LOG,4,LRTN)) Q:LRTN<1 I $D(^(LRTN,0)),+$P(^(0),U,3)[LWL,+$P(^(0),U,5) S:LRTEST'="" LRTEST=LRTEST_"^"_LRTN S:LRTEST="" LRTEST=LRTN
|
|---|
| 50 | AC ;
|
|---|
| 51 | K ^TMP("LR",$J,"T") D ^LREXPD
|
|---|
| 52 | F X=0:0 S X=$O(^TMP("LR",$J,"T",X)) Q:X<1 S X1=$P(^(X),";",2) I X1,$D(^LR($G(LRDFN),"CH",$G(IDT),$G(X1))) S:'$D(^LRO(68,"AC",LRDFN,IDT,X1)) ^(X1)=""
|
|---|
| 53 | K ^TMP("LR",$J,"T")
|
|---|
| 54 | Q
|
|---|
