source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCRIA1.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: 2.3 KB
Line 
1PRCRIA1 ;TPA/RAK/WASH IRMFO - Date Range ;8/27/96 15:37
2 ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4DATERNG(EARLY,LATE) ;Extrinsic Function - returns start & end dates
5 ;---------------------------------------------------------------------
6 ; DATE - Value returned in four pieces.
7 ;
8 ; fmstartdate^fmenddate^ouputstartdate^outputenddate
9 ;
10 ; Piece one and two are the date ranges in fileman format.
11 ; Piece three and four are the same dates in output format:
12 ; dy-Mon-yr
13 ;
14 ; ********
15 ; * NOTE *
16 ; ********
17 ; - The first piece will always be the earliest date entered.
18 ;
19 ; - The second piece 'ending date' will have .999 concatenated
20 ; to the end of it for fileman sorting purposes. Strip this
21 ; off if not needed. Ex: S $P(DATE,U,2)=$P($P(DATE,U,2),"."
22 ;
23 ; Optional Parameters:
24 ;
25 ; EARLY - If defined, the earliest date that may be selected.
26 ; (must be in fileman format)
27 ;
28 ; LATE - If defined, the latest date that may be selected.
29 ; (must be in fileman format)
30 ;---------------------------------------------------------------------
31 N DATE,DATE1,DATE2,DIR,DIRUT,LINE,X,Y
32 S DATE="",EARLY=$G(EARLY),LATE=$G(LATE)
33RANGE ;Ask date ranges
34 S DIR(0)="DOA^"_$S(EARLY:EARLY,1:"")_":"_$S(LATE:LATE,1:"")_":E)"
35 S DIR("A")="Start with Date: "
36 S DIR("?")=" "
37 S DIR("?",1)="Enter the starting date.",LINE=2
38 I EARLY S DIR("?",LINE)="Date must not precede "_$$FMTE^XLFDT(EARLY),LINE=LINE+1
39 I LATE S DIR("?",LINE)="Date must not follow "_$$FMTE^XLFDT(LATE)
40 W ! D ^DIR I $D(DIRUT) Q ""
41 S DATE1=Y,DIR("A")=" End with Date: "
42 S DIR("?",1)="Enter the ending date."
43 D ^DIR W:Y="" !!,"You must enter an 'End with Date'" G:Y="" RANGE I Y="^" Q ""
44 S DATE2=Y,Y=1 I DATE1=DATE2 K DIR D
45 .S DIR(0)="YO",DIR("A")="Are you asking for just one days data"
46 .S DIR("B")="Y" W ! D ^DIR K DIR
47 I Y="^" Q ""
48 I Y'=1 G RANGE
49 ; Set earliest date into first piece.
50 S DATE=$S(DATE2<DATE1:DATE2,1:DATE1)_U_$S(DATE2>DATE1:DATE2,1:DATE1)
51 S $P(DATE,U,3)=$$FMTE^XLFDT($P(DATE,U))
52 S $P(DATE,U,4)=$$FMTE^XLFDT($P(DATE,U,2))
53 S $P(DATE,U,2)=$P(DATE,U,2)_.999
54 Q DATE
Note: See TracBrowser for help on using the repository browser.