BLRORD2A.m

BLRORD2A ;SLC/FHS/TPF - CHECK FOR MAX FREQ OF ORDERS ;2/6/91  13:00 [ 08/01/2002  8:21 AM ]

 ;;5.2;LR;**1013**;JUL 30,2002

 ;

 ;;5.2;LAB SERVICE;**56,100**;Sep 27, 1994

SING ;

 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 %

BLRORD2A  ;SLC/FHS/TPF - CHECK FOR MAX FREQ OF ORDERS ;2/6/91  13:00 [ 08/01/2002  8:21 AM ]

 +1       ;;5.2;LR;**1013**;JUL 30,2002

 +2       ;

 +3       ;;5.2;LAB SERVICE;**56,100**;Sep 27, 1994

SING      ;

 +1        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

 +2        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 %