source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGQESC0.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.4 KB
Line 
1DGQESC0 ;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 ;
5SDATE() ; -- 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 ;
22EDATE(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 ;
41XDAYS ; 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 ;
59END ; -- End of Code
60 Q
61 ;
Note: See TracBrowser for help on using the repository browser.