Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LROW3

LROW3.m

Go to the documentation of this file. 
  1. LROW3 ;VA/DALOI/CJS - LIST THE TESTS ORDERED AND ALLOW EDITING ;JUL 06, 2010 3:14 PM
  1.  ;;5.2;LAB SERVICE;**33,121,286,1027**;NOV 01, 1997
  1. L ;
  1.  ; Only ask nature of order for CPRS - file #2 patients.
  1.  I $G(LRDPF,2)=2 D  Q:'$D(LRNATURE)
  1.  . D NATURE
  1.  . I $G(LRNATURE)=-1 W !!,$C(7),"...process aborted" S %="^" K LRNATURE
  1.  D L3
  1.  W !!,"All satisfactory" S %=1 D YN^DICN D:%=0 HELP G:%=0 L Q:%'=2
  1. 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)
  1.  I X'="",'$D(J(+X)) W !!?5,$C(7),"( "_X_" ) Is not a valid entry number " G LROW3
  1.  I X'="" S X=+X S LRSAMP=$P(J(X),U),LRTEST=$P(J(X),U,2) D X3 G L1
  1. L1A W !!,"Add more tests" S %=2 D YN^DICN D:%=0 HELP G:%=0 L1A I %=1 D L2^LROW1
  1.  G LROW3
  1.  ;
  1.  ;
  1. L2 S LRSAMP=$S($D(^LAB(62,I,0)):$P(^(0),U),1:"")
  1.  S K=0
  1.  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
  1.  Q
  1.  ;
  1.  ;
  1. L3 ;
  1.  K J S J=0,I=0
  1.  ; W !!,"You have just selected the following tests for ",PNM,"  ",SSN
  1.  W !!,"You have just selected the following tests for ",PNM,"  ",HRCN     ; IHS/ANMC/CLS 08/18/96
  1.  I $G(LRLWC)="LC" W:$G(LRORDTIM) !," for Collection on: ",$$FMTE^XLFDT(LRODT_"."_LRORDTIM,"M")
  1.  W !,?5,"entry no.",?15,"Test",?45,"Sample"
  1.  S I=0 F  S I=$O(LRXST(I)) Q:I<1  D L2
  1.  Q
  1.  ;
  1.  ;
  1. 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))
  1.  Q
  1.  ;
  1.  ;
  1. ENSTIK ;from LRMIBL, LRORD1
  1.  ; Only ask nature of order for CPRS - file #2 patients.
  1.  I $G(LRDPF,2)=2 D  Q:'$D(LRNATURE)
  1.  . D NATURE
  1.  . I $G(LRNATURE)=-1 W !!,$C(7),"...process aborted" S %="^" K LRNATURE
  1.  ;
  1.  D LL3
  1. LL W !!,"All satisfactory" S %=1 D YN^DICN D:%=0 HELP G:%=0 LL Q:%'=2
  1.  ;
  1. 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)
  1.  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
  1.  ;
  1. LL1A W !!,"Add more tests" S %=2 D YN^DICN D:%=0 HELP G:%=0 LL1A G ENSTIK:%'=1 K % Q
  1.  ;
  1.  ;
  1. LL2 ;
  1.  S LRSAMP=$P($G(^LAB(62,+I,0)),U)
  1.  S LRSPEC=$P($G(^LAB(61,+L,0)),U)
  1.  S K=0
  1.  F  S K=$O(LROT(I,L,K)) Q:K<1  D
  1.  . S J=J+1,J(J)=I_U_L_U_K
  1.  . W !,?5,J,?15,$P(^LAB(60,+LROT(I,L,K),0),U)," ",?45,LRSAMP
  1.  . W:LRSAMP'=LRSPEC "  ",LRSPEC
  1.  Q
  1.  ;
  1.  ;
  1. LL3 ;
  1.  K J
  1.  ; S J=0 W !!,"You have just selected the following tests for ",PNM,"  ",SSN
  1.  S J=0 W !!,"You have just selected the following tests for ",PNM,"  ",HRCN    ; IHS/ANMC/CLS 08/18/96
  1.  I LRORDR="LC" W !," for Collection on: ",$$FMTE^XLFDT(LRODT_"."_LRORDTIM,"M")
  1.  W !,?5,"entry no.",?15,"Test",?45,"Sample"
  1.  F I=-1:0 S I=$O(LROT(I)) Q:I=""  D
  1.  . F L=-1:0 S L=$O(LROT(I,L)) Q:L=""  D LL2
  1.  Q
  1.  ;
  1.  ;
  1. HELP W !!,"Answer 'Yes' or 'No' ('^' to cancel)"
  1.  Q
  1.  ;
  1.  ;
  1. X3 K X3(+LRTEST(X),+LRSAMP,+LRXST(LRSAMP,X))
  1.  K LRTEST(X),J(X),LRXST(LRSAMP,X),LRSAMP(X)
  1.  Q
  1.  ;
  1.  ;
  1. NATURE ;Get Nature of order
  1.  I '$D(LRPHSET) D NEW^LROR6()
  1.  Q