LRDATEDH ;DALISC/DRH - DATE RANGE FOR LRRS 1-14-94
;;5.2;LAB SERVICE;;Sep 27, 1994
;;V1
CONTROL ;
D LRSD
I 'OK S LREND=1 QUIT
D LRED
I 'OK S LREND=1 QUIT
Q
LRSD ;
N X1,X2,X
S OK=1
K DIR
S DIR(0)="D"
S DIR("A")="Please enter the BEGINNING DATE here"
S DIR("?",1)=" Date:"
S DIR("?",2)=" Date can be T for Today"
S DIR("?",3)=" T+1 for Tommorrow"
S DIR("?",4)=" T-1 for Yesterday"
S DIR("?",5)=" OR the date 10-12-93"
S DIR("?")=" "
S DIR("B")="T-30"
D ^DIR
I $D(DTOUT)!($D(DUOUT)) S OK=0 QUIT
I $L(X)=2 D HLPDT Q:'OK G CONTROL QUIT
I $E(Y,1,1)'=2 D HLPDT Q:'OK G CONTROL QUIT
I $L(Y)'<7 D
. W " ",$$FMTE^XLFDT(Y,"4D")
. S X1=Y,X2=-1
. D C^%DTC
. S LRSDT=X
Q
HLPDT ;
W !,"Insufficient data entered."
W !,"TYPE ? FOR HELP ",$C(7)
Q
LRED ;
S OK=1
K DIR
S DIR(0)="D"
S DIR("A")="Please enter the LAST DATE here"
S DIR("?",1)=" Date:"
S DIR("?",2)=" Date can be T for Today"
S DIR("?",3)=" T+1 for Tommorrow"
S DIR("?",4)=" T-1 for Yesterday"
S DIR("?",5)=" OR the date 10-12-93"
S DIR("?")=" "
S DIR("B")="TODAY"
D ^DIR
I $D(DTOUT)!($D(DUOUT)) S OK=0 QUIT
I $L(X)=2 D HLPDT Q:'OK G LRED Q
I $E(Y,1,1)'=2 D HLPDT Q:'OK G LRED QUIT
I $L(Y)'<7 S LREDT=Y
W " ",$$FMTE^XLFDT(Y,"4D")
I LRSDT>LREDT D NONO G CONTROL Q
Q
NONO W !!,"THE LAST DATE MUST BE AFTER THE BEGINNING DATE!",$C(7),$C(7)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRDATEDH 1484 printed Dec 13, 2024@02:13:52 Page 2
LRDATEDH ;DALISC/DRH - DATE RANGE FOR LRRS 1-14-94
+1 ;;5.2;LAB SERVICE;;Sep 27, 1994
+2 ;;V1
CONTROL ;
+1 DO LRSD
+2 IF 'OK
SET LREND=1
QUIT
+3 DO LRED
+4 IF 'OK
SET LREND=1
QUIT
+5 QUIT
LRSD ;
+1 NEW X1,X2,X
+2 SET OK=1
+3 KILL DIR
+4 SET DIR(0)="D"
+5 SET DIR("A")="Please enter the BEGINNING DATE here"
+6 SET DIR("?",1)=" Date:"
+7 SET DIR("?",2)=" Date can be T for Today"
+8 SET DIR("?",3)=" T+1 for Tommorrow"
+9 SET DIR("?",4)=" T-1 for Yesterday"
+10 SET DIR("?",5)=" OR the date 10-12-93"
+11 SET DIR("?")=" "
+12 SET DIR("B")="T-30"
+13 DO ^DIR
+14 IF $DATA(DTOUT)!($DATA(DUOUT))
SET OK=0
QUIT
+15 IF $LENGTH(X)=2
DO HLPDT
if 'OK
QUIT
GOTO CONTROL
QUIT
+16 IF $EXTRACT(Y,1,1)'=2
DO HLPDT
if 'OK
QUIT
GOTO CONTROL
QUIT
+17 IF $LENGTH(Y)'<7
Begin DoDot:1
+18 WRITE " ",$$FMTE^XLFDT(Y,"4D")
+19 SET X1=Y
SET X2=-1
+20 DO C^%DTC
+21 SET LRSDT=X
End DoDot:1
+22 QUIT
HLPDT ;
+1 WRITE !,"Insufficient data entered."
+2 WRITE !,"TYPE ? FOR HELP ",$CHAR(7)
+3 QUIT
LRED ;
+1 SET OK=1
+2 KILL DIR
+3 SET DIR(0)="D"
+4 SET DIR("A")="Please enter the LAST DATE here"
+5 SET DIR("?",1)=" Date:"
+6 SET DIR("?",2)=" Date can be T for Today"
+7 SET DIR("?",3)=" T+1 for Tommorrow"
+8 SET DIR("?",4)=" T-1 for Yesterday"
+9 SET DIR("?",5)=" OR the date 10-12-93"
+10 SET DIR("?")=" "
+11 SET DIR("B")="TODAY"
+12 DO ^DIR
+13 IF $DATA(DTOUT)!($DATA(DUOUT))
SET OK=0
QUIT
+14 IF $LENGTH(X)=2
DO HLPDT
if 'OK
QUIT
GOTO LRED
QUIT
+15 IF $EXTRACT(Y,1,1)'=2
DO HLPDT
if 'OK
QUIT
GOTO LRED
QUIT
+16 IF $LENGTH(Y)'<7
SET LREDT=Y
+17 WRITE " ",$$FMTE^XLFDT(Y,"4D")
+18 IF LRSDT>LREDT
DO NONO
GOTO CONTROL
QUIT
+19 QUIT
NONO WRITE !!,"THE LAST DATE MUST BE AFTER THE BEGINNING DATE!",$CHAR(7),$CHAR(7)
+1 QUIT
