1 | DGQESC0 ;ALB/JFP - VIC CLINIC SCAN ROUTINE ; 01/09/96
|
---|
2 | ;;V5.3;REGISTRATION;**73**;DEC 11,1996
|
---|
3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | ;
|
---|
5 | SDATE() ; -- Call to Dir to request start date
|
---|
6 | ;
|
---|
7 | N DIR,X,Y,DTOUT,DUOUT,DIROUT,DIRUT
|
---|
8 | ;
|
---|
9 | S DIR("A")="Start Date: "
|
---|
10 | S Y=DT X ^DD("DD")
|
---|
11 | S DIR("B")=Y
|
---|
12 | S DIR(0)="DAO^::EX^"
|
---|
13 | S DIR("?")=" - Enter date to start search, the default is today"
|
---|
14 | D ^DIR K DIR
|
---|
15 | ; -- up arrow/timeout
|
---|
16 | I ($D(DTOUT)!$D(DUOUT)!$D(DIROUT)) Q -1
|
---|
17 | ; -- null response
|
---|
18 | I $D(DIRUT) K DTOUT,DUOUT,DIROUT,DIRUT Q 1
|
---|
19 | ; -- returns start date
|
---|
20 | Q Y
|
---|
21 | ;
|
---|
22 | EDATE(PDATE) ; -- Call to Dir to request start date
|
---|
23 | ;
|
---|
24 | N DIR,X,Y,DTOUT,DUOUT,DIROUT,DIRUT,DEFDATE
|
---|
25 | ;
|
---|
26 | S DIR("A")="End Date: "
|
---|
27 | ;
|
---|
28 | I $D(PDATE) S Y=PDATE X ^DD("DD") S DEFDATE=Y
|
---|
29 | I '$D(PDATE) S (Y,PDATE)=DT X ^DD("DD") S DEFDATE=Y
|
---|
30 | S DIR("B")=DEFDATE
|
---|
31 | S DIR(0)="DAO^"_PDATE_"::%DT"
|
---|
32 | S DIR("?")=" - Enter date to end search,can not be less than start date"
|
---|
33 | D ^DIR K DIR
|
---|
34 | ; -- up arrow/timeout
|
---|
35 | I ($D(DTOUT)!$D(DUOUT)!$D(DIROUT)) Q -1
|
---|
36 | ; -- null response
|
---|
37 | I $D(DIRUT) K DTOUT,DUOUT,DIROUT,DIRUT Q 1
|
---|
38 | ; -- returns end date
|
---|
39 | Q Y
|
---|
40 | ;
|
---|
41 | XDAYS ; Ask how many days to scan for
|
---|
42 | N XFLAG,DIR,Y,X1,X2,X
|
---|
43 | ;
|
---|
44 | S XFLAG=0
|
---|
45 | S DIR(0)="N0^1:90"
|
---|
46 | S DIR("A")="Number of days to scan in advance"
|
---|
47 | S DIR("B")=7
|
---|
48 | S DIR("?")="Enter number of days to scan in advance."
|
---|
49 | D ^DIR
|
---|
50 | I (Y="^") Q
|
---|
51 | S XFLAG=1
|
---|
52 | D NOW^%DTC S (SCANDATE,X1)=%
|
---|
53 | S X2=Y
|
---|
54 | D C^%DTC
|
---|
55 | I X="" Q
|
---|
56 | S SCANDATE=X
|
---|
57 | Q
|
---|
58 | ;
|
---|
59 | END ; -- End of Code
|
---|
60 | Q
|
---|
61 | ;
|
---|