- LAMIVTLG ;SLC/CJS/DAL/DRH - LAB AUTOMATED DATA ;7/20/90 08:28 ;
- ;;5.2;AUTOMATED LAB INSTRUMENTS;**1030**;NOV 01, 1997
- ;;5.2;AUTOMATED LAB INSTRUMENTS;**12**;Sep 27, 1994;Build 7
- ;Modified by Hoak for Vitek literal interface
- Q
- LOG S LINK="",LRDFN=0,DPF=2 I '$G(LOG) G LG2 ;Run by accession number.
- I LROVER S ISQN=+$O(^LAH(LWL,1,"C",+LOG,0)) Q:ISQN>0
- I '$D(^LRO(68,WL,1,LADT,1,LOG,0)) S LINK="^^"_+LOG G LG2
- S X=^(0),LINK=WL_U_LADT_U_LOG,LRDFN=+X,DPF=$P(X,U,2)
- 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)=""
- I $D(^LRO(68.2,LWL,1,+TRAY,1,+CUP,0)) S ^(4,ISQN)="" ;,^LAH(LWL,1,"E",+IDE,ISQN)=""
- Q
- ISQN ;
- L +^LAH(LWL)
- S (^LAH(LWL),ISQN)=1+$S($D(^LAH(+LWL))#2:^LAH(LWL),1:0)
- S:CUP="" TRAY=1,CUP=ISQN
- S ^LAH(LWL,1,ISQN,0)=TRAY_U_CUP_"^^^^^"_METH_"^"_+$G(IDE),^LAH(LWL,1,"B",(+TRAY)_";"_(+CUP),ISQN)=""
- ;
- S ^LAH(LWL,1,"E",+$G(IDE),ISQN)="" ;3/6/95 - LJA. Do-Dot Removed...
- ;
- L -^LAH(LWL)
- ;IDE XREF ADDED TO ENABLE CORRECT IDENTIFIER FOR CX4/CX5 INSTRUMENTS
- Q
- LLIST S LRDFN=0,DPF=2 I LROVER S ISQN=+$O(^LAH(LWL,1,"B",(+TRAY)_";"_(+CUP),0)) Q:ISQN>0
- D ISQN S LINK="^^" ;Run by load/work list number sent.
- I $D(^LRO(68.2,+LWL,1,+TRAY,1,+CUP,0)) S LINK=$P(^(0),"^",1,3),^(4,ISQN)=""
- S $P(^LAH(LWL,1,ISQN,0),U,3,5)=LINK
- S DPF=2 Q:LINK="^^" S WL=+$P(LINK,"^",1),WDT=+$P(LINK,"^",2),LOG=+$P(LINK,"^",3),^LAH(LWL,1,"C",LOG,ISQN)=""
- S X=$S($D(^LRO(68,+WL,1,+WDT,1,+LOG,0)):^(0),1:"0^2"),DPF=+$P(X,U,2),LRDFN=+X
- Q
- SEQN S CUP="" G LLIST ;Run by the order data receved
- CENUM S DPF=2,LRDFN=0,LOG=$O(^LRO(68,WL,1,DT,1,"D",+CENUM,0)) G LOG:LOG>0 ;for martinez only
- ;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
- D ISQN S ^LAH(LWL,1,"C",LOG,ISQN)="",^LAH(LWL,1,"D",+CENUM,ISQN)="",$P(^LAH(LWL,1,ISQN,0),U,6)=CENUM
- I $D(^LRO(68.2,+LWL,1,+TRAY,1,+CUP,0)) S ^(4,ISQN)=""
- Q
- IDENT S DPF=2,LRDFN=0,LOG=$O(^LRO(68,WL,1,DT,1,"C",IDENT,0)) G LOG:LOG>0
- D ISQN Q
- CONTROL ;VERIFY CONTROL'S
- Q:'$D(^LRO(68,+WL,1,DT,1,+LOG,0)) Q:$P(^(0),U,2)'=62.3
- 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
- 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)
- S:'$D(LRTEC) LRTEC=$P(^VA(200,DUZ,0),U,2)
- 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)=""
- D CONTXREF K:$D(LOG) ^LAH(LWL,1,"C",+LOG) K ^LAH(LWL,1,"B",(+TRAY)_";"_(+CUP)),^LAH(+LWL,1,ISQN) Q
- CEPACK S Y=$P(Y,"\",1),YY="" F I=1:1:$L(Y) S:$A(Y,I)>32 YY=YY_$E(Y,I)
- S Y=YY K YY Q
- CONTXREF ; Set up verification X-Ref for controls
- N DA,LRTEST,LRTN,I,LRGTN,X1,X,S1,J,J1
- 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
- AC ;
- K ^TMP("LR",$J,"T") D ^LREXPD
- 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)=""
- K ^TMP("LR",$J,"T")
- Q
- LAMIVTLG ;SLC/CJS/DAL/DRH - LAB AUTOMATED DATA ;7/20/90 08:28 ;
- +1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**1030**;NOV 01, 1997
- +2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**12**;Sep 27, 1994;Build 7
- +3 ;Modified by Hoak for Vitek literal interface
- +4 QUIT
- LOG ;Run by accession number.
- SET LINK=""
- SET LRDFN=0
- SET DPF=2
- IF '$GET(LOG)
- GOTO LG2
- +1 IF LROVER
- SET ISQN=+$ORDER(^LAH(LWL,1,"C",+LOG,0))
- IF ISQN>0
- QUIT
- +2 IF '$DATA(^LRO(68,WL,1,LADT,1,LOG,0))
- SET LINK="^^"_+LOG
- GOTO LG2
- +3 SET X=^(0)
- SET LINK=WL_U_LADT_U_LOG
- SET LRDFN=+X
- SET DPF=$PIECE(X,U,2)
- LG2 DO ISQN
- IF $GET(LOG)
- SET ^LAH(LWL,1,"C",LOG,ISQN)=""
- SET $PIECE(^LAH(LWL,1,ISQN,0),U,3,5)=LINK
- IF $GET(CENUM)
- SET $PIECE(^(0),U,6)=CENUM
- SET ^LAH(LWL,1,"D",+CENUM,ISQN)=""
- +1 ;,^LAH(LWL,1,"E",+IDE,ISQN)=""
- IF $DATA(^LRO(68.2,LWL,1,+TRAY,1,+CUP,0))
- SET ^(4,ISQN)=""
- +2 QUIT
- ISQN ;
- +1 LOCK +^LAH(LWL)
- +2 SET (^LAH(LWL),ISQN)=1+$SELECT($DATA(^LAH(+LWL))#2:^LAH(LWL),1:0)
- +3 IF CUP=""
- SET TRAY=1
- SET CUP=ISQN
- +4 SET ^LAH(LWL,1,ISQN,0)=TRAY_U_CUP_"^^^^^"_METH_"^"_+$GET(IDE)
- SET ^LAH(LWL,1,"B",(+TRAY)_";"_(+CUP),ISQN)=""
- +5 ;
- +6 ;3/6/95 - LJA. Do-Dot Removed...
- SET ^LAH(LWL,1,"E",+$GET(IDE),ISQN)=""
- +7 ;
- +8 LOCK -^LAH(LWL)
- +9 ;IDE XREF ADDED TO ENABLE CORRECT IDENTIFIER FOR CX4/CX5 INSTRUMENTS
- +10 QUIT
- LLIST SET LRDFN=0
- SET DPF=2
- IF LROVER
- SET ISQN=+$ORDER(^LAH(LWL,1,"B",(+TRAY)_";"_(+CUP),0))
- IF ISQN>0
- QUIT
- +1 ;Run by load/work list number sent.
- DO ISQN
- SET LINK="^^"
- +2 IF $DATA(^LRO(68.2,+LWL,1,+TRAY,1,+CUP,0))
- SET LINK=$PIECE(^(0),"^",1,3)
- SET ^(4,ISQN)=""
- +3 SET $PIECE(^LAH(LWL,1,ISQN,0),U,3,5)=LINK
- +4 SET DPF=2
- IF LINK="^^"
- QUIT
- SET WL=+$PIECE(LINK,"^",1)
- SET WDT=+$PIECE(LINK,"^",2)
- SET LOG=+$PIECE(LINK,"^",3)
- SET ^LAH(LWL,1,"C",LOG,ISQN)=""
- +5 SET X=$SELECT($DATA(^LRO(68,+WL,1,+WDT,1,+LOG,0)):^(0),1:"0^2")
- SET DPF=+$PIECE(X,U,2)
- SET LRDFN=+X
- +6 QUIT
- SEQN ;Run by the order data receved
- SET CUP=""
- GOTO LLIST
- CENUM ;for martinez only
- SET DPF=2
- SET LRDFN=0
- SET LOG=$ORDER(^LRO(68,WL,1,DT,1,"D",+CENUM,0))
- IF LOG>0
- GOTO LOG
- +1 ;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
- +2 DO ISQN
- SET ^LAH(LWL,1,"C",LOG,ISQN)=""
- SET ^LAH(LWL,1,"D",+CENUM,ISQN)=""
- SET $PIECE(^LAH(LWL,1,ISQN,0),U,6)=CENUM
- +3 IF $DATA(^LRO(68.2,+LWL,1,+TRAY,1,+CUP,0))
- SET ^(4,ISQN)=""
- +4 QUIT
- IDENT SET DPF=2
- SET LRDFN=0
- SET LOG=$ORDER(^LRO(68,WL,1,DT,1,"C",IDENT,0))
- IF LOG>0
- GOTO LOG
- +1 DO ISQN
- QUIT
- CONTROL ;VERIFY CONTROL'S
- +1 IF '$DATA(^LRO(68,+WL,1,DT,1,+LOG,0))
- QUIT
- IF $PIECE(^(0),U,2)'=62.3
- QUIT
- +2 SET LRDFN=+^(0)
- SET IDT=9999999-$SELECT($DATA(^(3)):^(3),1:0)
- IF '$DATA(^LR(LRDFN,"CH",IDT,0))
- QUIT
- SET $PIECE(^LRO(68,WL,1,DT,1,LOG,3),U,4)=NOW
- +3 SET $PIECE(^LR(LRDFN,"CH",IDT,0),U,3)=NOW
- FOR I=1:0
- SET I=$ORDER(^LAH(LWL,1,ISQN,I))
- IF I<1
- QUIT
- SET ^LR(LRDFN,"CH",IDT,I)=^LAH(LWL,1,ISQN,I)
- +4 IF '$DATA(LRTEC)
- SET LRTEC=$PIECE(^VA(200,DUZ,0),U,2)
- +5 FOR I=0:0
- SET I=$ORDER(^LRO(68,WL,1,DT,1,LOG,4,I))
- IF I<1
- QUIT
- IF +$PIECE(^(I,0),U,3)[LWL
- IF '$PIECE(^(0),U,5)
- SET $PIECE(^(0),U,5)=NOW
- SET $PIECE(^(0),U,4)=LRTEC
- SET ^LRO(68,WL,1,DT,1,"AC",NOW,LOG)=""
- SET ^LRO(68,WL,1,DT,1,"AD",NOW\1,LOG)=""
- +6 DO CONTXREF
- IF $DATA(LOG)
- KILL ^LAH(LWL,1,"C",+LOG)
- KILL ^LAH(LWL,1,"B",(+TRAY)_";"_(+CUP)),^LAH(+LWL,1,ISQN)
- QUIT
- CEPACK SET Y=$PIECE(Y,"\",1)
- SET YY=""
- FOR I=1:1:$LENGTH(Y)
- IF $ASCII(Y,I)>32
- SET YY=YY_$EXTRACT(Y,I)
- +1 SET Y=YY
- KILL YY
- QUIT
- CONTXREF ; Set up verification X-Ref for controls
- +1 NEW DA,LRTEST,LRTN,I,LRGTN,X1,X,S1,J,J1
- +2 SET LRTEST=""
- FOR LRTN=0:0
- SET LRTN=$ORDER(^LRO(68,WL,1,DT,1,LOG,4,LRTN))
- IF LRTN<1
- QUIT
- IF $DATA(^(LRTN,0))
- IF +$PIECE(^(0),U,3)[LWL
- IF +$PIECE(^(0),U,5)
- IF LRTEST'=""
- SET LRTEST=LRTEST_"^"_LRTN
- IF LRTEST=""
- SET LRTEST=LRTN
- AC ;
- +1 KILL ^TMP("LR",$JOB,"T")
- DO ^LREXPD
- +2 FOR X=0:0
- SET X=$ORDER(^TMP("LR",$JOB,"T",X))
- IF X<1
- QUIT
- SET X1=$PIECE(^(X),";",2)
- IF X1
- IF $DATA(^LR($GET(LRDFN),"CH",$GET(IDT),$GET(X1)))
- IF '$DATA(^LRO(68,"AC",LRDFN,IDT,X1))
- SET ^(X1)=""
- +3 KILL ^TMP("LR",$JOB,"T")
- +4 QUIT
