source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPURS2.m@ 1078

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

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1PRCPURS2 ;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 ;
7DATESEL(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
11START 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 ;
24MONTHSEL ; 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
30START1 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
Note: See TracBrowser for help on using the repository browser.