| 1 | LRMILL ;SLC/DLG - BUILD LOAD LIST FOR MICROSCAN ;4/4/89 21:38 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;;Sep 27, 1994
|
|---|
| 3 | INSERT ;Add a sample to next cup
|
|---|
| 4 | D LRINST G END:LRINST<1,END:LRDAA<1 W !,"Select only from the ",$P(^LRO(68,LRDAA,0),U)," accession area"
|
|---|
| 5 | 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
|
|---|
| 6 | IN2 D SHOW D WHATEST G IN7:'$D(X),FINISH:X=U
|
|---|
| 7 | IN5 X LRTRANS I '$D(^LRO(68.2,LRINST,1,LRTRAY,1,0)) S ^(0)="^68.22PA^^"
|
|---|
| 8 | D SETONE W !!," >> ADDED <<"
|
|---|
| 9 | 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
|
|---|
| 10 | I LRAN["?" W !,"Enter just the number part of the accession" G IN7
|
|---|
| 11 | W !,$C(7),"This accesion doesn't exist" G IN7
|
|---|
| 12 | Q
|
|---|
| 13 | NOPE W !," OPERATION NOT COMPLETE" ;Drop thru finish
|
|---|
| 14 | FINISH L +^LRO(68.2,LRINST) S ^LRO(68.2,LRINST,3)=0,$P(^(2),U,4,5)=LRTRAY_U_LRCUP L -^LRO(68.2,LRINST)
|
|---|
| 15 | 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
|
|---|
| 16 | K AGE,DFN,DOB,K,PNM,SEX,T,D,G,LRAN,LREXEC,LRLLOC,SSN,X9
|
|---|
| 17 | Q
|
|---|
| 18 | LRINST ;Get loadlist data
|
|---|
| 19 | S U="^" D DT^LRX S LRAD=DT K ^TMP("LR",$J,"T"),DIC,LRHOLD,LRTSTS
|
|---|
| 20 | S DIC="^LRO(68.2,",DIC(0)="AEMZ" D ^DIC S LRINST=+Y Q:Y<1 L +^LRO(68.2,LRINST,3)
|
|---|
| 21 | 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 -^LRO(68.2,LRINST,3) Q
|
|---|
| 22 | S $P(^LRO(68.2,LRINST,3),U,1)=1 L -^LRO(68.2,LRINST,3)
|
|---|
| 23 | 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)
|
|---|
| 24 | 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")
|
|---|
| 25 | 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)
|
|---|
| 26 | S ^LRO(68.2,LRINST,1,0)="^68.21^"_LRTRAY_U_LRTRAY,^(LRTRAY,0)=LRTRAY_U_DT_U_DUZ_U_LRDAA
|
|---|
| 27 | Q
|
|---|
| 28 | SETONE ;Set tests into cup and update accession
|
|---|
| 29 | S ^LRO(68.2,LRINST,1,LRTRAY,1,LRCUP,0)=LRAA_U_LRAD_U_LRAN_U_LRWPROF_U_LRSPEC
|
|---|
| 30 | F I=0:0 S I=$O(X(I)) Q:I="" S LRIX=G2(I),LRTX=G2(I,0) D MV2
|
|---|
| 31 | S DA=LRCUP,DA(1)=LRTRAY,DA(2)=LRINST,DR="5",DIE="^LRO(68.2,LRINST,1,LRTRAY,1," D ^DIE
|
|---|
| 32 | Q
|
|---|
| 33 | 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
|
|---|
| 34 | Q
|
|---|
| 35 | WHATEST ;
|
|---|
| 36 | S LRSPEC=$S($D(^LRO(68,LRAA,1,LRAD,1,LRAN,5,1,0)):+^(0),1:"")
|
|---|
| 37 | 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)
|
|---|
| 38 | I G2<1 W !,"NO TESTS FREE TO ADD" K G2 Q
|
|---|
| 39 | S G4="$P(^LAB(60,+G2(I,0),0),U,1)",G1="What test(s) to add?" D GROUP^LRWU2
|
|---|
| 40 | Q
|
|---|
| 41 | SHOW ;Show the patient
|
|---|
| 42 | S LRDFN=$S($D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)):+^(0),1:-1) Q:LRDFN<1 S X=^LR(LRDFN,0)
|
|---|
| 43 | S LRDPF=$P(X,U,2),DFN=$P(X,U,3) D PT^LRX W !,PNM,?40,SSN Q
|
|---|
| 44 | Q
|
|---|
