| [613] | 1 | LREXPD ;SLC/RWF-EXPLODE A LRTEST LIST ;2/5/91 13:15
|
|---|
| 2 | ;;5.2;LAB SERVICE;**153,201,221**;Sep 27, 1994
|
|---|
| 3 | ;LRTEST IS LIST OF TEST's, LREXPD IS EXECUTE CODE TO SET OTHER VAR.
|
|---|
| 4 | S S1=0,J=0 S:'$D(LRTSTS)#2 LRTSTS=0
|
|---|
| 5 | F I=1:1 S X=$P(LRTEST,U,I) Q:X<1 D TREE
|
|---|
| 6 | K LREXPD,S1,J1 Q
|
|---|
| 7 | TREE I '$D(^LAB(60,X,0)) Q ;BAD LRTEST NUMBER
|
|---|
| 8 | I $P(^LAB(60,X,0),U,5)]"" Q:$D(^TMP("LR",$J,"T",X)) S LRTSTS=LRTSTS+1,LRORD(LRTSTS)=X,^TMP("LR",$J,"T",X)=^LAB(60,X,0) X:$D(LREXPD) LREXPD Q ;ADD TO LIST
|
|---|
| 9 | Q:'$D(^LAB(60,X,2,0)) Q:$O(^(0))<1 Q:$D(S1("A",X)) ;NOT A PANEL
|
|---|
| 10 | S S1=S1+1,S1(S1)=X,J1(S1)=J,S1("A",X)=""
|
|---|
| 11 | S J=0 F S J=$O(^LAB(60,S1(S1),2,J)) Q:J<1 S X=+^(J,0) D TREE
|
|---|
| 12 | S J=J1(S1),X=S1(S1),S1=S1-1
|
|---|
| 13 | Q
|
|---|
| 14 | EXP ;Get the list of tests for this ACC. from LRGVG1
|
|---|
| 15 | N I,N,IX
|
|---|
| 16 | K LRTEST,LRNAME,LRSM60 S LRALERT=$S($G(LROUTINE):LROUTINE,1:9),N=0,I=0,IX=+$G(^LRO(68,LRAA,1,LRAD,1,LRAN,5,1,0))
|
|---|
| 17 | F S I=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,I)) Q:I<.5 I $G(^(I,0)) S X=^(0) D
|
|---|
| 18 | . S N=N+1,LRTEST(N)=I,LRTEST(N,"P")=$P(X,U,9)_U_$$NLT^LRVER1(I)_"!"
|
|---|
| 19 | . S LRAL=$P($G(^(0)),U,2) I LRAL,LRAL<LRALERT S LRALERT=LRAL
|
|---|
| 20 | K LRAL S LRNTN=N F I=1:1:N S:$D(^LAB(60,+LRTEST(I),0)) LRTEST(I)=LRTEST(I)_U_^(0),LRNAME(I)=$P(LRTEST(I),U,2),LRNAME(I,+LRTEST(I))="" S:$G(^(1,IX,3)) LRSM60(+$P(LRTEST(I),";",2))=^(3)
|
|---|
| 21 | K IX N X1,X S X=$P($H,","),X(1)=$P($H,",",2),I=0 F S I=$O(LRSM60(I)) Q:'I S X1=X-LRSM60(I)_","_X(1),LRSM60(I)=9999999-$$HTFM^XLFDT(X1)
|
|---|
| 22 | Q
|
|---|
| 23 | EX1 ;;Expand the list of tests to edit.
|
|---|
| 24 | Q:'$D(LRTEST(T1)) S X=LRTEST(T1),^TMP("LR",$J,"VTO",+X)=$P($P(X,U,6),";",2)
|
|---|
| 25 | S ^TMP("LR",$J,"VTO",+X,"P")=$G(LRTEST(T1,"P")),S1=0,J=0 D EX2 K S1,J
|
|---|
| 26 | Q
|
|---|
| 27 | EX2 ;from LRDIST
|
|---|
| 28 | S LRSUB=$P(X,U,6) I $D(^LAB(60,+X,4)),$P(^(4),"^",2) S LRCFL=LRCFL_$P(^(4),"^",2)_U
|
|---|
| 29 | I $L(LRSUB) S S2=$P(LRSUB,";",2) D:'$D(^TMP("LR",$J,"TMP",S2)) ORD Q
|
|---|
| 30 | S S1=S1+1,S1(S1)=X,S1(S1,1)=J
|
|---|
| 31 | S J=0 F S J=$O(^LAB(60,+S1(S1),2,J)) Q:J<1 S Y=+^(J,0),X=Y_U_^LAB(60,Y,0) D EX2
|
|---|
| 32 | S X=S1(S1),J=S1(S1,1),S1=S1-1
|
|---|
| 33 | Q
|
|---|
| 34 | ORD S LRNX=LRNX+1,LRORD(LRNX)=S2,^TMP("LR",$J,"TMP",S2)=+X
|
|---|
| 35 | S ^TMP("LR",$J,"TMP",S2,"P")=$G(LRTEST(T1))_U_$$RNLT^LRVER1(+X)
|
|---|
| 36 | S:$P(X,U,18) LRM(S2)=+X,LRMX(+X)="" Q
|
|---|
| 37 | ;LRNX is set by caller
|
|---|
| 38 | Q
|
|---|
