Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RMPRDT

RMPRDT.m

Go to the documentation of this file.
  1. RMPRDT ;PHX/JLT,RVD-ASK DATE RANGE ;8/29/1994
  1. ;;3.0;PROSTHETICS;**40**;Feb 09, 1996
  1. D FQ G:(RMPRFY["^")!(RMPRQTR["^") END K RMPRN,^TMP($J)
  1. QTR 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
  1. .D C^%DTC S RMPRN=$E(X,1,3)_"1001" S (RY,Y)=RMPRN D DD^%DT S DATE(1)=RY,%DT("B")=Y
  1. 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")
  1. S $E(RY,1)=$S(RMPRFY>50:2,1:3),Y=RY
  1. D DD^%DT S %DT("B")=Y I $D(RMPRNA) S DATE(1)=RY G NSK
  1. DATE S %DT="XEA",%DT("A")="Enter Start Date: " D ^%DT G:X[U!(X="")!($D(DTOUT)) END
  1. S DATE(1)=+Y
  1. NSK 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
  1. 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")
  1. S $E(RY,1)=$S(RMPRFY>50:2,1:3),Y=RY
  1. D DD^%DT S %DT("B")=Y I $D(RMPRNA) S DATE(2)=+RY G EXIT
  1. EDATE S %DT="XEA",%DT("A")="Enter End Date: " D ^%DT G:X[U!(X="")!($D(DTOUT)) END S DATE(2)=+Y
  1. I DATE(1)>DATE(2) W !!,$C(7),"ENDING DATE RANGE IS LESS THAN BEGINNING DATE RANGE",! G QTR
  1. EXIT K %DT,RMPRN,DTOUT,X,X1,RY Q
  1. END K DATE,%DT,RMPRN,DTOUT,RMPRFY,RMPRQTR Q
  1. FQ ;GET CURRENT FISCAL YEAR AND QUARTER
  1. D:'$D(DT) DT^DICRW
  1. S RMPRFY=$E(DT,2,3) I $E(DT,4,7)>1000 S RMPRFY=RMPRFY+1
  1. S RMPRFY=$S($L(RMPRFY)>2:$E(RMPRFY,2,3),$L(RMPRFY)<2:RMPRFY=0_RMPRFY,1:RMPRFY)
  1. S RMPRQTR=$P("2^2^2^3^3^3^4^4^4^1^1^1","^",$E(DT,4,5)) Q:$D(RMPRWO)
  1. FY 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
  1. QT 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
  1. S RMPRFY=X,RMPRQTR=X1 Q
  1. ST ;GET DATE RANGE
  1. D DIV4^RMPRSIT I $D(X) S QUIT=1 Q
  1. RDATE S %DT="XEA",%DT("A")="Enter Start Date: " D ^%DT I X[U!(X="")!($D(DTOUT)) S QUIT=1 Q
  1. S DATE(1)=+Y
  1. S %DT="XEA",%DT("A")="Enter End Date: " D ^%DT I X[U!(X="")!($D(DTOUT)) S QUIT=1 Q
  1. S DATE(2)=+Y
  1. I DATE(1)>DATE(2) W !!,$C(7),"ENDING DATE RANGE IS LESS THAN BEGINNING DATE RANGE",! G RDATE
  1. Q