source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRORD2A.m@ 767

Last change on this file since 767 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.6 KB
Line 
1LRORD2A ;SLC/FHS - CHECK FOR MAX FREQ OF ORDERS ;2/6/91 13:00
2 ;;5.2;LAB SERVICE;**56,100,153**;Sep 27, 1994
3SING ;
4 Q:$G(LRORDRR)="R"
5 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
6 Q
7MAX ;Check max in a single day
8 Q:'LRTY!('$D(^LAB(60,LRTY,3,"B",LRSAMP))) S LRMAXX=^LAB(60,LRTY,3,$O(^LAB(60,LRTY,3,"B",LRSAMP,0)),0)
9CHK 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
10 S LRMAX2=+$P(LRMAXX,U,5) D:LRMAX2 NEW
11 Q
12NEW ;Check max for number of days
13 K LRDAX S X1=$O(^LRO(69,"AT",LRDFN,LRTY,LRSPEC,LRODT-1)),Y=$O(^(-LRODT-1))
14 I X1 S X2=LRODT D ^%DTC S:X<LRMAX2 LRDAX(2)=X
15 I Y S X2=-Y,X1=LRODT D ^%DTC S:X<LRMAX2 LRDAX(1)=X
16 Q:'$D(LRDAX) W !!,$P(^LAB(60,LRTY,0),U)," Exceeds maximum order FREQUENCY of 1 every ",LRMAX2," day(s)."
17 D SETT
18 W !,"Do You really want another N// " D % Q:%["Y"
19SCRUB ;
20 I %'["Y",$D(LRTEST),$D(LRTSTN) K LRTEST(LRTSTN),X3 Q
21 I %'["Y",$D(LRZX(1)) S LREND=1 Q
22 I %'["Y" K LROT(LRSAMP,LRSPEC,LRSPN),J(LRSPN) S LRM=LRM-1 Q
23 Q
24SETT ;
25 S LRODT2=LRODT
26 NEW LRODT
27 S X2=-LRMAX2,X1=LRODT2 D C^%DTC S LRODT=X
28 S X2=LRMAX2,X1=LRODT2 D C^%DTC S LRODT1=X
29 F LRX=0:0 S LRODT=$O(^LRO(69,"AT",LRDFN,LRTY,LRSPEC,LRODT)) Q:LRODT=""!(LRODT>LRODT1) D
30 . S LRSN=0 F S LRSN=$O(^LRO(69,LRODT,1,"AA",LRDFN,LRSN)) Q:LRSN<1 D
31 .. D ORDER^LROS
32 K LRODT1,LRX,LRODT2
33 Q
34% R %:DTIME S:'$T %="N" Q:%=""!($E(%)="Y")!($E(%)="N") W !,"Answer 'Y' or 'N' " G %
Note: See TracBrowser for help on using the repository browser.