LRORD2A ;SLC/FHS - CHECK FOR MAX FREQ OF ORDERS ;2/6/91 13:00
;;5.2;LAB SERVICE;**56,100,153**;Sep 27, 1994
SING ;
Q:$G(LRORDRR)="R"
K LRZX 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 LRSPN=0 F S LRSPN=$O(LROT(LRSAMP,LRSPEC,LRSPN)) Q:LRSPN<1 S LRTY=+LROT(LRSAMP,LRSPEC,LRSPN) D MAX
Q
MAX ;Check max in a single day
Q:'LRTY!('$D(^LAB(60,LRTY,3,"B",LRSAMP))) S LRMAXX=^LAB(60,LRTY,3,$O(^LAB(60,LRTY,3,"B",LRSAMP,0)),0)
CHK S LRMAX1=+$P(LRMAXX,U,7) I LRMAX1,$D(TT(LRTY,LRSPEC)),TT(LRTY,LRSPEC)'<LRMAX1 D EN1^LRORDD I %'["Y" D SCRUB Q:LREND
S LRMAX2=+$P(LRMAXX,U,5) D:LRMAX2 NEW
Q
NEW ;Check max for number of days
K LRDAX S X1=$O(^LRO(69,"AT",LRDFN,LRTY,LRSPEC,LRODT-1)),Y=$O(^(-LRODT-1))
I X1 S X2=LRODT D ^%DTC S:X<LRMAX2 LRDAX(2)=X
I Y S X2=-Y,X1=LRODT D ^%DTC S:X<LRMAX2 LRDAX(1)=X
Q:'$D(LRDAX) W !!,$P(^LAB(60,LRTY,0),U)," Exceeds maximum order FREQUENCY of 1 every ",LRMAX2," day(s)."
D SETT
W !,"Do You really want another N// " D % Q:%["Y"
SCRUB ;
I %'["Y",$D(LRTEST),$D(LRTSTN) K LRTEST(LRTSTN),X3 Q
I %'["Y",$D(LRZX(1)) S LREND=1 Q
I %'["Y" K LROT(LRSAMP,LRSPEC,LRSPN),J(LRSPN) S LRM=LRM-1 Q
Q
SETT ;
S LRODT2=LRODT
NEW LRODT
S X2=-LRMAX2,X1=LRODT2 D C^%DTC S LRODT=X
S X2=LRMAX2,X1=LRODT2 D C^%DTC S LRODT1=X
F LRX=0:0 S LRODT=$O(^LRO(69,"AT",LRDFN,LRTY,LRSPEC,LRODT)) Q:LRODT=""!(LRODT>LRODT1) D
. S LRSN=0 F S LRSN=$O(^LRO(69,LRODT,1,"AA",LRDFN,LRSN)) Q:LRSN<1 D
.. D ORDER^LROS
K LRODT1,LRX,LRODT2
Q
% R %:DTIME S:'$T %="N" Q:%=""!($E(%)="Y")!($E(%)="N") W !,"Answer 'Y' or 'N' " G %
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRORD2A 1637 printed Dec 13, 2024@02:18:52 Page 2
LRORD2A ;SLC/FHS - CHECK FOR MAX FREQ OF ORDERS ;2/6/91 13:00
+1 ;;5.2;LAB SERVICE;**56,100,153**;Sep 27, 1994
SING ;
+1 if $GET(LRORDRR)="R"
QUIT
+2 KILL LRZX
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 LRSPN=0
FOR
SET LRSPN=$ORDER(LROT(LRSAMP,LRSPEC,LRSPN))
if LRSPN<1
QUIT
SET LRTY=+LROT(LRSAMP,LRSPEC,LRSPN)
DO MAX
+3 QUIT
MAX ;Check max in a single day
+1 if 'LRTY!('$DATA(^LAB(60,LRTY,3,"B",LRSAMP)))
QUIT
SET LRMAXX=^LAB(60,LRTY,3,$ORDER(^LAB(60,LRTY,3,"B",LRSAMP,0)),0)
CHK SET LRMAX1=+$PIECE(LRMAXX,U,7)
IF LRMAX1
IF $DATA(TT(LRTY,LRSPEC))
IF TT(LRTY,LRSPEC)'<LRMAX1
DO EN1^LRORDD
IF %'["Y"
DO SCRUB
if LREND
QUIT
+1 SET LRMAX2=+$PIECE(LRMAXX,U,5)
if LRMAX2
DO NEW
+2 QUIT
NEW ;Check max for number of days
+1 KILL LRDAX
SET X1=$ORDER(^LRO(69,"AT",LRDFN,LRTY,LRSPEC,LRODT-1))
SET Y=$ORDER(^(-LRODT-1))
+2 IF X1
SET X2=LRODT
DO ^%DTC
if X<LRMAX2
SET LRDAX(2)=X
+3 IF Y
SET X2=-Y
SET X1=LRODT
DO ^%DTC
if X<LRMAX2
SET LRDAX(1)=X
+4 if '$DATA(LRDAX)
QUIT
WRITE !!,$PIECE(^LAB(60,LRTY,0),U)," Exceeds maximum order FREQUENCY of 1 every ",LRMAX2," day(s)."
+5 DO SETT
+6 WRITE !,"Do You really want another N// "
DO %
if %["Y"
QUIT
SCRUB ;
+1 IF %'["Y"
IF $DATA(LRTEST)
IF $DATA(LRTSTN)
KILL LRTEST(LRTSTN),X3
QUIT
+2 IF %'["Y"
IF $DATA(LRZX(1))
SET LREND=1
QUIT
+3 IF %'["Y"
KILL LROT(LRSAMP,LRSPEC,LRSPN),J(LRSPN)
SET LRM=LRM-1
QUIT
+4 QUIT
SETT ;
+1 SET LRODT2=LRODT
+2 NEW LRODT
+3 SET X2=-LRMAX2
SET X1=LRODT2
DO C^%DTC
SET LRODT=X
+4 SET X2=LRMAX2
SET X1=LRODT2
DO C^%DTC
SET LRODT1=X
+5 FOR LRX=0:0
SET LRODT=$ORDER(^LRO(69,"AT",LRDFN,LRTY,LRSPEC,LRODT))
if LRODT=""!(LRODT>LRODT1)
QUIT
Begin DoDot:1
+6 SET LRSN=0
FOR
SET LRSN=$ORDER(^LRO(69,LRODT,1,"AA",LRDFN,LRSN))
if LRSN<1
QUIT
Begin DoDot:2
+7 DO ORDER^LROS
End DoDot:2
End DoDot:1
+8 KILL LRODT1,LRX,LRODT2
+9 QUIT
% READ %:DTIME
if '$TEST
SET %="N"
if %=""!($EXTRACT(%)="Y")!($EXTRACT(%)="N")
QUIT
WRITE !,"Answer 'Y' or 'N' "
GOTO %
