| 1 | PRCPURS2 ;WISC/RFJ-select dates ;24 May 93
|
|---|
| 2 | ;;5.1;IFCAP;**84**;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | DATESEL(V1) ; select starting and ending dates in days
|
|---|
| 8 | ; returns datestrt and dateend
|
|---|
| 9 | N %,%DT,%H,%I,DEFAULT,X,Y
|
|---|
| 10 | K DATEEND,DATESTRT
|
|---|
| 11 | START S Y=$E(DT,1,5)_"01" D DD^%DT S DEFAULT=Y
|
|---|
| 12 | S %DT("A")="Start with "_$S(V1'="":V1_" ",1:"")_"Date: ",%DT("B")=DEFAULT,%DT="AEP",%DT(0)=-DT D ^%DT I Y<0 Q
|
|---|
| 13 | I $E(Y,6,7)="00" S Y=$E(Y,1,5)_"01"
|
|---|
| 14 | S DATESTRT=Y
|
|---|
| 15 | S Y=DT D DD^%DT S DEFAULT=Y
|
|---|
| 16 | S %DT("A")=" End with "_$S(V1'="":V1_" ",1:"")_"Date: ",%DT("B")=DEFAULT,%DT="AEP",%DT(0)=-DT D ^%DT I Y<0 Q
|
|---|
| 17 | I $E(Y,6,7)="00" S Y=$E(Y,1,5)_"01"
|
|---|
| 18 | I Y<DATESTRT W !,"END DATE MUST BE GREATER THAN OR EQUAL TO THE START DATE.",! G START
|
|---|
| 19 | S DATEEND=Y,Y=DATESTRT D DD^%DT
|
|---|
| 20 | W !?5,"*** Selected date range from ",Y," to " S Y=DATEEND D DD^%DT W Y," ***"
|
|---|
| 21 | Q
|
|---|
| 22 | ;
|
|---|
| 23 | ;
|
|---|
| 24 | MONTHSEL ; select starting and ending dates in months
|
|---|
| 25 | ; returns datestrt and dateend
|
|---|
| 26 | ; modified 5/27/05 to actually restrict selections to month & year
|
|---|
| 27 | ; and return DATESTRT as 1st of beginning month and DATEEND as last day of ending month. - T. Holloway
|
|---|
| 28 | N %,%DT,%H,%I,DEFAULT,PRCLP,PRCMN,X,Y
|
|---|
| 29 | K DATEEND,DATESTRT
|
|---|
| 30 | START1 S X1=DT,X2=-90 D C^%DTC S Y=$E(X,1,5)_"00" D DD^%DT S DEFAULT=Y
|
|---|
| 31 | S %DT("A")="Start with Date: ",%DT("B")=DEFAULT,%DT="AEPM",%DT(0)=-DT D ^%DT I Y<0 Q
|
|---|
| 32 | S DATESTRT=Y
|
|---|
| 33 | S Y=$E(DT,1,5)_"00" D DD^%DT S DEFAULT=Y
|
|---|
| 34 | S %DT("A")=" End with Date: ",%DT("B")=DEFAULT,%DT="AEPM",%DT(0)=-DT D ^%DT I Y<0 Q
|
|---|
| 35 | I Y<DATESTRT W !,"END DATE MUST BE GREATER THAN OR EQUAL TO THE START DATE.",! G START1
|
|---|
| 36 | S PRCLP=$$LEAP^DIDTC($E(Y,1,3)),PRCMN=+$E(Y,4,5),DATESTRT=DATESTRT+1
|
|---|
| 37 | 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
|
|---|
| 38 | S:PRCMN=2 DATEEND=DATEEND+PRCLP ; if February and Leap Year, add 1 to get 29th
|
|---|
| 39 | S:DATEEND>DT DATEEND=DT-1 ; if end month is current month, set DATEEND to yesterday
|
|---|
| 40 | I $E(DATEEND,6,7)="00" W !," You may not include the current month until at least 1 full day",!," has passed.",! G START1
|
|---|
| 41 | S Y=DATESTRT D DD^%DT
|
|---|
| 42 | W !?5,"*** Selected date range from ",Y," to " S Y=DATEEND D DD^%DT W Y," ***"
|
|---|
| 43 | Q
|
|---|
