45 lines
2.8 KiB
Mathematica
45 lines
2.8 KiB
Mathematica
LAMILL ;SLC/DLG - BUILD LOAD LIST FOR MICROSCAN ;7/20/90 09:36 ;
|
|
;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
|
|
INSERT ;Add a sample to next cup
|
|
D LRINST G END:LRINST<1,END:LRDAA<1 W !,"Select only from the ",$P(^LRO(68,LRDAA,0),U)," accession area"
|
|
S LRACC=1 D ^LRWU4 K LRACC G FINISH:LRAN<1 I LRDAA'=LRAA W !,"Sorry but this accession is in the wrong group" G IN2
|
|
IN2 D SHOW D WHATEST G IN7:'$D(X),FINISH:X=U
|
|
IN5 X LRTRANS I '$D(^LRO(68.2,LRINST,1,LRTRAY,1,0)) S ^(0)="^68.22PA^^"
|
|
D SETONE W !!," >> ADDED <<"
|
|
IN7 R !!,"Next Accession NUMBER: ",LRAN:DTIME G FINISH:'$T!(LRAN["^")!(LRAN'>0) I $D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) G IN2
|
|
I LRAN["?" W !,"Enter just the number part of the accession" G IN7
|
|
W !,$C(7),"This accesion doesn't exist" G IN7
|
|
Q
|
|
NOPE W !," OPERATION NOT COMPLETE" ;Drop thru finish
|
|
FINISH L ^LRO(68.2,LRINST) S ^LRO(68.2,LRINST,3)=0,$P(^(2),U,4,5)=LRTRAY_U_LRCUP
|
|
END K A,DIC,I,LRDAA,LRFULL,LRDFN,LRDPF,LRFULL,LRIX,LRTSTS,LRTX,LRWPROF,LRWRD,LRINSTIT,LRMAXCUP,LRTRANS,LRTYPE,X,Y,Z,LRINST,%,LRPROF,LRTRAY,LRCUP,LRAA,LRAD
|
|
K AGE,DFN,DOB,K,PNM,SEX,T,D,G,LRAN,LREXEC,LRLLOC,SSN,X9
|
|
Q
|
|
LRINST ;Get loadlist data
|
|
S U="^" D DT^LRX S LRAD=DT K ^TMP("LR",$J,"T"),DIC,LRHOLD,LRTSTS
|
|
S DIC="^LRO(68.2,",DIC(0)="AEMZ" D ^DIC S LRINST=+Y Q:Y<1 L ^LRO(68.2,LRINST,3)
|
|
I $S($D(^LRO(68.2,LRINST,3)):$P(^(3),U,1),1:0) W !,"Load list is busy now, Please try later." S LRINST=-1 L Q
|
|
S $P(^LRO(68.2,LRINST,3),U,1)=1 L
|
|
S LRTRANS=+$P(Y(0),U,2),LRTYPE=+$P(Y(0),U,3),LRFULL=$P(Y(0),U,5),LRINSTIT=+$P(Y(0),U,7),LRMAXCUP=+$P(Y(0),U,4),Y(2)=$S($D(^LRO(68.2,LRINST,2)):^(2),1:""),LRTRAY=+$P(Y(2),U,4),LRCUP=+$P(Y(2),U,5)
|
|
S LRTRANS=$S($D(^LAB(62.07,LRTRANS,.1)):^(.1),1:"S LRCUP=LRCUP+1"),LRINSTIT=$S($D(^LAB(62.07,LRINSTIT,.1)):^(.1),1:"Q")
|
|
S:'LRTYPE LRTRAY=1 S LRWPROF=+$O(^LRO(68.2,LRINST,10,0)),LRDAA=$S($D(^LRO(68.2,LRINST,10,LRWPROF,0)):$P(^(0),U,2),1:0)
|
|
S ^LRO(68.2,LRINST,1,0)="^68.21^"_LRTRAY_U_LRTRAY,^(LRTRAY,0)=LRTRAY_U_DT_U_DUZ_U_LRDAA
|
|
Q
|
|
SETONE ;Set tests into cup and update accession
|
|
S ^LRO(68.2,LRINST,1,LRTRAY,1,LRCUP,0)=LRAA_U_LRAD_U_LRAN_U_LRWPROF_U_LRSPEC
|
|
F I=0:0 S I=$O(X(I)) Q:I="" S LRIX=G2(I),LRTX=G2(I,0) D MV2
|
|
K DR,DIE S DA=LRCUP,DA(1)=LRTRAY,DA(2)=LRINST,DR="5//^S X=1",DR(2,68.225)="1//^S X=1",DIE="^LRO(68.2,LRINST,1,LRTRAY,1," D ^DIE
|
|
Q
|
|
MV2 S ^LRO(68.2,LRINST,1,LRTRAY,1,LRCUP,1,LRIX,0)=LRTX,$P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRIX,0),U,3)=LRINST_";"_LRTRAY_";"_LRCUP
|
|
Q
|
|
WHATEST ;
|
|
S LRSPEC=$S($D(^LRO(68,LRAA,1,LRAD,1,LRAN,5,1,0)):+^(0),1:"")
|
|
K X,G2 S G2=0 F I=0:0 S I=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,I)) Q:I<1 I +^(I,0),'$P(^(0),U,3) S G2=G2+1,G2(G2)=I,G2(G2,0)=+^(0)
|
|
I G2<1 W !,"NO TESTS FREE TO ADD" K G2 Q
|
|
S G4="$P(^LAB(60,+G2(I,0),0),U,1)",G1="What test(s) to add?" D GROUP^LRWU2
|
|
Q
|
|
SHOW ;Show the patient
|
|
S LRDFN=$S($D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)):+^(0),1:-1) Q:LRDFN<1 S X=^LR(LRDFN,0)
|
|
S LRDPF=$P(X,U,2),DFN=$P(X,U,3) D PT^LRX W !,PNM,?40,SSN Q
|
|
Q
|