- LRORD2A ;SLC/FHS - CHECK FOR MAX FREQ OF ORDERS ;2/6/91 13:00
- ;;5.2T9;LR;**1018**;Nov 17, 2004
- ;;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 %
- LRORD2A ;SLC/FHS - CHECK FOR MAX FREQ OF ORDERS ;2/6/91 13:00
- +1 ;;5.2T9;LR;**1018**;Nov 17, 2004
- +2 ;;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 %
