DGQESC0.m

DGQESC0 ;ALB/JFP - VIC CLINIC SCAN ROUTINE ; 01/09/96

 ;;5.3;REGISTRATION;**73,1015**;DEC 11,1996;Build 21

 ;;Per VHA Directive 10-93-142, this routine should not be modified.

 ;

SDATE() ; -- Call to Dir to request start date

 ;

 N DIR,X,Y,DTOUT,DUOUT,DIROUT,DIRUT

 ;

 S DIR("A")="Start Date: "

 S Y=DT X ^DD("DD")

 S DIR("B")=Y

 S DIR(0)="DAO^::EX^"

 S DIR("?")="  - Enter date to start search, the default is today"

 D ^DIR K DIR

 ; -- up arrow/timeout

 I ($D(DTOUT)!$D(DUOUT)!$D(DIROUT)) Q -1

 ; -- null response

 I $D(DIRUT) K DTOUT,DUOUT,DIROUT,DIRUT Q 1

 ; -- returns start date

 Q Y

 ;

EDATE(PDATE) ; -- Call to Dir to request start date

 ;

 N DIR,X,Y,DTOUT,DUOUT,DIROUT,DIRUT,DEFDATE

 ;

 S DIR("A")="End Date: "

 ;

 I $D(PDATE) S Y=PDATE X ^DD("DD") S DEFDATE=Y

 I '$D(PDATE) S (Y,PDATE)=DT X ^DD("DD") S DEFDATE=Y

 S DIR("B")=DEFDATE

 S DIR(0)="DAO^"_PDATE_"::%DT"

 S DIR("?")="  - Enter date to end search,can not be less than start date"

 D ^DIR K DIR

 ; -- up arrow/timeout

 I ($D(DTOUT)!$D(DUOUT)!$D(DIROUT)) Q -1

 ; -- null response

 I $D(DIRUT) K DTOUT,DUOUT,DIROUT,DIRUT Q 1

 ; -- returns end date

 Q Y

 ;

XDAYS ; Ask how many days to scan for

 N XFLAG,DIR,Y,X1,X2,X

 ;

 S XFLAG=0

 S DIR(0)="N0^1:90"

 S DIR("A")="Number of days to scan in advance"

 S DIR("B")=7

 S DIR("?")="Enter number of days to scan in advance."

 D ^DIR

 I (Y="^") Q

 S XFLAG=1

 D NOW^%DTC S (SCANDATE,X1)=%

 S X2=Y

 D C^%DTC

 I X="" Q

 S SCANDATE=X

 Q

 ;

END ; -- End of Code

 Q

 ;

DGQESC0   ;ALB/JFP - VIC CLINIC SCAN ROUTINE ; 01/09/96

 +1       ;;5.3;REGISTRATION;**73,1015**;DEC 11,1996;Build 21

 +2       ;;Per VHA Directive 10-93-142, this routine should not be modified.

 +3       ;

SDATE()   ; -- Call to Dir to request start date

 +1       ;

 +2        NEW DIR,X,Y,DTOUT,DUOUT,DIROUT,DIRUT

 +3       ;

 +4        SET DIR("A")="Start Date: "

 +5        SET Y=DT

           XECUTE ^DD("DD")

 +6        SET DIR("B")=Y

 +7        SET DIR(0)="DAO^::EX^"

 +8        SET DIR("?")="  - Enter date to start search, the default is today"

 +9        DO ^DIR

           KILL DIR

 +10      ; -- up arrow/timeout

 +11       IF ($DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT))

               QUIT -1

 +12      ; -- null response

 +13       IF $DATA(DIRUT)

               KILL DTOUT,DUOUT,DIROUT,DIRUT

               QUIT 1

 +14      ; -- returns start date

 +15       QUIT Y

 +16      ;

EDATE(PDATE) ; -- Call to Dir to request start date

 +1       ;

 +2        NEW DIR,X,Y,DTOUT,DUOUT,DIROUT,DIRUT,DEFDATE

 +3       ;

 +4        SET DIR("A")="End Date: "

 +5       ;

 +6        IF $DATA(PDATE)

               SET Y=PDATE

               XECUTE ^DD("DD")

               SET DEFDATE=Y

 +7        IF '$DATA(PDATE)

               SET (Y,PDATE)=DT

               XECUTE ^DD("DD")

               SET DEFDATE=Y

 +8        SET DIR("B")=DEFDATE

 +9        SET DIR(0)="DAO^"_PDATE_"::%DT"

 +10       SET DIR("?")="  - Enter date to end search,can not be less than start date"

 +11       DO ^DIR

           KILL DIR

 +12      ; -- up arrow/timeout

 +13       IF ($DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT))

               QUIT -1

 +14      ; -- null response

 +15       IF $DATA(DIRUT)

               KILL DTOUT,DUOUT,DIROUT,DIRUT

               QUIT 1

 +16      ; -- returns end date

 +17       QUIT Y

 +18      ;

XDAYS     ; Ask how many days to scan for

 +1        NEW XFLAG,DIR,Y,X1,X2,X

 +2       ;

 +3        SET XFLAG=0

 +4        SET DIR(0)="N0^1:90"

 +5        SET DIR("A")="Number of days to scan in advance"

 +6        SET DIR("B")=7

 +7        SET DIR("?")="Enter number of days to scan in advance."

 +8        DO ^DIR

 +9        IF (Y="^")

               QUIT 

 +10       SET XFLAG=1

 +11       DO NOW^%DTC

           SET (SCANDATE,X1)=%

 +12       SET X2=Y

 +13       DO C^%DTC

 +14       IF X=""

               QUIT 

 +15       SET SCANDATE=X

 +16       QUIT 

 +17      ;

END       ; -- End of Code

 +1        QUIT 

 +2       ;