source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LROW3.m@ 1590

Last change on this file since 1590 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.7 KB
Line 
1LROW3 ;DALOI/CJS - LIST THE TESTS ORDERED AND ALLOW EDITING ;Mar 23, 2004
2 ;;5.2;LAB SERVICE;**33,121,286**;Sep 27, 1994
3L ;
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
10L1 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
13L1A 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 ;
17L2 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 ;
23L3 ;
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 ;
32L4 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 ;
36ENSTIK ;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
43LL W !!,"All satisfactory" S %=1 D YN^DICN D:%=0 HELP G:%=0 LL Q:%'=2
44 ;
45LL1 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 ;
48LL1A W !!,"Add more tests" S %=2 D YN^DICN D:%=0 HELP G:%=0 LL1A G ENSTIK:%'=1 K % Q
49 ;
50 ;
51LL2 ;
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 ;
62LL3 ;
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 ;
72HELP W !!,"Answer 'Yes' or 'No' ('^' to cancel)"
73 Q
74 ;
75 ;
76X3 K X3(+LRTEST(X),+LRSAMP,+LRXST(LRSAMP,X))
77 K LRTEST(X),J(X),LRXST(LRSAMP,X),LRSAMP(X)
78 Q
79 ;
80 ;
81NATURE ;Get Nature of order
82 I '$D(LRPHSET) D NEW^LROR6()
83 Q
Note: See TracBrowser for help on using the repository browser.