| 1 | LROW3 ;DALOI/CJS - LIST THE TESTS ORDERED AND ALLOW EDITING ;Mar 23, 2004
|
|---|
| 2 | ;;5.2;LAB SERVICE;**33,121,286**;Sep 27, 1994
|
|---|
| 3 | L ;
|
|---|
| 4 | ; Only ask nature of order for CPRS - file #2 patients.
|
|---|
| 5 | I $G(LRDPF,2)=2 D Q:'$D(LRNATURE)
|
|---|
| 6 | . D NATURE
|
|---|
| 7 | . I $G(LRNATURE)=-1 W !!,$C(7),"...process aborted" S %="^" K LRNATURE
|
|---|
| 8 | D L3
|
|---|
| 9 | W !!,"All satisfactory" S %=1 D YN^DICN D:%=0 HELP G:%=0 L Q:%'=2
|
|---|
| 10 | L1 W !,"Delete test entry no.: " R X:DTIME W:X["?" !,"Select entry number to be deleted." W:X'?.N !,"Select one entry at a time." D L3:X["?" G L1:X["?"!(X'?.N)
|
|---|
| 11 | I X'="",'$D(J(+X)) W !!?5,$C(7),"( "_X_" ) Is not a valid entry number " G LROW3
|
|---|
| 12 | I X'="" S X=+X S LRSAMP=$P(J(X),U),LRTEST=$P(J(X),U,2) D X3 G L1
|
|---|
| 13 | L1A W !!,"Add more tests" S %=2 D YN^DICN D:%=0 HELP G:%=0 L1A I %=1 D L2^LROW1
|
|---|
| 14 | G LROW3
|
|---|
| 15 | ;
|
|---|
| 16 | ;
|
|---|
| 17 | L2 S LRSAMP=$S($D(^LAB(62,I,0)):$P(^(0),U),1:"")
|
|---|
| 18 | S K=0
|
|---|
| 19 | F S K=$O(LRXST(I,K)) Q:K<1 S J=K,J(K)=I_U_K D L4 W !,?5,K,?15,$P(^LAB(60,+LRTEST(K),0),U)," ",?45,LRSAMP W:LRSAMP'=LRSPEC " ",LRSPEC
|
|---|
| 20 | Q
|
|---|
| 21 | ;
|
|---|
| 22 | ;
|
|---|
| 23 | L3 ;
|
|---|
| 24 | K J S J=0,I=0
|
|---|
| 25 | W !!,"You have just selected the following tests for ",PNM," ",SSN
|
|---|
| 26 | I $G(LRLWC)="LC" W:$G(LRORDTIM) !," for Collection on: ",$$FMTE^XLFDT(LRODT_"."_LRORDTIM,"M")
|
|---|
| 27 | W !,?5,"entry no.",?15,"Test",?45,"Sample"
|
|---|
| 28 | S I=0 F S I=$O(LRXST(I)) Q:I<1 D L2
|
|---|
| 29 | Q
|
|---|
| 30 | ;
|
|---|
| 31 | ;
|
|---|
| 32 | L4 S LRSPEC=$S(I>0:$S($D(^LAB(61,LRXST(I,K),0)):$P(^(0),U),1:""),1:$P(^LAB(61,$P(LRXST(0,K),U,2),0),U))
|
|---|
| 33 | Q
|
|---|
| 34 | ;
|
|---|
| 35 | ;
|
|---|
| 36 | ENSTIK ;from LRMIBL, LRORD1
|
|---|
| 37 | ; Only ask nature of order for CPRS - file #2 patients.
|
|---|
| 38 | I $G(LRDPF,2)=2 D Q:'$D(LRNATURE)
|
|---|
| 39 | . D NATURE
|
|---|
| 40 | . I $G(LRNATURE)=-1 W !!,$C(7),"...process aborted" S %="^" K LRNATURE
|
|---|
| 41 | ;
|
|---|
| 42 | D LL3
|
|---|
| 43 | LL W !!,"All satisfactory" S %=1 D YN^DICN D:%=0 HELP G:%=0 LL Q:%'=2
|
|---|
| 44 | ;
|
|---|
| 45 | LL1 W !,"Delete test entry no.: " R X:DTIME W:X["?" !,"Select entry number to be deleted." W:X'?.N !,"Select one entry at a time." D LL3:X["?" G LL1:X["?"!(X'?.N)
|
|---|
| 46 | I '(+X'=X!(X>J)!(X<1)) S LRSAMP=$P(J(X),U),LRSPEC=$P(J(X),U,2),LRTEST=$P(J(X),U,3) K LROT(LRSAMP,LRSPEC,LRTEST) G LL1
|
|---|
| 47 | ;
|
|---|
| 48 | LL1A W !!,"Add more tests" S %=2 D YN^DICN D:%=0 HELP G:%=0 LL1A G ENSTIK:%'=1 K % Q
|
|---|
| 49 | ;
|
|---|
| 50 | ;
|
|---|
| 51 | LL2 ;
|
|---|
| 52 | S LRSAMP=$P($G(^LAB(62,+I,0)),U)
|
|---|
| 53 | S LRSPEC=$P($G(^LAB(61,+L,0)),U)
|
|---|
| 54 | S K=0
|
|---|
| 55 | F S K=$O(LROT(I,L,K)) Q:K<1 D
|
|---|
| 56 | . S J=J+1,J(J)=I_U_L_U_K
|
|---|
| 57 | . W !,?5,J,?15,$P(^LAB(60,+LROT(I,L,K),0),U)," ",?45,LRSAMP
|
|---|
| 58 | . W:LRSAMP'=LRSPEC " ",LRSPEC
|
|---|
| 59 | Q
|
|---|
| 60 | ;
|
|---|
| 61 | ;
|
|---|
| 62 | LL3 ;
|
|---|
| 63 | K J
|
|---|
| 64 | S J=0 W !!,"You have just selected the following tests for ",PNM," ",SSN
|
|---|
| 65 | I LRORDR="LC" W !," for Collection on: ",$$FMTE^XLFDT(LRODT_"."_LRORDTIM,"M")
|
|---|
| 66 | W !,?5,"entry no.",?15,"Test",?45,"Sample"
|
|---|
| 67 | F I=-1:0 S I=$O(LROT(I)) Q:I="" D
|
|---|
| 68 | . F L=-1:0 S L=$O(LROT(I,L)) Q:L="" D LL2
|
|---|
| 69 | Q
|
|---|
| 70 | ;
|
|---|
| 71 | ;
|
|---|
| 72 | HELP W !!,"Answer 'Yes' or 'No' ('^' to cancel)"
|
|---|
| 73 | Q
|
|---|
| 74 | ;
|
|---|
| 75 | ;
|
|---|
| 76 | X3 K X3(+LRTEST(X),+LRSAMP,+LRXST(LRSAMP,X))
|
|---|
| 77 | K LRTEST(X),J(X),LRXST(LRSAMP,X),LRSAMP(X)
|
|---|
| 78 | Q
|
|---|
| 79 | ;
|
|---|
| 80 | ;
|
|---|
| 81 | NATURE ;Get Nature of order
|
|---|
| 82 | I '$D(LRPHSET) D NEW^LROR6()
|
|---|
| 83 | Q
|
|---|
