source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRDATEDH.m@ 823

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

initial load of WorldVistAEHR

File size: 1.4 KB
RevLine 
[613]1LRDATEDH ;DALISC/DRH - DATE RANGE FOR LRRS 1-14-94
2 ;;5.2;LAB SERVICE;;Sep 27, 1994
3 ;;V1
4CONTROL ;
5 D LRSD
6 I 'OK S LREND=1 QUIT
7 D LRED
8 I 'OK S LREND=1 QUIT
9 Q
10LRSD ;
11 N X1,X2,X
12 S OK=1
13 K DIR
14 S DIR(0)="D"
15 S DIR("A")="Please enter the BEGINNING DATE here"
16 S DIR("?",1)=" Date:"
17 S DIR("?",2)=" Date can be T for Today"
18 S DIR("?",3)=" T+1 for Tommorrow"
19 S DIR("?",4)=" T-1 for Yesterday"
20 S DIR("?",5)=" OR the date 10-12-93"
21 S DIR("?")=" "
22 S DIR("B")="T-30"
23 D ^DIR
24 I $D(DTOUT)!($D(DUOUT)) S OK=0 QUIT
25 I $L(X)=2 D HLPDT Q:'OK G CONTROL QUIT
26 I $E(Y,1,1)'=2 D HLPDT Q:'OK G CONTROL QUIT
27 I $L(Y)'<7 D
28 . W " ",$$FMTE^XLFDT(Y,"4D")
29 . S X1=Y,X2=-1
30 . D C^%DTC
31 . S LRSDT=X
32 Q
33HLPDT ;
34 W !,"Insufficient data entered."
35 W !,"TYPE ? FOR HELP ",$C(7)
36 Q
37LRED ;
38 S OK=1
39 K DIR
40 S DIR(0)="D"
41 S DIR("A")="Please enter the LAST DATE here"
42 S DIR("?",1)=" Date:"
43 S DIR("?",2)=" Date can be T for Today"
44 S DIR("?",3)=" T+1 for Tommorrow"
45 S DIR("?",4)=" T-1 for Yesterday"
46 S DIR("?",5)=" OR the date 10-12-93"
47 S DIR("?")=" "
48 S DIR("B")="TODAY"
49 D ^DIR
50 I $D(DTOUT)!($D(DUOUT)) S OK=0 QUIT
51 I $L(X)=2 D HLPDT Q:'OK G LRED Q
52 I $E(Y,1,1)'=2 D HLPDT Q:'OK G LRED QUIT
53 I $L(Y)'<7 S LREDT=Y
54 W " ",$$FMTE^XLFDT(Y,"4D")
55 I LRSDT>LREDT D NONO G CONTROL Q
56 Q
57NONO W !!,"THE LAST DATE MUST BE AFTER THE BEGINNING DATE!",$C(7),$C(7)
58 Q
Note: See TracBrowser for help on using the repository browser.