RMPRDT ;PHX/JLT,RVD-ASK DATE RANGE ;8/29/1994
;;3.0;PROSTHETICS;**40**;Feb 09, 1996
D FQ G:(RMPRFY["^")!(RMPRQTR["^") END K RMPRN,^TMP($J)
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
.D C^%DTC S RMPRN=$E(X,1,3)_"1001" S (RY,Y)=RMPRN D DD^%DT S DATE(1)=RY,%DT("B")=Y
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")
S $E(RY,1)=$S(RMPRFY>50:2,1:3),Y=RY
D DD^%DT S %DT("B")=Y I $D(RMPRNA) S DATE(1)=RY G NSK
DATE S %DT="XEA",%DT("A")="Enter Start Date: " D ^%DT G:X[U!(X="")!($D(DTOUT)) END
S DATE(1)=+Y
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
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")
S $E(RY,1)=$S(RMPRFY>50:2,1:3),Y=RY
D DD^%DT S %DT("B")=Y I $D(RMPRNA) S DATE(2)=+RY G EXIT
EDATE S %DT="XEA",%DT("A")="Enter End Date: " D ^%DT G:X[U!(X="")!($D(DTOUT)) END S DATE(2)=+Y
I DATE(1)>DATE(2) W !!,$C(7),"ENDING DATE RANGE IS LESS THAN BEGINNING DATE RANGE",! G QTR
EXIT K %DT,RMPRN,DTOUT,X,X1,RY Q
END K DATE,%DT,RMPRN,DTOUT,RMPRFY,RMPRQTR Q
FQ ;GET CURRENT FISCAL YEAR AND QUARTER
D:'$D(DT) DT^DICRW
S RMPRFY=$E(DT,2,3) I $E(DT,4,7)>1000 S RMPRFY=RMPRFY+1
S RMPRFY=$S($L(RMPRFY)>2:$E(RMPRFY,2,3),$L(RMPRFY)<2:RMPRFY=0_RMPRFY,1:RMPRFY)
S RMPRQTR=$P("2^2^2^3^3^3^4^4^4^1^1^1","^",$E(DT,4,5)) Q:$D(RMPRWO)
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
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
S RMPRFY=X,RMPRQTR=X1 Q
ST ;GET DATE RANGE
D DIV4^RMPRSIT I $D(X) S QUIT=1 Q
RDATE S %DT="XEA",%DT("A")="Enter Start Date: " D ^%DT I X[U!(X="")!($D(DTOUT)) S QUIT=1 Q
S DATE(1)=+Y
S %DT="XEA",%DT("A")="Enter End Date: " D ^%DT I X[U!(X="")!($D(DTOUT)) S QUIT=1 Q
S DATE(2)=+Y
I DATE(1)>DATE(2) W !!,$C(7),"ENDING DATE RANGE IS LESS THAN BEGINNING DATE RANGE",! G RDATE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRDT 2360 printed Nov 22, 2024@17:44:12 Page 2
RMPRDT ;PHX/JLT,RVD-ASK DATE RANGE ;8/29/1994
+1 ;;3.0;PROSTHETICS;**40**;Feb 09, 1996
+2 DO FQ
if (RMPRFY["^")!(RMPRQTR["^")
GOTO END
KILL RMPRN,^TMP($JOB)
QTR IF DT<$EXTRACT(DT,1)_RMPRFY_"1001"
IF RMPRQTR=1
SET X1=$EXTRACT(DT,1)_RMPRFY_"1001"
SET X2=-365
SET $EXTRACT(X1,1)=$SELECT(RMPRFY>50:2,1:3)
Begin DoDot:1
+1 DO C^%DTC
SET RMPRN=$EXTRACT(X,1,3)_"1001"
SET (RY,Y)=RMPRN
DO DD^%DT
SET DATE(1)=RY
SET %DT("B")=Y
End DoDot:1
if $DATA(RMPRNA)
GOTO NSK
GOTO DATE
+2 SET (RY,Y)=$SELECT(RMPRQTR=1:$EXTRACT(DT,1)_RMPRFY_"1001",RMPRQTR=2:$EXTRACT(DT,1)_RMPRFY_"0101",RMPRQTR=3:$EXTRACT(DT,1)_RMPRFY_"0401",RMPRQTR=4:$EXTRACT(DT,1)_RMPRFY_"0701")
+3 SET $EXTRACT(RY,1)=$SELECT(RMPRFY>50:2,1:3)
SET Y=RY
+4 DO DD^%DT
SET %DT("B")=Y
IF $DATA(RMPRNA)
SET DATE(1)=RY
GOTO NSK
DATE SET %DT="XEA"
SET %DT("A")="Enter Start Date: "
DO ^%DT
if X[U!(X="")!($DATA(DTOUT))
GOTO END
+1 SET DATE(1)=+Y
NSK IF $DATA(RMPRN)
SET (RY,Y)=$EXTRACT(RMPRN,1,3)_"1231"
DO DD^%DT
SET %DT("B")=Y
SET DATE(2)=RY
if $DATA(RMPRNA)
GOTO EXIT
GOTO EDATE
+1 SET (RY,Y)=$SELECT(RMPRQTR=1:$EXTRACT(DT,1)_RMPRFY+1_"0930",RMPRQTR=2:$EXTRACT(DT,1)_RMPRFY_"0331",RMPRQTR=3:$EXTRACT(DT,1)_RMPRFY_"0630",RMPRQTR=4:$EXTRACT(DT,1)_RMPRFY_"0930")
+2 SET $EXTRACT(RY,1)=$SELECT(RMPRFY>50:2,1:3)
SET Y=RY
+3 DO DD^%DT
SET %DT("B")=Y
IF $DATA(RMPRNA)
SET DATE(2)=+RY
GOTO EXIT
EDATE SET %DT="XEA"
SET %DT("A")="Enter End Date: "
DO ^%DT
if X[U!(X="")!($DATA(DTOUT))
GOTO END
SET DATE(2)=+Y
+1 IF DATE(1)>DATE(2)
WRITE !!,$CHAR(7),"ENDING DATE RANGE IS LESS THAN BEGINNING DATE RANGE",!
GOTO QTR
EXIT KILL %DT,RMPRN,DTOUT,X,X1,RY
QUIT
END KILL DATE,%DT,RMPRN,DTOUT,RMPRFY,RMPRQTR
QUIT
FQ ;GET CURRENT FISCAL YEAR AND QUARTER
+1 if '$DATA(DT)
DO DT^DICRW
+2 SET RMPRFY=$EXTRACT(DT,2,3)
IF $EXTRACT(DT,4,7)>1000
SET RMPRFY=RMPRFY+1
+3 SET RMPRFY=$SELECT($LENGTH(RMPRFY)>2:$EXTRACT(RMPRFY,2,3),$LENGTH(RMPRFY)<2:RMPRFY=0_RMPRFY,1:RMPRFY)
+4 SET RMPRQTR=$PIECE("2^2^2^3^3^3^4^4^4^1^1^1","^",$EXTRACT(DT,4,5))
if $DATA(RMPRWO)
QUIT
FY WRITE !,"Select FISCAL YEAR: ",RMPRFY,"// "
READ X:DTIME
if '$TEST!(X="^")
SET RMPRFY="^"
if RMPRFY="^"
QUIT
if X=""
SET X=RMPRFY
IF X'?2N
WRITE $CHAR(7),!,"Enter a two digit fiscal year (e.g., 93).",!
GOTO FY
QT WRITE !,"Select QUARTER: ",RMPRQTR,"// "
READ X1:DTIME
if '$TEST!(X1["^")
SET RMPRQTR="^"
if RMPRQTR="^"
QUIT
if X1=""
SET X1=RMPRQTR
IF X1'?1N!(X1>4)!(X1=0)
WRITE $CHAR(7),!,"Enter a single digit number from 1 to 4.",!
GOTO QT
+1 SET RMPRFY=X
SET RMPRQTR=X1
QUIT
ST ;GET DATE RANGE
+1 DO DIV4^RMPRSIT
IF $DATA(X)
SET QUIT=1
QUIT
RDATE SET %DT="XEA"
SET %DT("A")="Enter Start Date: "
DO ^%DT
IF X[U!(X="")!($DATA(DTOUT))
SET QUIT=1
QUIT
+1 SET DATE(1)=+Y
+2 SET %DT="XEA"
SET %DT("A")="Enter End Date: "
DO ^%DT
IF X[U!(X="")!($DATA(DTOUT))
SET QUIT=1
QUIT
+3 SET DATE(2)=+Y
+4 IF DATE(1)>DATE(2)
WRITE !!,$CHAR(7),"ENDING DATE RANGE IS LESS THAN BEGINNING DATE RANGE",!
GOTO RDATE
+5 QUIT
