PRCPURS2 ;WISC/RFJ-select dates ;24 May 93

;;5.1;IFCAP;**84**;Oct 20, 2000

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

Q

;

;

DATESEL(V1) ; select starting and ending dates in days

; returns datestrt and dateend

N %,%DT,%H,%I,DEFAULT,X,Y

K DATEEND,DATESTRT

START S Y=$E(DT,1,5)_"01" D DD^%DT S DEFAULT=Y

S %DT("A")="Start with "_$S(V1'="":V1_" ",1:"")_"Date: ",%DT("B")=DEFAULT,%DT="AEP",%DT(0)=-DT D ^%DT I Y<0 Q

I $E(Y,6,7)="00" S Y=$E(Y,1,5)_"01"

S DATESTRT=Y

S Y=DT D DD^%DT S DEFAULT=Y

S %DT("A")=" End with "_$S(V1'="":V1_" ",1:"")_"Date: ",%DT("B")=DEFAULT,%DT="AEP",%DT(0)=-DT D ^%DT I Y<0 Q

I $E(Y,6,7)="00" S Y=$E(Y,1,5)_"01"

I Y<DATESTRT W !,"END DATE MUST BE GREATER THAN OR EQUAL TO THE START DATE.",! G START

S DATEEND=Y,Y=DATESTRT D DD^%DT

W !?5,"*** Selected date range from ",Y," to " S Y=DATEEND D DD^%DT W Y," ***"

Q

;

;

MONTHSEL ; select starting and ending dates in months

; returns datestrt and dateend

; modified 5/27/05 to actually restrict selections to month & year

; and return DATESTRT as 1st of beginning month and DATEEND as last day of ending month. - T. Holloway

N %,%DT,%H,%I,DEFAULT,PRCLP,PRCMN,X,Y

K DATEEND,DATESTRT

START1 S X1=DT,X2=-90 D C^%DTC S Y=$E(X,1,5)_"00" D DD^%DT S DEFAULT=Y

S %DT("A")="Start with Date: ",%DT("B")=DEFAULT,%DT="AEPM",%DT(0)=-DT D ^%DT I Y<0 Q

S DATESTRT=Y

S Y=$E(DT,1,5)_"00" D DD^%DT S DEFAULT=Y

S %DT("A")=" End with Date: ",%DT("B")=DEFAULT,%DT="AEPM",%DT(0)=-DT D ^%DT I Y<0 Q

I Y<DATESTRT W !,"END DATE MUST BE GREATER THAN OR EQUAL TO THE START DATE.",! G START1

S PRCLP=$$LEAP^DIDTC($E(Y,1,3)),PRCMN=+$E(Y,4,5),DATESTRT=DATESTRT+1

S DATEEND=$E(Y,1,5)_$P("31^28^31^30^31^30^31^31^30^31^30^31","^",PRCMN) ; set end date to last day of month

S:PRCMN=2 DATEEND=DATEEND+PRCLP ; if February and Leap Year, add 1 to get 29th

S:DATEEND>DT DATEEND=DT-1 ; if end month is current month, set DATEEND to yesterday

I $E(DATEEND,6,7)="00" W !," You may not include the current month until at least 1 full day",!," has passed.",! G START1

S Y=DATESTRT D DD^%DT

W !?5,"*** Selected date range from ",Y," to " S Y=DATEEND D DD^%DT W Y," ***"

Q

--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPURS2 2214 printed Jan 14, 2022@23:07:40 Page 2

PRCPURS2 ;WISC/RFJ-select dates ;24 May 93

+1 ;;5.1;IFCAP;**84**;Oct 20, 2000

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

+3 QUIT

+4 ;

+5 ;

DATESEL(V1) ; select starting and ending dates in days

+1 ; returns datestrt and dateend

+2 NEW %,%DT,%H,%I,DEFAULT,X,Y

+3 KILL DATEEND,DATESTRT

START SET Y=$EXTRACT(DT,1,5)_"01"

DO DD^%DT

SET DEFAULT=Y

+1 SET %DT("A")="Start with "_$SELECT(V1'="":V1_" ",1:"")_"Date: "

SET %DT("B")=DEFAULT

SET %DT="AEP"

SET %DT(0)=-DT

DO ^%DT

IF Y<0

QUIT

+2 IF $EXTRACT(Y,6,7)="00"

SET Y=$EXTRACT(Y,1,5)_"01"

+3 SET DATESTRT=Y

+4 SET Y=DT

DO DD^%DT

SET DEFAULT=Y

+5 SET %DT("A")=" End with "_$SELECT(V1'="":V1_" ",1:"")_"Date: "

SET %DT("B")=DEFAULT

SET %DT="AEP"

SET %DT(0)=-DT

DO ^%DT

IF Y<0

QUIT

+6 IF $EXTRACT(Y,6,7)="00"

SET Y=$EXTRACT(Y,1,5)_"01"

+7 IF Y<DATESTRT

WRITE !,"END DATE MUST BE GREATER THAN OR EQUAL TO THE START DATE.",!

GOTO START

+8 SET DATEEND=Y

SET Y=DATESTRT

DO DD^%DT

+9 WRITE !?5,"*** Selected date range from ",Y," to "

SET Y=DATEEND

DO DD^%DT

WRITE Y," ***"

+10 QUIT

+11 ;

+12 ;

MONTHSEL ; select starting and ending dates in months

+1 ; returns datestrt and dateend

+2 ; modified 5/27/05 to actually restrict selections to month & year

+3 ; and return DATESTRT as 1st of beginning month and DATEEND as last day of ending month. - T. Holloway

+4 NEW %,%DT,%H,%I,DEFAULT,PRCLP,PRCMN,X,Y

+5 KILL DATEEND,DATESTRT

START1 SET X1=DT

SET X2=-90

DO C^%DTC

SET Y=$EXTRACT(X,1,5)_"00"

DO DD^%DT

SET DEFAULT=Y

+1 SET %DT("A")="Start with Date: "

SET %DT("B")=DEFAULT

SET %DT="AEPM"

SET %DT(0)=-DT

DO ^%DT

IF Y<0

QUIT

+2 SET DATESTRT=Y

+3 SET Y=$EXTRACT(DT,1,5)_"00"

DO DD^%DT

SET DEFAULT=Y

+4 SET %DT("A")=" End with Date: "

SET %DT("B")=DEFAULT

SET %DT="AEPM"

SET %DT(0)=-DT

DO ^%DT

IF Y<0

QUIT

+5 IF Y<DATESTRT

WRITE !,"END DATE MUST BE GREATER THAN OR EQUAL TO THE START DATE.",!

GOTO START1

+6 SET PRCLP=$$LEAP^DIDTC($EXTRACT(Y,1,3))

SET PRCMN=+$EXTRACT(Y,4,5)

SET DATESTRT=DATESTRT+1

+7 ; set end date to last day of month

SET DATEEND=$EXTRACT(Y,1,5)_$PIECE("31^28^31^30^31^30^31^31^30^31^30^31","^",PRCMN)

+8 ; if February and Leap Year, add 1 to get 29th

if PRCMN=2

SET DATEEND=DATEEND+PRCLP

+9 ; if end month is current month, set DATEEND to yesterday

if DATEEND>DT

SET DATEEND=DT-1

+10 IF $EXTRACT(DATEEND,6,7)="00"

WRITE !," You may not include the current month until at least 1 full day",!," has passed.",!

GOTO START1

+11 SET Y=DATESTRT

DO DD^%DT

+12 WRITE !?5,"*** Selected date range from ",Y," to "

SET Y=DATEEND

DO DD^%DT

WRITE Y," ***"

+13 QUIT