| [613] | 1 | LAMIAUT8 ;FHS/SLC - ADD OR DELETE FROM VITEK LOAD LIST ;7/20/90 09:35
|
|---|
| 2 | ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
|
|---|
| 3 | ADD ;
|
|---|
| 4 | I '$D(^LRO(68,LRAA,1,LRAD,1,X,0)) W !,$C(7),"THIS IS NOT A VALID ACCESSION NUMBER " Q
|
|---|
| 5 | S ^TMP("LR",$J,"T",X)=+^(0)_U_+(^(5,1,0)) W !," <<< ADDED >>> ",! Q
|
|---|
| 6 | Q
|
|---|
| 7 | DELETE ;
|
|---|
| 8 | I '$D(^TMP("LR",$J,"T",X)) W !,$C(7),"THIS NUMBER IS NOT ON THE LIST " Q
|
|---|
| 9 | K ^TMP("LR",$J,"T",X) W !," <<< DELETED >>> ",! Q
|
|---|
| 10 | Q
|
|---|
| 11 | STUFF ;
|
|---|
| 12 | S LRAA=$S(LRALL:$P(^LRO(68.2,LRINST,10,+$O(^LRO(68.2,LRINST,10,0)),0),U,2),1:$P(^LRO(68.2,LRINST,10,LRPROF,0),U,2))
|
|---|
| 13 | S:'$D(^LRO(68.2,LRINST,1,0)) ^(0)="^68.21^"
|
|---|
| 14 | F LRAN=0:0 S LRAN=$O(^TMP("LR",$J,"T",LRAN)) Q:LRAN<1 S LRSPEC=$P(^(LRAN),U,2) D STUFF1 I $O(X(0)) D STUFF3
|
|---|
| 15 | S $P(^LRO(68.2,LRINST,2),U,4)=LRTRAY,$P(^(2),U,5)=LRCUP,$P(^(2),U)=DT
|
|---|
| 16 | Q
|
|---|
| 17 | STUFF1 ;
|
|---|
| 18 | K X F AA=0:0 S AA=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,AA)) Q:AA<1 I $D(^(AA,0)) S LRURG=$S($P(^(0),U,2):$P(^(0),U,2),1:9) I $D(LRTP(AA)) D STUFF2
|
|---|
| 19 | Q
|
|---|
| 20 | STUFF2 ;
|
|---|
| 21 | I LRTP(AA) Q:LRSPEC=LRTP(AA)
|
|---|
| 22 | S X(AA)=AA_U_LRURG,X(AA,$O(LRTP(AA,0)))="" Q
|
|---|
| 23 | STUFF3 ;
|
|---|
| 24 | X LRTRANS I '$D(^LRO(68.2,LRINST,1,LRTRAY,0)) S ^(0)=LRTRAY_U_DT_U_DUZ_U_LRAA,$P(^LRO(68.2,LRINST,1,0),U,3)=LRTRAY,$P(^(0),U,4)=$P(^(0),U,4)+1 W !,"B"
|
|---|
| 25 | S:'$D(^LRO(68.2,LRINST,1,LRTRAY,1,0)) ^(0)="^68.22PA^1^1"
|
|---|
| 26 | I '$D(^LRO(68.2,LRINST,1,LRTRAY,1,LRCUP,1,0)) S ^(0)="^68.222^" W "."
|
|---|
| 27 | S ^LRO(68.2,LRINST,1,LRTRAY,1,LRCUP,0)=LRAA_U_LRAD_U_LRAN_U_$O(LRTP($O(X(0)),0))_U_LRSPEC
|
|---|
| 28 | F X=0:0 S X=$O(X(X)) Q:X="" S ^LRO(68.2,LRINST,1,LRTRAY,1,LRCUP,1,X,0)=X(X),$P(^LRO(68.2,LRINST,1,LRTRAY,1,LRCUP,1,0),U,3)=X,$P(^(0),U,4)=$P(^(0),U,4)+1 D LRO
|
|---|
| 29 | Q
|
|---|
| 30 | LRO S $P(^LRO(68,LRAA,1,LRAD,1,LRAN,1,4,X,0),U,3)=LRINST_";"_LRTRAY_";"_LRCUP Q
|
|---|
| 31 | Q
|
|---|
| 32 | PROF ;
|
|---|
| 33 | S LRAA=$S($D(^LRO(68.2,LRINST,10,1,0)):+$P(^(0),U,2),1:0) I 'LRAA W !!?10,"NO ACCESSION AREA ASSIGNED " S LREND=1 Q
|
|---|
| 34 | S Y(0)=^LRO(68,LRAA,0) I $P(Y(0),U,14) S LRP=14 D ACCESS I LREND W !!?10,"Access denied to this Accession Area." Q
|
|---|
| 35 | F I=0:0 S I=$O(^LRO(68.2,LRINST,10,LRPROF,1,I)) Q:I<1 I $D(^(I,0)) S LRTP(+^(0))=$P(^(0),U,2),LRTP(+^(0),LRPROF)=""
|
|---|
| 36 | F T=0:0 S T=$O(^LRO(68.2,LRINST,10,LRPROF,2,T)) Q:T<1 F C=0:0 S C=$O(^LRO(68.2,LRINST,10,LRPROF,2,T,1,C)) Q:C<1 S LRCT=^(C,0) D CTRLTST S LRCTRL(T,C)=X
|
|---|
| 37 | F I=0:0 S I=$O(^LRO(68.2,LRINST,10,LRPROF,3,I)) Q:I<1 S LRDSPEC(+^(I,0))=""
|
|---|
| 38 | Q
|
|---|
| 39 | CTRLTST ;from LRLL1, LRLL2
|
|---|
| 40 | S X=LRCT_U F J=0:0 S J=$O(^LAB(62.3,LRCT,2,J)) Q:J<1 S Y=+^(J,0) S:$D(^LRO(68.2,LRINST,10,LRPROF,1,"B",+Y)) X=X_+Y_U
|
|---|
| 41 | I '$P(X,U,2) W !,"CONTROL ",$P(^LAB(62.3,+X,0),U,1)," HAS NO TEST FOR THIS PROFILE."
|
|---|
| 42 | Q
|
|---|
| 43 | CLEAR ;from LRLL
|
|---|
| 44 | W !,"WANT TO UNLOAD THE ",$S(LRTYPE:"LOAD",1:"WORK")," LIST FIRST" S %=2 D YN^DICN W:%=0 !,"If you're not sure, we'll skip it." W:%=-1 !,"Nothing cleared." S DUOUT=(%=-1) Q:%'=1
|
|---|
| 45 | D CLEAR^LRLLS3 S (LAST,^LRO(68.2,LRINST,2))=DT_"^1^1^0^0",$P(^(1,0),U,3,4)=0 F I=0:0 S I=$O(^LRO(68.2,LRINST,1,0)) Q:I<1 S $P(^(0),U,3)=I,$P(^(0),U,4)=I
|
|---|
| 46 | I LRTYPE W !,"Do you want to delete all unverified ",$P(^LRO(68.2,LRINST,0),U)," instrument data" S %=2 D YN^DICN S DUOUT=(%=-1) Q:%'=1 K ^LAH(LRINST)
|
|---|
| 47 | Q
|
|---|
| 48 | ACCESS ;
|
|---|
| 49 | S LRKEY=+$P(Y(0),U,LRP),LRKEY=$S($D(^DIC(19.1,LRKEY,0)):$P(^(0),U),1:0),LREND=$S($D(^XUSEC(LRKEY,DUZ)):0,1:1)
|
|---|
| 50 | Q
|
|---|
