- QAQDATE ;HISC/JES,DAD-EXTRAPOLATE DATE FOR SORT/PRINTS ;10/15/92 12:45 ;
- ;;1.7;QM Integration Module;**3**;07/25/1995
- ;
- ;OPTIONAL INPUT VARIABLE
- ; QAQDATE = ['] Date range type ^ [ Date 1 ] ^ [ Date 2 ]
- ;
- ;OUTPUT VARIABLES
- ; QAQQUIT = 1 If exit out, else 0
- ; QAQNBEG = Beginning date (FM)
- ; QAQNEND = Ending date (FM)
- ; QAQENGD = Today in external format
- ; QAQ1HED = Mumps header code (X QAQ1HED)
- ; QAQ2HED = Date range chosen text
- ; QAQTART = Tab value to center QAQ2HED
- ; QAQRANG = From - To date range text
- ;
- S QA("DD")=^DD("DD"),QAQFRAME="^MONTHLY^QUARTERLY^SEMI-ANNUALLY^YEARLY^FISCAL YEARLY^USER SELECTABLE",QAQDATE=$G(QAQDATE)
- RANGE ;
- I $P(QAQDATE,"^")["'" S QAQQUIT=0 D G ABORT:QAQQUIT,QUIT
- . S X=$E($TR($P(QAQDATE,"^"),"'")),(X,WHEN)=$TR(X,"mqsfyu","MQSFYU")
- . I "^M^Q^S^Y^F^U^"'[("^"_X_"^") S QAQQUIT=1 Q
- . W !!,"Date range: ",X,$P($P(QAQFRAME,"^"_X,2),"^")
- . D MONTH:WHEN="M",QUART:(WHEN="Q")!(WHEN="S")
- . D YEAR:(WHEN="F")!(WHEN="Y"),USERSEL:WHEN="U"
- . Q
- W !!,"Monthly, Quarterly, Semi-Annually, Yearly, Fiscal Yearly, User Selectable",!,"Select date range: ",$S($P(QAQDATE,"^")]"":$P(QAQDATE,"^")_"// ",1:"")
- R X:DTIME S:'$T X="^" I X="" S X=$P(QAQDATE,"^") W X
- G:(X="")!(X="^") ABORT
- S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- I $F(QAQFRAME,"^"_X)'>0 W:$E(X)'="?" " ??",*7 W !!?5,"Enter the first few letters of one of the choices listed below." G RANGE
- W $P($P(QAQFRAME,"^"_X,2),"^") S WHEN=$E(X),QAQQUIT=0
- D MONTH:WHEN="M",QUART:(WHEN="Q")!(WHEN="S"),YEAR:(WHEN="F")!(WHEN="Y"),USERSEL:WHEN="U"
- I QAQQUIT S QAQDATE="" G RANGE
- E G QUIT
- MONTH ;
- S EOM("01")="31^JANUARY",EOM("02")="28^FEBRUARY",EOM("03")="31^MARCH",EOM("04")="30^APRIL",EOM("05")="31^MAY",EOM("06")="30^JUNE"
- S EOM("07")="31^JULY",EOM("08")="31^AUGUST",EOM("09")="30^SEPTEMBER",EOM(10)="31^OCTOBER",EOM(11)="30^NOVEMBER",EOM(12)="31^DECEMBER"
- K %DT S %DT="AE",%DT("A")="Enter Month and Year: " S:$P(QAQDATE,"^",2)]"" %DT("B")=$P(QAQDATE,"^",2) W ! D ^%DT I Y'>0 S QAQQUIT=1 Q
- I ('+$E(Y,4,5))!(+$E(Y,6,7)) W " ??",*7,!!,"Please enter a month and year",$S(+$E(Y,6,7):" only",1:"") G MONTH
- S MOE=$E(Y,4,5),QAQNEND=$E(Y,1,5)_$P(EOM(MOE),"^",1),X=1700+$E(Y,1,3) S:$E(Y,4,5)="02" QAQNEND=QAQNEND+((X#4=0)&((X#100)!(X#400=0)))
- S QAQNBEG=$E(QAQNEND,1,5)_"01",QAQ2HED="MONTH OF "_$P(EOM(MOE),"^",2)_" "_(1700+$E(Y,1,3))
- Q
- QUART ;
- S SEMI=0 I WHEN="S" S SEMI=1 W !!,"Enter Quarter Period and FY you wish Semi-Annual range to end with"
- W !
- ENTERQ W !,"Enter Quarter and Year: ",$S($P(QAQDATE,"^",2)]"":$P(QAQDATE,"^",2)_"// ",1:"") R QUART:DTIME S:'$T QUART="^" S:QUART="" QUART=$P(QAQDATE,"^",2) I (QUART="^")!(QUART="") S QAQQUIT=1 Q
- I (QUART'?1N1P2N)&(QUART'?1N1P4N) W:$E(QUART)'="?" " ??",*7 W !!,"Enter Quarter Period in this format: 2nd quarter 1988 would be 2-88, 2/88, 2 88",! G ENTERQ
- I ($E(QUART)>4)!($E(QUART)<1) W " ??",*7,!!,"Enter Quarter 1 to 4 only",! G ENTERQ
- S QU=$E(QUART),YR=$E(QUART,3,6) K %DT S X=YR D ^%DT S YR=$E(Y,1,3)
- S QUBEG(1)=YR-1_1001,QUBEG(2)=YR_"0101",QUBEG(3)=YR_"0401",QUBEG(4)=YR_"0701",QUEND(1)=YR-1_1231,QUEND(2)=YR_"0331",QUEND(3)=YR_"0630",QUEND(4)=YR_"0930",QUQUA(1)="FIRST",QUQUA(2)="SECOND",QUQUA(3)="THIRD",QUQUA(4)="FOURTH"
- S:SEMI SEBEG(1)=YR-1_"0701",SEBEG(2)=YR-1_1001,SEBEG(3)=YR_"0101",SEBEG(4)=YR_"0401"
- S QAQNBEG=QUBEG(QU),QAQNEND=QUEND(QU),QAQ2HED=QUQUA(QU)_" QUARTER FY "_(1700+YR) S:SEMI QAQNBEG=SEBEG(QU),QAQ2HED="SEMI-ANNUAL PERIOD ENDING "_QAQ2HED
- Q
- YEAR ;
- S FY=$S(WHEN="F":1,1:0) W !!,"Enter ",$S(FY:"FISCAL ",1:""),"YEAR: ",$S($P(QAQDATE,"^",2)]"":$P(QAQDATE,"^",2)_"// ",1:"")
- R YR:DTIME S:'$T YR="^" S:YR="" YR=$P(QAQDATE,"^",2) I (YR="^")!(YR="") S QAQQUIT=1 Q
- I (YR'?2N)&(YR'?4N) W:$E(YR)'="?" " ??",*7 W !!,"Enter a 2 or 4 digit ",$S(FY:"fiscal ",1:""),"year" G YEAR
- K %DT S X=YR D ^%DT S YR=$E(Y,1,3)
- I FY S QAQNBEG=YR-1_1001,QAQNEND=YR_"0930",QAQ2HED="FISCAL YEAR "_(1700+YR)
- E S QAQNBEG=YR_"0101",QAQNEND=YR_1231,QAQ2HED="YEAR "_(1700+YR)
- Q
- USERSEL ;
- W !!,"Enter beginning and ending dates for the desired time period:",! K %DT S %DT="AEX",%DT("A")="Beginning Date: " S:$P(QAQDATE,"^",2)]"" %DT("B")=$P(QAQDATE,"^",2) D ^%DT I Y'>0 S QAQQUIT=1 Q
- S QAQNBEG=Y X QA("DD") S BEGIN=Y
- K %DT S %DT="AEX",%DT(0)=QAQNBEG,%DT("A")="Ending Date: ",%DT("B")=$S($P(QAQDATE,"^",3)]"":$P(QAQDATE,"^",3),1:BEGIN) D ^%DT I Y'>0 S QAQQUIT=1 Q
- S QAQNEND=Y X QA("DD") S QAQ2HED="PERIOD FROM "_BEGIN_" TO "_Y
- Q
- ABORT ;
- D K S QAQQUIT=1 G KILL
- QUIT ;
- K %DT S %DT="",X="T" D ^%DT X QA("DD") S QAQENGD=Y,QAQ1HED="W !?65,QAQENGD",QAQTART=80-$L(QAQ2HED)/2,QAQRANG="Range selected: " S Y=QAQNBEG X QA("DD") S QAQRANG=QAQRANG_Y_" to " S Y=QAQNEND X QA("DD") S QAQRANG=QAQRANG_Y W !!,QAQRANG,!
- KILL ;
- K %DT,BEGIN,EOM,FY,LP,MOE,MON,QA,QAQDATE,QAQFRAME,QU,QUART,QUBEG,QUEND,QUQUA,SEBEG,SEMI,WHEN,X,Y,YR
- Q
- K ; *** ENTRY POINT TO CLEANUP RETURNED VARIABLES
- K QAQQUIT,QAQNBEG,QAQNEND,QAQENGD,QAQ1HED,QAQ2HED,QAQTART,QAQRANG
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAQDATE 5006 printed Jan 18, 2025@03:32:33 Page 2
- QAQDATE ;HISC/JES,DAD-EXTRAPOLATE DATE FOR SORT/PRINTS ;10/15/92 12:45 ;
- +1 ;;1.7;QM Integration Module;**3**;07/25/1995
- +2 ;
- +3 ;OPTIONAL INPUT VARIABLE
- +4 ; QAQDATE = ['] Date range type ^ [ Date 1 ] ^ [ Date 2 ]
- +5 ;
- +6 ;OUTPUT VARIABLES
- +7 ; QAQQUIT = 1 If exit out, else 0
- +8 ; QAQNBEG = Beginning date (FM)
- +9 ; QAQNEND = Ending date (FM)
- +10 ; QAQENGD = Today in external format
- +11 ; QAQ1HED = Mumps header code (X QAQ1HED)
- +12 ; QAQ2HED = Date range chosen text
- +13 ; QAQTART = Tab value to center QAQ2HED
- +14 ; QAQRANG = From - To date range text
- +15 ;
- +16 SET QA("DD")=^DD("DD")
- SET QAQFRAME="^MONTHLY^QUARTERLY^SEMI-ANNUALLY^YEARLY^FISCAL YEARLY^USER SELECTABLE"
- SET QAQDATE=$GET(QAQDATE)
- RANGE ;
- +1 IF $PIECE(QAQDATE,"^")["'"
- SET QAQQUIT=0
- Begin DoDot:1
- +2 SET X=$EXTRACT($TRANSLATE($PIECE(QAQDATE,"^"),"'"))
- SET (X,WHEN)=$TRANSLATE(X,"mqsfyu","MQSFYU")
- +3 IF "^M^Q^S^Y^F^U^"'[("^"_X_"^")
- SET QAQQUIT=1
- QUIT
- +4 WRITE !!,"Date range: ",X,$PIECE($PIECE(QAQFRAME,"^"_X,2),"^")
- +5 if WHEN="M"
- DO MONTH
- if (WHEN="Q")!(WHEN="S")
- DO QUART
- +6 if (WHEN="F")!(WHEN="Y")
- DO YEAR
- if WHEN="U"
- DO USERSEL
- +7 QUIT
- End DoDot:1
- if QAQQUIT
- GOTO ABORT
- GOTO QUIT
- +8 WRITE !!,"Monthly, Quarterly, Semi-Annually, Yearly, Fiscal Yearly, User Selectable",!,"Select date range: ",$SELECT($PIECE(QAQDATE,"^")]"":$PIECE(QAQDATE,"^")_"// ",1:"")
- +9 READ X:DTIME
- if '$TEST
- SET X="^"
- IF X=""
- SET X=$PIECE(QAQDATE,"^")
- WRITE X
- +10 if (X="")!(X="^")
- GOTO ABORT
- +11 SET X=$TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- +12 IF $FIND(QAQFRAME,"^"_X)'>0
- if $EXTRACT(X)'="?"
- WRITE " ??",*7
- WRITE !!?5,"Enter the first few letters of one of the choices listed below."
- GOTO RANGE
- +13 WRITE $PIECE($PIECE(QAQFRAME,"^"_X,2),"^")
- SET WHEN=$EXTRACT(X)
- SET QAQQUIT=0
- +14 if WHEN="M"
- DO MONTH
- if (WHEN="Q")!(WHEN="S")
- DO QUART
- if (WHEN="F")!(WHEN="Y")
- DO YEAR
- if WHEN="U"
- DO USERSEL
- +15 IF QAQQUIT
- SET QAQDATE=""
- GOTO RANGE
- +16 IF '$TEST
- GOTO QUIT
- MONTH ;
- +1 SET EOM("01")="31^JANUARY"
- SET EOM("02")="28^FEBRUARY"
- SET EOM("03")="31^MARCH"
- SET EOM("04")="30^APRIL"
- SET EOM("05")="31^MAY"
- SET EOM("06")="30^JUNE"
- +2 SET EOM("07")="31^JULY"
- SET EOM("08")="31^AUGUST"
- SET EOM("09")="30^SEPTEMBER"
- SET EOM(10)="31^OCTOBER"
- SET EOM(11)="30^NOVEMBER"
- SET EOM(12)="31^DECEMBER"
- +3 KILL %DT
- SET %DT="AE"
- SET %DT("A")="Enter Month and Year: "
- if $PIECE(QAQDATE,"^",2)]""
- SET %DT("B")=$PIECE(QAQDATE,"^",2)
- WRITE !
- DO ^%DT
- IF Y'>0
- SET QAQQUIT=1
- QUIT
- +4 IF ('+$EXTRACT(Y,4,5))!(+$EXTRACT(Y,6,7))
- WRITE " ??",*7,!!,"Please enter a month and year",$SELECT(+$EXTRACT(Y,6,7):" only",1:"")
- GOTO MONTH
- +5 SET MOE=$EXTRACT(Y,4,5)
- SET QAQNEND=$EXTRACT(Y,1,5)_$PIECE(EOM(MOE),"^",1)
- SET X=1700+$EXTRACT(Y,1,3)
- if $EXTRACT(Y,4,5)="02"
- SET QAQNEND=QAQNEND+((X#4=0)&((X#100)!(X#400=0)))
- +6 SET QAQNBEG=$EXTRACT(QAQNEND,1,5)_"01"
- SET QAQ2HED="MONTH OF "_$PIECE(EOM(MOE),"^",2)_" "_(1700+$EXTRACT(Y,1,3))
- +7 QUIT
- QUART ;
- +1 SET SEMI=0
- IF WHEN="S"
- SET SEMI=1
- WRITE !!,"Enter Quarter Period and FY you wish Semi-Annual range to end with"
- +2 WRITE !
- ENTERQ WRITE !,"Enter Quarter and Year: ",$SELECT($PIECE(QAQDATE,"^",2)]"":$PIECE(QAQDATE,"^",2)_"// ",1:"")
- READ QUART:DTIME
- if '$TEST
- SET QUART="^"
- if QUART=""
- SET QUART=$PIECE(QAQDATE,"^",2)
- IF (QUART="^")!(QUART="")
- SET QAQQUIT=1
- QUIT
- +1 IF (QUART'?1N1P2N)&(QUART'?1N1P4N)
- if $EXTRACT(QUART)'="?"
- WRITE " ??",*7
- WRITE !!,"Enter Quarter Period in this format: 2nd quarter 1988 would be 2-88, 2/88, 2 88",!
- GOTO ENTERQ
- +2 IF ($EXTRACT(QUART)>4)!($EXTRACT(QUART)<1)
- WRITE " ??",*7,!!,"Enter Quarter 1 to 4 only",!
- GOTO ENTERQ
- +3 SET QU=$EXTRACT(QUART)
- SET YR=$EXTRACT(QUART,3,6)
- KILL %DT
- SET X=YR
- DO ^%DT
- SET YR=$EXTRACT(Y,1,3)
- +4 SET QUBEG(1)=YR-1_1001
- SET QUBEG(2)=YR_"0101"
- SET QUBEG(3)=YR_"0401"
- SET QUBEG(4)=YR_"0701"
- SET QUEND(1)=YR-1_1231
- SET QUEND(2)=YR_"0331"
- SET QUEND(3)=YR_"0630"
- SET QUEND(4)=YR_"0930"
- SET QUQUA(1)="FIRST"
- SET QUQUA(2)="SECOND"
- SET QUQUA(3)="THIRD"
- SET QUQUA(4)="FOURTH"
- +5 if SEMI
- SET SEBEG(1)=YR-1_"0701"
- SET SEBEG(2)=YR-1_1001
- SET SEBEG(3)=YR_"0101"
- SET SEBEG(4)=YR_"0401"
- +6 SET QAQNBEG=QUBEG(QU)
- SET QAQNEND=QUEND(QU)
- SET QAQ2HED=QUQUA(QU)_" QUARTER FY "_(1700+YR)
- if SEMI
- SET QAQNBEG=SEBEG(QU)
- SET QAQ2HED="SEMI-ANNUAL PERIOD ENDING "_QAQ2HED
- +7 QUIT
- YEAR ;
- +1 SET FY=$SELECT(WHEN="F":1,1:0)
- WRITE !!,"Enter ",$SELECT(FY:"FISCAL ",1:""),"YEAR: ",$SELECT($PIECE(QAQDATE,"^",2)]"":$PIECE(QAQDATE,"^",2)_"// ",1:"")
- +2 READ YR:DTIME
- if '$TEST
- SET YR="^"
- if YR=""
- SET YR=$PIECE(QAQDATE,"^",2)
- IF (YR="^")!(YR="")
- SET QAQQUIT=1
- QUIT
- +3 IF (YR'?2N)&(YR'?4N)
- if $EXTRACT(YR)'="?"
- WRITE " ??",*7
- WRITE !!,"Enter a 2 or 4 digit ",$SELECT(FY:"fiscal ",1:""),"year"
- GOTO YEAR
- +4 KILL %DT
- SET X=YR
- DO ^%DT
- SET YR=$EXTRACT(Y,1,3)
- +5 IF FY
- SET QAQNBEG=YR-1_1001
- SET QAQNEND=YR_"0930"
- SET QAQ2HED="FISCAL YEAR "_(1700+YR)
- +6 IF '$TEST
- SET QAQNBEG=YR_"0101"
- SET QAQNEND=YR_1231
- SET QAQ2HED="YEAR "_(1700+YR)
- +7 QUIT
- USERSEL ;
- +1 WRITE !!,"Enter beginning and ending dates for the desired time period:",!
- KILL %DT
- SET %DT="AEX"
- SET %DT("A")="Beginning Date: "
- if $PIECE(QAQDATE,"^",2)]""
- SET %DT("B")=$PIECE(QAQDATE,"^",2)
- DO ^%DT
- IF Y'>0
- SET QAQQUIT=1
- QUIT
- +2 SET QAQNBEG=Y
- XECUTE QA("DD")
- SET BEGIN=Y
- +3 KILL %DT
- SET %DT="AEX"
- SET %DT(0)=QAQNBEG
- SET %DT("A")="Ending Date: "
- SET %DT("B")=$SELECT($PIECE(QAQDATE,"^",3)]"":$PIECE(QAQDATE,"^",3),1:BEGIN)
- DO ^%DT
- IF Y'>0
- SET QAQQUIT=1
- QUIT
- +4 SET QAQNEND=Y
- XECUTE QA("DD")
- SET QAQ2HED="PERIOD FROM "_BEGIN_" TO "_Y
- +5 QUIT
- ABORT ;
- +1 DO K
- SET QAQQUIT=1
- GOTO KILL
- QUIT ;
- +1 KILL %DT
- SET %DT=""
- SET X="T"
- DO ^%DT
- XECUTE QA("DD")
- SET QAQENGD=Y
- SET QAQ1HED="W !?65,QAQENGD"
- SET QAQTART=80-$LENGTH(QAQ2HED)/2
- SET QAQRANG="Range selected: "
- SET Y=QAQNBEG
- XECUTE QA("DD")
- SET QAQRANG=QAQRANG_Y_" to "
- SET Y=QAQNEND
- XECUTE QA("DD")
- SET QAQRANG=QAQRANG_Y
- WRITE !!,QAQRANG,!
- KILL ;
- +1 KILL %DT,BEGIN,EOM,FY,LP,MOE,MON,QA,QAQDATE,QAQFRAME,QU,QUART,QUBEG,QUEND,QUQUA,SEBEG,SEMI,WHEN,X,Y,YR
- +2 QUIT
- K ; *** ENTRY POINT TO CLEANUP RETURNED VARIABLES
- +1 KILL QAQQUIT,QAQNBEG,QAQNEND,QAQENGD,QAQ1HED,QAQ2HED,QAQTART,QAQRANG
- +2 QUIT