VistA-FOIAVistA/r/LAB_SERVICE-LR-LS/LRORDD.m

46 lines
3.1 KiB
Mathematica

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