source: FOIAVistA/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LAMILL.m@ 1094

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