LRDATEDH.m

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 ---LRDATEDH   1484     printed  Apr 09, 2024@21:12:29                                                                                                                                                                                                    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