LRORDD ;SLC/FHS - CHECK FOR DIFFERENT URGENCY WITH IN ORDER ;2/6/91 13:05 ;
;;5.2;LAB SERVICE;;Sep 27, 1994
DUP1 ;LOOK FOR DUPLICATES WITH IN TEST
S LRSAMP=0 F S LRSAMP=$O(LROT(LRSAMP)) Q:LRSAMP<1 S LRSPEC=0 F S LRSPEC=$O(LROT(LRSAMP,LRSPEC)) Q:LRSPEC<1 S ZZ=0 F S ZZ=$O(LROT(LRSAMP,LRSPEC,ZZ)) Q:ZZ<1 S LRSTSX=+LROT(LRSAMP,LRSPEC,ZZ) D DUP2
K LRTNM,LRURGX,LRTX,II,I,Z,ZZ,LRSTSX,LRTSTX,LRST
Q
EN ;
S X=+^(0) S:'$D(TT(X,S)) TT(X,S)=0 S TT(X,S)=TT(X,S)+1 Q
DUP2 ;
Q:'$D(^LAB(60,+LRSTSX,0)) I $P(^(0),U,20) Q
Q:'$D(^LAB(60,+LRSTSX,2,0)) S LREND=0,LRURG=$S($D(LROT(LRSAMP,LRSPEC,ZZ,1)):LROT(LRSAMP,LRSPEC,ZZ,1),1:LROUTINE)
S I=0 F S I=$O(^LAB(60,LRSTSX,2,I)) Q:I<1 S LRTSTS=+$S($D(^(I,0)):^(0),1:0) I '$P(^LAB(60,+LRTSTS,0),U,20) S Z=0 F S Z=$O(LROT(LRSAMP,LRSPEC,Z)) Q:Z<1 I LRTSTS=+LROT(LRSAMP,LRSPEC,Z) D DUP3
Q
DUP3 ;
S LRTNM=$P(^LAB(60,LRSTSX,0),U),LRURGX=$S($D(LROT(LRSAMP,LRSPEC,Z,1)):LROT(LRSAMP,LRSPEC,Z,1),1:LROUTINE)
I LRURGX'=LRURG Q
S X=$P(^LAB(60,LRTSTS,0),U) W !!,LRTNM," ~ Contains the Test ",X,! D DUP^LRORD2 W !!,"THE ORDER FOR ~ ",X," ~ IS DELETED ",$C(7) K LROT(LRSAMP,LRSPEC,Z) H 2
I $D(X3),$D(LRTEST) F A=0:0 S A=$O(LRTEST(A)) Q:A="" I +LRTEST(A)=Z K X3(Z,LRSAMP(A),LRXST(LRSAMP,A)),LRXS(LRSAMP(A),LRXST(LRSAMP,A),LRTEST(A)),LRSAMP(A),LRXST(LRSAMP,A),LRTEST(A) S:$D(LRTSTN) LRTSTN=LRTSTN-1
Q
LROW ;
Q:'+$P(^LAB(69.9,1,0),U,17)
F D=0:0 S D=$O(LRTEST(D)) Q:D="" S LRTSTX=$P(LRTEST(D),U),ZZ=$P(LRTEST(D),U,2) F LRSAMP=0:0 S LRSAMP=$O(X3(LRTSTX,LRSAMP)) Q:LRSAMP="" F LRSPEC=0:0 S LRSPEC=$O(X3(LRTSTX,LRSAMP,LRSPEC)) Q:LRSPEC="" D LROT
D DUP1
Q
LROT S LROT(LRSAMP,LRSPEC,LRTSTX)=LRTSTX,LROT(LRSAMP,LRSPEC,LRTSTX,1)=ZZ Q
EN1 ; FROM LROW1 MAXIUM ORDER FREQUENCY CHECKER
W !!?7,$C(7),$P(^LAB(60,LRTY,0),U)," Order has EXCEEDED the daily maximum of ",LRMAX1," per day. " F LRSN=0:0 S LRSN=$O(T(LRTY,LRSN)) Q:'LRSN D ORDER^LROS
W !!," Do you really want another? NO // " D % S:%'["Y" LROUT=1
Q
% R %:DTIME S:'$T DTOUT=1 Q:%=""!(%["Y")!(%["N") W !,"Answer 'Y' or 'N' : " G %
Q
EN2 ;FROM LRORD2 CHECK FOR MAXIUM ORDER FREQUENCY
S LRMAX1=+$P(^LAB(60,LRTSTS,3,$O(^LAB(60,LRTSTS,3,"B",LRCS(LRCSN),0)),0),U,7)
Q:'LRMAX1 I TT(LRTSTS,LRSPEC)>LRMAX1 S LRTY=LRTSTS D EN1 S LRTSTS=LRTY K LRTY
Q
Q20 ;Look for Duplicate of the same test
D:LRSAMP="" GSS^LRORD3 I (LRSAMP<1)!(LRSPEC<1) W !,$S(LRSAMP<1:"Sample",LRSPEC<1:"Source",1:"Sample and source")," incompletely defined, test skipped." K LRSAME Q
S LREND=0,Z=0 F S Z=$O(LROT(LRSAMP,LRSPEC,Z)) Q:Z<1 I +LROT(LRSAMP,LRSPEC,Z)=LRTSTS W !!?20," ~ ",$P(^LAB(60,LRTSTS,0),U)," ",$S($D(^LAB(62,LRSAMP,0)):$P(^(0),U),1:"")," ",$S($D(^LAB(61,LRSPEC,0)):$P(^(0),U),1:"")," ~" D DUP^LRORD2 H 2
Q:LREND
S LRSAVE=LROUTINE
S LROT(LRSAMP,LRSPEC,LRSSX)=LRTSTS S:$P(^LAB(60,LRTSTS,0),U,18) LROUTINE=$P(^(0),U,18) S:LROUTINE'=LRSAVE LRURGG=LROUTINE D:LRST!(LRSAVE'=LROUTINE) URGG^LRORD1
S LROUTINE=LRSAVE
S LREXP=$S($D(^LAB(60,LRTSTS,3,+$O(^LAB(60,LRTSTS,3,"B",+LRSAMP,0)),0)):$P(^(0),U,6),1:0) S:LREXP LROT(LRSAMP,LRSPEC,LRSSX,2)=LREXP
I 'LREXP S LREXP=$S($P(^LAB(60,LRTSTS,0),U,19):$P(^(0),U,19),1:0) S:LREXP LROT(LRSAMP,LRSPEC,LRSSX,2)=LREXP
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRORDD 3190 printed Oct 16, 2024@18:19:39 Page 2
LRORDD ;SLC/FHS - CHECK FOR DIFFERENT URGENCY WITH IN ORDER ;2/6/91 13:05 ;
+1 ;;5.2;LAB SERVICE;;Sep 27, 1994
DUP1 ;LOOK FOR DUPLICATES WITH IN TEST
+1 SET LRSAMP=0
FOR
SET LRSAMP=$ORDER(LROT(LRSAMP))
if LRSAMP<1
QUIT
SET LRSPEC=0
FOR
SET LRSPEC=$ORDER(LROT(LRSAMP,LRSPEC))
if LRSPEC<1
QUIT
SET ZZ=0
FOR
SET ZZ=$ORDER(LROT(LRSAMP,LRSPEC,ZZ))
if ZZ<1
QUIT
SET LRSTSX=+LROT(LRSAMP,LRSPEC,ZZ)
DO DUP2
+2 KILL LRTNM,LRURGX,LRTX,II,I,Z,ZZ,LRSTSX,LRTSTX,LRST
+3 QUIT
EN ;
+1 SET X=+^(0)
if '$DATA(TT(X,S))
SET TT(X,S)=0
SET TT(X,S)=TT(X,S)+1
QUIT
DUP2 ;
+1 if '$DATA(^LAB(60,+LRSTSX,0))
QUIT
IF $PIECE(^(0),U,20)
QUIT
+2 if '$DATA(^LAB(60,+LRSTSX,2,0))
QUIT
SET LREND=0
SET LRURG=$SELECT($DATA(LROT(LRSAMP,LRSPEC,ZZ,1)):LROT(LRSAMP,LRSPEC,ZZ,1),1:LROUTINE)
+3 SET I=0
FOR
SET I=$ORDER(^LAB(60,LRSTSX,2,I))
if I<1
QUIT
SET LRTSTS=+$SELECT($DATA(^(I,0)):^(0),1:0)
IF '$PIECE(^LAB(60,+LRTSTS,0),U,20)
SET Z=0
FOR
SET Z=$ORDER(LROT(LRSAMP,LRSPEC,Z))
if Z<1
QUIT
IF LRTSTS=+LROT(LRSAMP,LRSPEC,Z)
DO DUP3
+4 QUIT
DUP3 ;
+1 SET LRTNM=$PIECE(^LAB(60,LRSTSX,0),U)
SET LRURGX=$SELECT($DATA(LROT(LRSAMP,LRSPEC,Z,1)):LROT(LRSAMP,LRSPEC,Z,1),1:LROUTINE)
+2 IF LRURGX'=LRURG
QUIT
+3 SET X=$PIECE(^LAB(60,LRTSTS,0),U)
WRITE !!,LRTNM," ~ Contains the Test ",X,!
DO DUP^LRORD2
WRITE !!,"THE ORDER FOR ~ ",X," ~ IS DELETED ",$CHAR(7)
KILL LROT(LRSAMP,LRSPEC,Z)
HANG 2
+4 IF $DATA(X3)
IF $DATA(LRTEST)
FOR A=0:0
SET A=$ORDER(LRTEST(A))
if A=""
QUIT
IF +LRTEST(A)=Z
KILL X3(Z,LRSAMP(A),LRXST(LRSAMP,A)),LRXS(LRSAMP(A),LRXST(LRSAMP,A),LRTEST(A)),LRSAMP(A),LRXST(LRSAMP,A),LRTEST(A)
if $DATA(LRTSTN)
SET LRTSTN=LRTSTN-1
+5 QUIT
LROW ;
+1 if '+$PIECE(^LAB(69.9,1,0),U,17)
QUIT
+2 FOR D=0:0
SET D=$ORDER(LRTEST(D))
if D=""
QUIT
SET LRTSTX=$PIECE(LRTEST(D),U)
SET ZZ=$PIECE(LRTEST(D),U,2)
FOR LRSAMP=0:0
SET LRSAMP=$ORDER(X3(LRTSTX,LRSAMP))
if LRSAMP=""
QUIT
FOR LRSPEC=0:0
SET LRSPEC=$ORDER(X3(LRTSTX,LRSAMP,LRSPEC))
if LRSPEC=""
QUIT
DO LROT
+3 DO DUP1
+4 QUIT
LROT SET LROT(LRSAMP,LRSPEC,LRTSTX)=LRTSTX
SET LROT(LRSAMP,LRSPEC,LRTSTX,1)=ZZ
QUIT
EN1 ; FROM LROW1 MAXIUM ORDER FREQUENCY CHECKER
+1 WRITE !!?7,$CHAR(7),$PIECE(^LAB(60,LRTY,0),U)," Order has EXCEEDED the daily maximum of ",LRMAX1," per day. "
FOR LRSN=0:0
SET LRSN=$ORDER(T(LRTY,LRSN))
if 'LRSN
QUIT
DO ORDER^LROS
+2 WRITE !!," Do you really want another? NO // "
DO %
if %'["Y"
SET LROUT=1
+3 QUIT
% READ %:DTIME
if '$TEST
SET DTOUT=1
if %=""!(%["Y")!(%["N")
QUIT
WRITE !,"Answer 'Y' or 'N' : "
GOTO %
+1 QUIT
EN2 ;FROM LRORD2 CHECK FOR MAXIUM ORDER FREQUENCY
+1 SET LRMAX1=+$PIECE(^LAB(60,LRTSTS,3,$ORDER(^LAB(60,LRTSTS,3,"B",LRCS(LRCSN),0)),0),U,7)
+2 if 'LRMAX1
QUIT
IF TT(LRTSTS,LRSPEC)>LRMAX1
SET LRTY=LRTSTS
DO EN1
SET LRTSTS=LRTY
KILL LRTY
+3 QUIT
Q20 ;Look for Duplicate of the same test
+1 if LRSAMP=""
DO GSS^LRORD3
IF (LRSAMP<1)!(LRSPEC<1)
WRITE !,$SELECT(LRSAMP<1:"Sample",LRSPEC<1:"Source",1:"Sample and source")," incompletely defined, test skipped."
KILL LRSAME
QUIT
+2 SET LREND=0
SET Z=0
FOR
SET Z=$ORDER(LROT(LRSAMP,LRSPEC,Z))
if Z<1
QUIT
IF +LROT(LRSAMP,LRSPEC,Z)=LRTSTS
WRITE !!?20," ~ ",$PIECE(^LAB(60,LRTSTS,0),U)," ",$SELECT($DATA(^LAB(62,LRSAMP,0)):$PIECE(^(0),U),1:"")," ",$SELECT($DATA(^LAB(61,LRSPEC,0)):$PIECE(^(0),U),1:"")," ~"
DO DUP^LRORD2
HANG 2
+3 if LREND
QUIT
+4 SET LRSAVE=LROUTINE
+5 SET LROT(LRSAMP,LRSPEC,LRSSX)=LRTSTS
if $PIECE(^LAB(60,LRTSTS,0),U,18)
SET LROUTINE=$PIECE(^(0),U,18)
if LROUTINE'=LRSAVE
SET LRURGG=LROUTINE
if LRST!(LRSAVE'=LROUTINE)
DO URGG^LRORD1
+6 SET LROUTINE=LRSAVE
+7 SET LREXP=$SELECT($DATA(^LAB(60,LRTSTS,3,+$ORDER(^LAB(60,LRTSTS,3,"B",+LRSAMP,0)),0)):$PIECE(^(0),U,6),1:0)
if LREXP
SET LROT(LRSAMP,LRSPEC,LRSSX,2)=LREXP
+8 IF 'LREXP
SET LREXP=$SELECT($PIECE(^LAB(60,LRTSTS,0),U,19):$PIECE(^(0),U,19),1:0)
if LREXP
SET LROT(LRSAMP,LRSPEC,LRSSX,2)=LREXP
+9 QUIT
