| 1 | LRORDD ;SLC/FHS - CHECK FOR DIFFERENT URGENCY WITH IN ORDER ;2/6/91 13:05 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;;Sep 27, 1994
|
|---|
| 3 | DUP1 ;LOOK FOR DUPLICATES WITH IN TEST
|
|---|
| 4 | 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
|
|---|
| 5 | K LRTNM,LRURGX,LRTX,II,I,Z,ZZ,LRSTSX,LRTSTX,LRST
|
|---|
| 6 | Q
|
|---|
| 7 | EN ;
|
|---|
| 8 | S X=+^(0) S:'$D(TT(X,S)) TT(X,S)=0 S TT(X,S)=TT(X,S)+1 Q
|
|---|
| 9 | DUP2 ;
|
|---|
| 10 | Q:'$D(^LAB(60,+LRSTSX,0)) I $P(^(0),U,20) Q
|
|---|
| 11 | 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)
|
|---|
| 12 | 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
|
|---|
| 13 | Q
|
|---|
| 14 | DUP3 ;
|
|---|
| 15 | S LRTNM=$P(^LAB(60,LRSTSX,0),U),LRURGX=$S($D(LROT(LRSAMP,LRSPEC,Z,1)):LROT(LRSAMP,LRSPEC,Z,1),1:LROUTINE)
|
|---|
| 16 | I LRURGX'=LRURG Q
|
|---|
| 17 | 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
|
|---|
| 18 | 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
|
|---|
| 19 | Q
|
|---|
| 20 | LROW ;
|
|---|
| 21 | Q:'+$P(^LAB(69.9,1,0),U,17)
|
|---|
| 22 | 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
|
|---|
| 23 | D DUP1
|
|---|
| 24 | Q
|
|---|
| 25 | LROT S LROT(LRSAMP,LRSPEC,LRTSTX)=LRTSTX,LROT(LRSAMP,LRSPEC,LRTSTX,1)=ZZ Q
|
|---|
| 26 | EN1 ; FROM LROW1 MAXIUM ORDER FREQUENCY CHECKER
|
|---|
| 27 | 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
|
|---|
| 28 | W !!," Do you really want another? NO // " D % S:%'["Y" LROUT=1
|
|---|
| 29 | Q
|
|---|
| 30 | % R %:DTIME S:'$T DTOUT=1 Q:%=""!(%["Y")!(%["N") W !,"Answer 'Y' or 'N' : " G %
|
|---|
| 31 | Q
|
|---|
| 32 | EN2 ;FROM LRORD2 CHECK FOR MAXIUM ORDER FREQUENCY
|
|---|
| 33 | S LRMAX1=+$P(^LAB(60,LRTSTS,3,$O(^LAB(60,LRTSTS,3,"B",LRCS(LRCSN),0)),0),U,7)
|
|---|
| 34 | Q:'LRMAX1 I TT(LRTSTS,LRSPEC)>LRMAX1 S LRTY=LRTSTS D EN1 S LRTSTS=LRTY K LRTY
|
|---|
| 35 | Q
|
|---|
| 36 | Q20 ;Look for Duplicate of the same test
|
|---|
| 37 | 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
|
|---|
| 38 | 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
|
|---|
| 39 | Q:LREND
|
|---|
| 40 | S LRSAVE=LROUTINE
|
|---|
| 41 | 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
|
|---|
| 42 | S LROUTINE=LRSAVE
|
|---|
| 43 | 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
|
|---|
| 44 | 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
|
|---|
| 45 | Q
|
|---|
