- 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 Mar 13, 2025@21:18:12 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
