- LRORDD ; IHS/HQT/MJL - CHECK FOR DIFFERENT URGENCY WITH IN ORDER 2/6/91 13:05 ; [ 07/22/2002 1:33 PM ]
- ;;5.2;LR;**1010,1011,1013**;JUL 15, 2002
- ;
- ;;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 ;
- I '$G(BLRGUI) 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 S:'$G(BLRGUI) 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
- I '$G(BLRGUI) 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 $G(BLRGUI) D DUP^LRORD2
- 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:'$G(BLRGUI) !,$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:'$G(BLRGUI) !!?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:'$G(BLRGUI) 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
- LRORDD ; IHS/HQT/MJL - CHECK FOR DIFFERENT URGENCY WITH IN ORDER 2/6/91 13:05 ; [ 07/22/2002 1:33 PM ]
- +1 ;;5.2;LR;**1010,1011,1013**;JUL 15, 2002
- +2 ;
- +3 ;;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 IF '$GET(BLRGUI)
- 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
- IF '$GET(BLRGUI)
- 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 IF '$GET(BLRGUI)
- 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 $GET(BLRGUI)
- DO DUP^LRORD2
- +5 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
- +6 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)
- IF '$GET(BLRGUI)
- 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
- IF '$GET(BLRGUI)
- 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
- IF '$GET(BLRGUI)
- 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
