43 lines
1.2 KiB
Mathematica
43 lines
1.2 KiB
Mathematica
LAKDIFF3 ;DALOI/DLG - LAB ROUTINE DATA VERIFICATION BY WORKLIST OF KEYBOARD DIFFS ; 7/28/88 10:01 AM
|
|
;;5.2;AUTOMATED LAB INSTRUMENTS;**52,60**;Sep 27, 1994
|
|
;
|
|
N B,LRCUP,LRORU3,LRPANEL,LRPROF,LRSQ,LRTM60,LRTRAY,LRTSE,LRTYPE,X,Y
|
|
;
|
|
S LREND=0,LRLL=LWL,LRTYPE=$P(^LRO(68.2,LRLL,0),U,3)
|
|
;
|
|
S LRPROF=$O(^LRO(68.2,LRLL,10,0))
|
|
I LRPROF<1 W !,"No profile defined." Q
|
|
S B=$O(^LRO(68.2,LRLL,10,LRPROF))
|
|
I B>0 D Q:LREND
|
|
. N DIC,X,Y
|
|
. S DIC(0)="AEQ",DIC="^LRO(68.2,"_LRLL_",10,"
|
|
. D ^DIC
|
|
. I Y<1 S LREND=1 Q
|
|
. S LRPROF=+Y
|
|
;
|
|
S X=^LRO(68.2,LRLL,10,LRPROF,0),LRPANEL=$P(X,U,1)
|
|
;
|
|
I $P(^LRO(68,LRAA,0),U,2)'="CH" S LREND=1 Q
|
|
;
|
|
K LRORD,LRVTS,LRTSTS
|
|
D EXPLODE^LRGP2
|
|
I '$O(LRVTS(0)) S LREND=1 Q
|
|
;
|
|
S I=0
|
|
F S I=$O(LRORD(I)) Q:I<1 S J=LRORD(I),X=$P(^LAB(60,J,0),U,5),LRORD(I)=$P(X,";",2)
|
|
;
|
|
K LRTEST,C5,LRSET,LRLDT,DIC,LRNM,LRNG,LRDEL,T,LRFP,LRAB,LRVER,Y,Z
|
|
;
|
|
S LRTM60=9999999-$$HTFM^XLFDT($H-$P($G(^LAB(69.9,1,0)),U,7),1)
|
|
S LRTRAY=TRAY,LRCUP=CUP,LRSQ=ISQN,LRTSE=-1
|
|
S X=^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRODT=$P(X,U,4),LRSN=$P(X,U,5)
|
|
S LRORU3=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3))
|
|
;
|
|
W !,PNM,?40,SSN
|
|
;
|
|
D VER^LRVR1
|
|
;
|
|
I 'LREND,$G(LRAA),$G(LRAD),$G(LRAN) S $P(^LRO(68,LRAA,1,LRAD,2),"^",4)=$G(LRAN)
|
|
;
|
|
Q
|