source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRDT.m@ 702

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

initial load of WorldVistAEHR

File size: 2.3 KB
RevLine 
[613]1RMPRDT ;PHX/JLT,RVD-ASK DATE RANGE ;8/29/1994
2 ;;3.0;PROSTHETICS;**40**;Feb 09, 1996
3 D FQ G:(RMPRFY["^")!(RMPRQTR["^") END K RMPRN,^TMP($J)
4QTR I DT<$E(DT,1)_RMPRFY_"1001",RMPRQTR=1 S X1=$E(DT,1)_RMPRFY_"1001",X2=-365 S $E(X1,1)=$S(RMPRFY>50:2,1:3) D G:$D(RMPRNA) NSK G DATE
5 .D C^%DTC S RMPRN=$E(X,1,3)_"1001" S (RY,Y)=RMPRN D DD^%DT S DATE(1)=RY,%DT("B")=Y
6 S (RY,Y)=$S(RMPRQTR=1:$E(DT,1)_RMPRFY_"1001",RMPRQTR=2:$E(DT,1)_RMPRFY_"0101",RMPRQTR=3:$E(DT,1)_RMPRFY_"0401",RMPRQTR=4:$E(DT,1)_RMPRFY_"0701")
7 S $E(RY,1)=$S(RMPRFY>50:2,1:3),Y=RY
8 D DD^%DT S %DT("B")=Y I $D(RMPRNA) S DATE(1)=RY G NSK
9DATE S %DT="XEA",%DT("A")="Enter Start Date: " D ^%DT G:X[U!(X="")!($D(DTOUT)) END
10 S DATE(1)=+Y
11NSK I $D(RMPRN) S (RY,Y)=$E(RMPRN,1,3)_"1231" D DD^%DT S %DT("B")=Y S DATE(2)=RY G:$D(RMPRNA) EXIT G EDATE
12 S (RY,Y)=$S(RMPRQTR=1:$E(DT,1)_RMPRFY+1_"0930",RMPRQTR=2:$E(DT,1)_RMPRFY_"0331",RMPRQTR=3:$E(DT,1)_RMPRFY_"0630",RMPRQTR=4:$E(DT,1)_RMPRFY_"0930")
13 S $E(RY,1)=$S(RMPRFY>50:2,1:3),Y=RY
14 D DD^%DT S %DT("B")=Y I $D(RMPRNA) S DATE(2)=+RY G EXIT
15EDATE S %DT="XEA",%DT("A")="Enter End Date: " D ^%DT G:X[U!(X="")!($D(DTOUT)) END S DATE(2)=+Y
16 I DATE(1)>DATE(2) W !!,$C(7),"ENDING DATE RANGE IS LESS THAN BEGINNING DATE RANGE",! G QTR
17EXIT K %DT,RMPRN,DTOUT,X,X1,RY Q
18END K DATE,%DT,RMPRN,DTOUT,RMPRFY,RMPRQTR Q
19FQ ;GET CURRENT FISCAL YEAR AND QUARTER
20 D:'$D(DT) DT^DICRW
21 S RMPRFY=$E(DT,2,3) I $E(DT,4,7)>1000 S RMPRFY=RMPRFY+1
22 S RMPRFY=$S($L(RMPRFY)>2:$E(RMPRFY,2,3),$L(RMPRFY)<2:RMPRFY=0_RMPRFY,1:RMPRFY)
23 S RMPRQTR=$P("2^2^2^3^3^3^4^4^4^1^1^1","^",$E(DT,4,5)) Q:$D(RMPRWO)
24FY W !,"Select FISCAL YEAR: ",RMPRFY,"// " R X:DTIME S:'$T!(X="^") RMPRFY="^" Q:RMPRFY="^" S:X="" X=RMPRFY I X'?2N W $C(7),!,"Enter a two digit fiscal year (e.g., 93).",! G FY
25QT W !,"Select QUARTER: ",RMPRQTR,"// " R X1:DTIME S:'$T!(X1["^") RMPRQTR="^" Q:RMPRQTR="^" S:X1="" X1=RMPRQTR I X1'?1N!(X1>4)!(X1=0) W $C(7),!,"Enter a single digit number from 1 to 4.",! G QT
26 S RMPRFY=X,RMPRQTR=X1 Q
27ST ;GET DATE RANGE
28 D DIV4^RMPRSIT I $D(X) S QUIT=1 Q
29RDATE S %DT="XEA",%DT("A")="Enter Start Date: " D ^%DT I X[U!(X="")!($D(DTOUT)) S QUIT=1 Q
30 S DATE(1)=+Y
31 S %DT="XEA",%DT("A")="Enter End Date: " D ^%DT I X[U!(X="")!($D(DTOUT)) S QUIT=1 Q
32 S DATE(2)=+Y
33 I DATE(1)>DATE(2) W !!,$C(7),"ENDING DATE RANGE IS LESS THAN BEGINNING DATE RANGE",! G RDATE
34 Q
Note: See TracBrowser for help on using the repository browser.