- 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 Feb 19, 2025@00:00:40 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
