LROW3 ;DALOI/STAFF - LIST THE TESTS ORDERED AND ALLOW EDITING ;11/18/11 16:29
;;5.2;LAB SERVICE;**33,121,286,350**;Sep 27, 1994;Build 230
;
L ;
; Only ask nature of order for CPRS - file #2 patients.
I $G(LRDPF,2)=2 D Q:'$D(LRNATURE)
. D NATURE
. I $G(LRNATURE)=-1 W !!,$C(7),"...process aborted" S %="^" K LRNATURE
D L3
W !!,"All satisfactory" S %=1 D YN^DICN D:%=0 HELP G:%=0 L Q:%'=2
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)
I X'="",'$D(J(+X)) W !!?5,$C(7),"( "_X_" ) Is not a valid entry number " G LROW3
I X'="" S X=+X S LRSAMP=$P(J(X),U),LRTEST=$P(J(X),U,2) D X3 G L1
L1A W !!,"Add more tests" S %=2 D YN^DICN D:%=0 HELP G:%=0 L1A I %=1 D L2^LROW1
G LROW3
;
;
L2 S LRSAMP=$S($D(^LAB(62,I,0)):$P(^(0),U),1:"")
S K=0
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
Q
;
;
L3 ;
K J S J=0,I=0
W !!,"You have just selected the following tests for ",PNM," ",SSN
I $G(LRLWC)="LC" W:$G(LRORDTIM) !," for Collection on: ",$$FMTE^XLFDT(LRODT_"."_LRORDTIM,"M")
W !,?5,"entry no.",?15,"Test",?45,"Sample"
S I=0 F S I=$O(LRXST(I)) Q:I<1 D L2
Q
;
;
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))
Q
;
;
ENSTIK ;from LRMIBL, LRORD1
; Only ask nature of order for CPRS - file #2 patients.
I $G(LRDPF,2)=2 D Q:'$D(LRNATURE)
. D NATURE
. I $G(LRNATURE)=-1 W !!,$C(7),"...process aborted" S %="^" K LRNATURE
;
D LL3
LL W !!,"All satisfactory" S %=1 D YN^DICN D:%=0 HELP G:%=0 LL Q:%'=2
;
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)
I X I +X=X I '$D(J(+X)) W !!?5,$C(7),"( "_X_" ) is not a valid entry.",! H 2 G LL1
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
;
LL1A W !!,"Add more tests" S %=2 D YN^DICN D:%=0 HELP G:%=0 LL1A G ENSTIK:%'=1
K %
Q
;
;
LL2 ;
S LRSAMP=$P($G(^LAB(62,+I,0)),U)
S LRSPEC=$P($G(^LAB(61,+L,0)),U)
S K=0
F S K=$O(LROT(I,L,K)) Q:K<1 D
. S J=J+1,J(J)=I_U_L_U_K
. W !,?5,J,?15,$P(^LAB(60,+LROT(I,L,K),0),U)," ",?45,LRSAMP
. W:LRSAMP'=LRSPEC " ",LRSPEC
Q
;
;
LL3 ;
K J
S J=0 W !!,"You have just selected the following tests for ",PNM," ",SSN
I LRORDR="LC" W !," for Collection on: ",$$FMTE^XLFDT(LRODT_"."_LRORDTIM,"M")
W !,?5,"entry no.",?15,"Test",?45,"Sample"
F I=-1:0 S I=$O(LROT(I)) Q:I="" D
. F L=-1:0 S L=$O(LROT(I,L)) Q:L="" D LL2
Q
;
;
HELP W !!,"Answer 'Yes' or 'No' ('^' to cancel)"
Q
;
;
X3 K X3(+LRTEST(X),+LRSAMP,+LRXST(LRSAMP,X))
K LRTEST(X),J(X),LRXST(LRSAMP,X),LRSAMP(X)
Q
;
;
NATURE ;Get Nature of order
I '$D(LRPHSET) D NEW^LROR6()
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLROW3 2991 printed Oct 16, 2024@18:19:57 Page 2
LROW3 ;DALOI/STAFF - LIST THE TESTS ORDERED AND ALLOW EDITING ;11/18/11 16:29
+1 ;;5.2;LAB SERVICE;**33,121,286,350**;Sep 27, 1994;Build 230
+2 ;
L ;
+1 ; Only ask nature of order for CPRS - file #2 patients.
+2 IF $GET(LRDPF,2)=2
Begin DoDot:1
+3 DO NATURE
+4 IF $GET(LRNATURE)=-1
WRITE !!,$CHAR(7),"...process aborted"
SET %="^"
KILL LRNATURE
End DoDot:1
if '$DATA(LRNATURE)
QUIT
+5 DO L3
+6 WRITE !!,"All satisfactory"
SET %=1
DO YN^DICN
if %=0
DO HELP
if %=0
GOTO L
if %'=2
QUIT
L1 WRITE !,"Delete test entry no.: "
READ X:DTIME
if X["?"
WRITE !,"Select entry number to be deleted."
if X'?.N
WRITE !,"Select one entry at a time."
if X["?"
DO L3
if X["?"!(X'?.N)
GOTO L1
+1 IF X'=""
IF '$DATA(J(+X))
WRITE !!?5,$CHAR(7),"( "_X_" ) Is not a valid entry number "
GOTO LROW3
+2 IF X'=""
SET X=+X
SET LRSAMP=$PIECE(J(X),U)
SET LRTEST=$PIECE(J(X),U,2)
DO X3
GOTO L1
L1A WRITE !!,"Add more tests"
SET %=2
DO YN^DICN
if %=0
DO HELP
if %=0
GOTO L1A
IF %=1
DO L2^LROW1
+1 GOTO LROW3
+2 ;
+3 ;
L2 SET LRSAMP=$SELECT($DATA(^LAB(62,I,0)):$PIECE(^(0),U),1:"")
+1 SET K=0
+2 FOR
SET K=$ORDER(LRXST(I,K))
if K<1
QUIT
SET J=K
SET J(K)=I_U_K
DO L4
WRITE !,?5,K,?15,$PIECE(^LAB(60,+LRTEST(K),0),U)," ",?45,LRSAMP
if LRSAMP'=LRSPEC
WRITE " ",LRSPEC
+3 QUIT
+4 ;
+5 ;
L3 ;
+1 KILL J
SET J=0
SET I=0
+2 WRITE !!,"You have just selected the following tests for ",PNM," ",SSN
+3 IF $GET(LRLWC)="LC"
if $GET(LRORDTIM)
WRITE !," for Collection on: ",$$FMTE^XLFDT(LRODT_"."_LRORDTIM,"M")
+4 WRITE !,?5,"entry no.",?15,"Test",?45,"Sample"
+5 SET I=0
FOR
SET I=$ORDER(LRXST(I))
if I<1
QUIT
DO L2
+6 QUIT
+7 ;
+8 ;
L4 SET LRSPEC=$SELECT(I>0:$SELECT($DATA(^LAB(61,LRXST(I,K),0)):$PIECE(^(0),U),1:""),1:$PIECE(^LAB(61,$PIECE(LRXST(0,K),U,2),0),U))
+1 QUIT
+2 ;
+3 ;
ENSTIK ;from LRMIBL, LRORD1
+1 ; Only ask nature of order for CPRS - file #2 patients.
+2 IF $GET(LRDPF,2)=2
Begin DoDot:1
+3 DO NATURE
+4 IF $GET(LRNATURE)=-1
WRITE !!,$CHAR(7),"...process aborted"
SET %="^"
KILL LRNATURE
End DoDot:1
if '$DATA(LRNATURE)
QUIT
+5 ;
+6 DO LL3
LL WRITE !!,"All satisfactory"
SET %=1
DO YN^DICN
if %=0
DO HELP
if %=0
GOTO LL
if %'=2
QUIT
+1 ;
LL1 WRITE !,"Delete test entry no.: "
READ X:DTIME
+1 if X["?"
WRITE !,"Select entry number to be deleted."
+2 if X'?.N
WRITE !,"Select one entry at a time."
+3 if X["?"
DO LL3
if X["?"!(X'?.N)
GOTO LL1
+4 IF X
IF +X=X
IF '$DATA(J(+X))
WRITE !!?5,$CHAR(7),"( "_X_" ) is not a valid entry.",!
HANG 2
GOTO LL1
+5 IF '(+X'=X!(X>J)!(X<1))
SET LRSAMP=$PIECE(J(X),U)
SET LRSPEC=$PIECE(J(X),U,2)
SET LRTEST=$PIECE(J(X),U,3)
KILL LROT(LRSAMP,LRSPEC,LRTEST)
GOTO LL1
+6 ;
LL1A WRITE !!,"Add more tests"
SET %=2
DO YN^DICN
if %=0
DO HELP
if %=0
GOTO LL1A
if %'=1
GOTO ENSTIK
+1 KILL %
+2 QUIT
+3 ;
+4 ;
LL2 ;
+1 SET LRSAMP=$PIECE($GET(^LAB(62,+I,0)),U)
+2 SET LRSPEC=$PIECE($GET(^LAB(61,+L,0)),U)
+3 SET K=0
+4 FOR
SET K=$ORDER(LROT(I,L,K))
if K<1
QUIT
Begin DoDot:1
+5 SET J=J+1
SET J(J)=I_U_L_U_K
+6 WRITE !,?5,J,?15,$PIECE(^LAB(60,+LROT(I,L,K),0),U)," ",?45,LRSAMP
+7 if LRSAMP'=LRSPEC
WRITE " ",LRSPEC
End DoDot:1
+8 QUIT
+9 ;
+10 ;
LL3 ;
+1 KILL J
+2 SET J=0
WRITE !!,"You have just selected the following tests for ",PNM," ",SSN
+3 IF LRORDR="LC"
WRITE !," for Collection on: ",$$FMTE^XLFDT(LRODT_"."_LRORDTIM,"M")
+4 WRITE !,?5,"entry no.",?15,"Test",?45,"Sample"
+5 FOR I=-1:0
SET I=$ORDER(LROT(I))
if I=""
QUIT
Begin DoDot:1
+6 FOR L=-1:0
SET L=$ORDER(LROT(I,L))
if L=""
QUIT
DO LL2
End DoDot:1
+7 QUIT
+8 ;
+9 ;
HELP WRITE !!,"Answer 'Yes' or 'No' ('^' to cancel)"
+1 QUIT
+2 ;
+3 ;
X3 KILL X3(+LRTEST(X),+LRSAMP,+LRXST(LRSAMP,X))
+1 KILL LRTEST(X),J(X),LRXST(LRSAMP,X),LRSAMP(X)
+2 QUIT
+3 ;
+4 ;
NATURE ;Get Nature of order
+1 IF '$DATA(LRPHSET)
DO NEW^LROR6()
+2 QUIT
