PRCRIA1 ;TPA/RAK/WASH IRMFO - Date Range ;8/27/96 15:37
;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
DATERNG(EARLY,LATE) ;Extrinsic Function - returns start & end dates
;---------------------------------------------------------------------
; DATE - Value returned in four pieces.
;
; fmstartdate^fmenddate^ouputstartdate^outputenddate
;
; Piece one and two are the date ranges in fileman format.
; Piece three and four are the same dates in output format:
; dy-Mon-yr
;
; ********
; * NOTE *
; ********
; - The first piece will always be the earliest date entered.
;
; - The second piece 'ending date' will have .999 concatenated
; to the end of it for fileman sorting purposes. Strip this
; off if not needed. Ex: S $P(DATE,U,2)=$P($P(DATE,U,2),"."
;
; Optional Parameters:
;
; EARLY - If defined, the earliest date that may be selected.
; (must be in fileman format)
;
; LATE - If defined, the latest date that may be selected.
; (must be in fileman format)
;---------------------------------------------------------------------
N DATE,DATE1,DATE2,DIR,DIRUT,LINE,X,Y
S DATE="",EARLY=$G(EARLY),LATE=$G(LATE)
RANGE ;Ask date ranges
S DIR(0)="DOA^"_$S(EARLY:EARLY,1:"")_":"_$S(LATE:LATE,1:"")_":E)"
S DIR("A")="Start with Date: "
S DIR("?")=" "
S DIR("?",1)="Enter the starting date.",LINE=2
I EARLY S DIR("?",LINE)="Date must not precede "_$$FMTE^XLFDT(EARLY),LINE=LINE+1
I LATE S DIR("?",LINE)="Date must not follow "_$$FMTE^XLFDT(LATE)
W ! D ^DIR I $D(DIRUT) Q ""
S DATE1=Y,DIR("A")=" End with Date: "
S DIR("?",1)="Enter the ending date."
D ^DIR W:Y="" !!,"You must enter an 'End with Date'" G:Y="" RANGE I Y="^" Q ""
S DATE2=Y,Y=1 I DATE1=DATE2 K DIR D
.S DIR(0)="YO",DIR("A")="Are you asking for just one days data"
.S DIR("B")="Y" W ! D ^DIR K DIR
I Y="^" Q ""
I Y'=1 G RANGE
; Set earliest date into first piece.
S DATE=$S(DATE2<DATE1:DATE2,1:DATE1)_U_$S(DATE2>DATE1:DATE2,1:DATE1)
S $P(DATE,U,3)=$$FMTE^XLFDT($P(DATE,U))
S $P(DATE,U,4)=$$FMTE^XLFDT($P(DATE,U,2))
S $P(DATE,U,2)=$P(DATE,U,2)_.999
Q DATE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCRIA1 2393 printed Dec 13, 2024@02:16:59 Page 2
PRCRIA1 ;TPA/RAK/WASH IRMFO - Date Range ;8/27/96 15:37
+1 ;;5.1;IFCAP;;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
DATERNG(EARLY,LATE) ;Extrinsic Function - returns start & end dates
+1 ;---------------------------------------------------------------------
+2 ; DATE - Value returned in four pieces.
+3 ;
+4 ; fmstartdate^fmenddate^ouputstartdate^outputenddate
+5 ;
+6 ; Piece one and two are the date ranges in fileman format.
+7 ; Piece three and four are the same dates in output format:
+8 ; dy-Mon-yr
+9 ;
+10 ; ********
+11 ; * NOTE *
+12 ; ********
+13 ; - The first piece will always be the earliest date entered.
+14 ;
+15 ; - The second piece 'ending date' will have .999 concatenated
+16 ; to the end of it for fileman sorting purposes. Strip this
+17 ; off if not needed. Ex: S $P(DATE,U,2)=$P($P(DATE,U,2),"."
+18 ;
+19 ; Optional Parameters:
+20 ;
+21 ; EARLY - If defined, the earliest date that may be selected.
+22 ; (must be in fileman format)
+23 ;
+24 ; LATE - If defined, the latest date that may be selected.
+25 ; (must be in fileman format)
+26 ;---------------------------------------------------------------------
+27 NEW DATE,DATE1,DATE2,DIR,DIRUT,LINE,X,Y
+28 SET DATE=""
SET EARLY=$GET(EARLY)
SET LATE=$GET(LATE)
RANGE ;Ask date ranges
+1 SET DIR(0)="DOA^"_$SELECT(EARLY:EARLY,1:"")_":"_$SELECT(LATE:LATE,1:"")_":E)"
+2 SET DIR("A")="Start with Date: "
+3 SET DIR("?")=" "
+4 SET DIR("?",1)="Enter the starting date."
SET LINE=2
+5 IF EARLY
SET DIR("?",LINE)="Date must not precede "_$$FMTE^XLFDT(EARLY)
SET LINE=LINE+1
+6 IF LATE
SET DIR("?",LINE)="Date must not follow "_$$FMTE^XLFDT(LATE)
+7 WRITE !
DO ^DIR
IF $DATA(DIRUT)
QUIT ""
+8 SET DATE1=Y
SET DIR("A")=" End with Date: "
+9 SET DIR("?",1)="Enter the ending date."
+10 DO ^DIR
if Y=""
WRITE !!,"You must enter an 'End with Date'"
if Y=""
GOTO RANGE
IF Y="^"
QUIT ""
+11 SET DATE2=Y
SET Y=1
IF DATE1=DATE2
KILL DIR
Begin DoDot:1
+12 SET DIR(0)="YO"
SET DIR("A")="Are you asking for just one days data"
+13 SET DIR("B")="Y"
WRITE !
DO ^DIR
KILL DIR
End DoDot:1
+14 IF Y="^"
QUIT ""
+15 IF Y'=1
GOTO RANGE
+16 ; Set earliest date into first piece.
+17 SET DATE=$SELECT(DATE2<DATE1:DATE2,1:DATE1)_U_$SELECT(DATE2>DATE1:DATE2,1:DATE1)
+18 SET $PIECE(DATE,U,3)=$$FMTE^XLFDT($PIECE(DATE,U))
+19 SET $PIECE(DATE,U,4)=$$FMTE^XLFDT($PIECE(DATE,U,2))
+20 SET $PIECE(DATE,U,2)=$PIECE(DATE,U,2)_.999
+21 QUIT DATE
