GMRCCY ;SFVAMC/DAD - Consult Closure Tool: Date Range Selector ;01/20/17 15:19
;;3.0;CONSULT/REQUEST TRACKING;**89**;DEC 27, 1997;Build 62
;Consult Closure Tool
;
; IA# Usage Component
; ---------------------------
; 10003 Supported ^%DT
; 10103 Supported $$FMTE^XLFDT
; 10103 Supported $$SCH^XLFDT
; 10104 Supported $$UP^XLFSTR
;
EN(GMTBEG,GMTEND,GMHEAD,GMRANG) ; *** Entry Point
; Input
; GMTBEG = Begin date - Default (FM Int) [Req, Pass by ref]
; GMTEND = End date - Default (FM Int) [Req, Pass by ref]
; GMHEAD = Header line [Opt, Pass by value]
; GMRANG = Date range type [Opt, Pass by value]
; M,M!,Q,Q!,S,S!,Y,Y!,F,F!,U,U! ("!" forces selection)
; Output
; $$EN() = 1 - Okay OR 0 - Exit
; GMTBEG = Begin date [If $$EN()=1 FM Int Date, Else ""]
; GMTEND = End date [If $$EN()=1 FM Int Date, Else ""]
;
; Example
; IF $$EN^GMDATE(.GMTBEG,.GMTEND,GMHEAD,GMRANG)'>0 QUIT
;
N GM,GMDATA,GMDFLT,GMDONE,GMFRAM,GMQUIT,GMWHEN,X,Y
S (GMFRAM,GMFRAM(0))=""
F GM=1:1 S GMDATA=$P($T(FRAMDAT+GM),";;",2) Q:GMDATA=U D
. S GMFRAM=GMFRAM_U_$$UP^XLFSTR(GMDATA)
. S GMFRAM(0)=GMFRAM(0)_GMDATA_$S(GM<6:", ",1:"")
. Q
F D Q:GMQUIT!GMDONE
. S (GMQUIT,GMDONE)=0
. S GMTBEG=$S($G(GMTBEG)\1?7N:GMTBEG\1,1:"")
. S GMTEND=$S($G(GMTEND)\1?7N:GMTEND\1,1:"")
. S GMDFLT=$$UP^XLFSTR($G(GMRANG))_U_GMTBEG_U_GMTEND
. I $G(GMHEAD)]"" W !,GMHEAD
. W !,GMFRAM(0)
. W !,"Select date range: "
. W $S($TR($P(GMDFLT,U),"!")]"":$TR($P(GMDFLT,U),"!")_"// ",1:"")
. S GMWHEN=""
. I $P(GMDFLT,U)'["!" R GMWHEN:DTIME S:'$T GMWHEN=U
. I GMWHEN="" S GMWHEN=$TR($P(GMDFLT,U),"!") W GMWHEN
. I (GMWHEN="")!($E(GMWHEN)=U) S GMQUIT=1 Q
. S GMWHEN=$$UP^XLFSTR(GMWHEN)
. I $F(GMFRAM,U_GMWHEN)'>0 D Q
.. D BELL(GMWHEN)
.. I $P(GMDFLT,U)["!" S GMQUIT=1 Q
.. W !!?5,"Enter the first few letters of "
.. W "one of the choices listed below.",!
.. Q
. W $P($P(GMFRAM,U_GMWHEN,2),U)
. S GMWHEN=$E(GMWHEN)
. S GMQUIT=$$ASKDATE(GMWHEN,GMDFLT,.GMTBEG,.GMTEND)
. I GMQUIT D
.. S GMQUIT=$S($P(GMDFLT,U)'["!":0,1:GMQUIT)
.. I GMQUIT'>0 W !
.. Q
. E D
.. S GMDONE=1
.. Q
. Q
S GMQUIT='$G(GMQUIT)
I GMQUIT>0 D
. W !!,"Range selected: "
. W $$FMTE^XLFDT(GMTBEG,"5Z")," to ",$$FMTE^XLFDT(GMTEND,"5Z")
. Q
E D
. S (GMTBEG,GMTEND)=""
. Q
Q GMQUIT
;
FRAMDAT ;; TimeFrameName
;;Monthly
;;Quarterly
;;Semi-Annually
;;Yearly
;;Fiscal Yearly
;;User Selectable
;;^
;
ASKDATE(GMWHEN,GMDFLT,GMTBEG,GMTEND) ; *** Prompt for date range
N GMQUIT
S GMQUIT=1
I GMWHEN="M" D
. S GMQUIT=$$MONTH(GMWHEN,GMDFLT,.GMTBEG,.GMTEND)
. Q
I (GMWHEN="Q")!(GMWHEN="S") D
. S GMQUIT=$$QUART(GMWHEN,GMDFLT,.GMTBEG,.GMTEND)
. Q
I (GMWHEN="F")!(GMWHEN="Y") D
. S GMQUIT=$$YEAR(GMWHEN,GMDFLT,.GMTBEG,.GMTEND)
. Q
I GMWHEN="U" D
. S GMQUIT=$$USERSEL(GMWHEN,GMDFLT,.GMTBEG,.GMTEND)
. Q
Q GMQUIT
;
MONTH(GMWHEN,GMDFLT,GMTBEG,GMTEND) ; *** Monthly
N %DT,GM,GMDATA,GMDONE,GMEND,GMEOM,GMMNYR,GMMOE,GMQUIT,GMYEAR,X,Y
F GM=1:1 S GMDATA=$P($T(MONTHDAT+GM),";;",2) Q:GMDATA=U D
. S GMEOM($P(GMDATA,U))=$P(GMDATA,U,2,3)
. Q
S (GMQUIT,GMDONE)=0
F D Q:(GMQUIT>0)!(GMDONE>0)
. K %DT
. S %DT="AE"
. S %DT("A")="Enter Month and Year: "
. I $P(GMDFLT,U,2)]"" D
.. S GMMNYR=$P(GMDFLT,U,2)
.. S %DT("B")=$E(GMMNYR,4,5)_"/"_(1700+$E(GMMNYR,1,3))
.. Q
. W ! D ^%DT S GMEND=+$G(Y)
. I GMEND'>0 S GMQUIT=1 Q
. I ('+$E(GMEND,4,5))!(+$E(GMEND,6,7)) D Q
.. D BELL("")
.. W !!,"Please enter a month and year"
.. W $S(+$E(GMEND,6,7):" only",1:"")
.. Q
. S GMMOE=$E(GMEND,4,5)
. S GMTEND=$E(GMEND,1,5)_$P(GMEOM(GMMOE),U)
. I $E(GMTEND,4,5)="02" D
.. S GMYEAR=1700+$E(GMTEND,1,3)
.. S GMTEND=GMTEND+((GMYEAR#4=0)&((GMYEAR#100)!(GMYEAR#400=0)))
.. Q
. S GMTBEG=$E(GMTEND,1,5)_"01"
. S GMDONE=1
. Q
Q GMQUIT
;
MONTHDAT ;; MonthNumber ^ DaysInMonth ^ MonthName
;;01^31^JANUARY
;;02^28^FEBRUARY
;;03^31^MARCH
;;04^30^APRIL
;;05^31^MAY
;;06^30^JUNE
;;07^31^JULY
;;08^31^AUGUST
;;09^30^SEPTEMBER
;;10^31^OCTOBER
;;11^30^NOVEMBER
;;12^31^DECEMBER
;;^
;
QUART(GMWHEN,GMDFLT,GMTBEG,GMTEND) ; *** Quarterly & Semi-Annually
N %DT,GM,GMDATA,GMDONE,GMMNDY,GMQU,GMQUIT,GMQUYR,GMSBEG,GMSEMI,GMYR,GMQART
N GMQBEG,GMQEND,GMQQUA,X,Y
S GMSEMI=$S(GMWHEN="S":1,1:0)
F GM=1:1 S GMDATA=$P($T(QUARTDAT+GM),";;",2) Q:GMDATA=U D
. S GMQQUA(GM)=$P(GMDATA,U)
. S GMQBEG(GM)="000"_$P(GMDATA,U,2)
. S GMSBEG(GM)="000"_$P(GMDATA,U,3)
. S GMQEND(GM)="000"_$P(GMDATA,U,4)
. Q
S GMQUYR=""
I $P(GMDFLT,U,2)]"" D
. S GMMNDY=$E($P(GMDFLT,U,2),4,7)
. I (GMMNDY'<GMQBEG(1))&(GMMNDY'>GMQEND(1)) S GMQU=1
. I (GMMNDY'<GMQBEG(2))&(GMMNDY'>GMQEND(2)) S GMQU=2
. I (GMMNDY'<GMQBEG(3))&(GMMNDY'>GMQEND(3)) S GMQU=3
. I (GMMNDY'<GMQBEG(4))&(GMMNDY'>GMQEND(4)) S GMQU=4
. S GMQUYR=$S(GMQU>0:GMQU_"/"_(1700+$E($P(GMDFLT,U,2),1,3)+(GMQU=1)),1:"")
. Q
S (GMQUIT,GMDONE)=0
F D Q:(GMQUIT>0)!(GMDONE>0)
. I GMSEMI>0 D
.. W !!,"Enter Quarter Period and FY you "
.. W "wish Semi-Annual range to end with"
.. Q
. W !
. W !,"Enter Quarter and Year: ",$S(GMQUYR]"":GMQUYR_"// ",1:"")
. R GMQART:DTIME S:'$T GMQART=U
. I GMQART="" S GMQART=GMQUYR
. I (GMQART=U)!(GMQART="") S GMQUIT=1 Q
. I (GMQART'?1N1P2N)&(GMQART'?1N1P4N) D Q
.. D BELL(GMQART)
.. W !!,"Enter Quarter Period in this format: "
.. W "2nd quarter 1988 would be 2-88, 2/88, 2 88"
.. Q
. I ($E(GMQART)>4)!($E(GMQART)<1) D Q
.. D BELL("")
.. W !!,"Enter Quarter 1 to 4 only"
.. Q
. S GMQU=$E(GMQART)
. S GMYR=$E(GMQART,3,6)
. K %DT S X=GMYR D ^%DT S GMYR=$E(Y,1,3)
. F GM=1:1:4 D
.. S GMQBEG(GM)=$S(GM=1:GMYR-1,1:GMYR)_$E(GMQBEG(GM),4,7)
.. S GMSBEG(GM)=$S(GM'>2:GMYR-1,1:GMYR)_$E(GMSBEG(GM),4,7)
.. S GMQEND(GM)=$S(GM=1:GMYR-1,1:GMYR)_$E(GMQEND(GM),4,7)
.. Q
. S GMTEND=GMQEND(GMQU)
. S GMTBEG=$S(GMSEMI:GMSBEG(GMQU),1:GMQBEG(GMQU))
. S GMDONE=1
. Q
Q GMQUIT
;
QUARTDAT ;;Name ^ QuarterStart ^ SemiStart ^ QuarterEnd
;;FIRST^1001^0701^1231
;;SECOND^0101^1001^0331
;;THIRD^0401^0101^0630
;;FOURTH^0701^0401^0930
;;^
;
YEAR(GMWHEN,GMDFLT,GMTBEG,GMTEND) ; *** Yearly & Fiscal Yearly
N %DT,GMDONE,GMFY,GMQUIT,GMYEAR,GMYR,X,Y
S GMFY=$S(GMWHEN="F":1,1:0)
S (GMQUIT,GMDONE)=0
F D Q:(GMQUIT>0)!(GMDONE>0)
. W !!,"Enter ",$S(GMFY:"FISCAL ",1:""),"YEAR: "
. S GMYEAR=$S($P(GMDFLT,U,2)]"":1700+$E($P(GMDFLT,U,2),1,3),1:"")
. W $S(GMYEAR]"":GMYEAR_"// ",1:"")
. R GMYR:DTIME S:'$T GMYR=U
. I GMYR="" S GMYR=GMYEAR
. I (GMYR=U)!(GMYR="") S GMQUIT=1 Q
. I (GMYR'?2N)&(GMYR'?4N) D Q
.. D BELL(GMYR)
.. W !!,"Enter a 2 or 4 digit ",$S(GMFY:"fiscal ",1:""),"year"
.. Q
. K %DT S X=GMYR D ^%DT S GMYR=$E(Y,1,3)
. I GMFY D
.. S GMTBEG=GMYR-1_"1001"
.. S GMTEND=GMYR_"0930"
.. Q
. E D
.. S GMTBEG=GMYR_"0101"
.. S GMTEND=GMYR_"1231"
.. Q
. S GMDONE=1
. Q
Q GMQUIT
;
USERSEL(GMWHEN,GMDFLT,GMTBEG,GMTEND) ; *** User Selectable
N %DT,GMBEG,GMEND,GMQUIT,X,Y
S GMQUIT=0
W !!,"Enter beginning and ending dates for the desired time period:",!
K %DT
S %DT="AEX"
S %DT("A")="Beginning Date: "
I $P(GMDFLT,U,2)]"" S %DT("B")=$$FMTE^XLFDT($P(GMDFLT,U,2),"5Z")
D ^%DT S GMBEG=+$G(Y)
I GMBEG>0 D
. K %DT
. S %DT="AEX"
. S %DT(0)=GMBEG
. S %DT("A")="Ending Date: "
. I $P(GMDFLT,U,3)]"",$P(GMDFLT,U,3)'<GMBEG D
.. S %DT("B")=$$FMTE^XLFDT($P(GMDFLT,U,3),"5Z")
.. Q
. E D
.. S %DT("B")=$$FMTE^XLFDT(GMBEG,"5Z")
.. Q
. D ^%DT S GMEND=+$G(Y)
. I GMEND>0 D
.. S GMTBEG=GMBEG
.. S GMTEND=GMEND
.. Q
. E D
.. S GMQUIT=1
.. Q
. Q
E D
. S GMQUIT=1
. Q
Q GMQUIT
;
BELL(X) ; *** Write ?? <Beep>
I $E(X)'="?" W " ??",$C(7)
Q
;
LASTMNTH(GMDATE,GMTBEG,GMTEND) ; *** Compute last month date range
N GMMN,GMYR
S GMYR=1700+$E(GMDATE,1,3)
S GMMN=$E(GMDATE,4,5)
I (GMMN'<1)&(GMMN'>12) D
. S GMMN=GMMN-1
. I GMMN=0 S GMMN=12,GMYR=GMYR-1
. I $L(GMMN)=1 S GMMN="0"_GMMN
. S GMTBEG=(GMYR-1700)_GMMN_"01"
. S GMTEND=$$SCH^XLFDT("1M(1)",GMTBEG)\1
. Q
E D
. S (GMTBEG,GMTEND)=""
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCCY 8149 printed Sep 23, 2025@19:21:25 Page 2
GMRCCY ;SFVAMC/DAD - Consult Closure Tool: Date Range Selector ;01/20/17 15:19
+1 ;;3.0;CONSULT/REQUEST TRACKING;**89**;DEC 27, 1997;Build 62
+2 ;Consult Closure Tool
+3 ;
+4 ; IA# Usage Component
+5 ; ---------------------------
+6 ; 10003 Supported ^%DT
+7 ; 10103 Supported $$FMTE^XLFDT
+8 ; 10103 Supported $$SCH^XLFDT
+9 ; 10104 Supported $$UP^XLFSTR
+10 ;
EN(GMTBEG,GMTEND,GMHEAD,GMRANG) ; *** Entry Point
+1 ; Input
+2 ; GMTBEG = Begin date - Default (FM Int) [Req, Pass by ref]
+3 ; GMTEND = End date - Default (FM Int) [Req, Pass by ref]
+4 ; GMHEAD = Header line [Opt, Pass by value]
+5 ; GMRANG = Date range type [Opt, Pass by value]
+6 ; M,M!,Q,Q!,S,S!,Y,Y!,F,F!,U,U! ("!" forces selection)
+7 ; Output
+8 ; $$EN() = 1 - Okay OR 0 - Exit
+9 ; GMTBEG = Begin date [If $$EN()=1 FM Int Date, Else ""]
+10 ; GMTEND = End date [If $$EN()=1 FM Int Date, Else ""]
+11 ;
+12 ; Example
+13 ; IF $$EN^GMDATE(.GMTBEG,.GMTEND,GMHEAD,GMRANG)'>0 QUIT
+14 ;
+15 NEW GM,GMDATA,GMDFLT,GMDONE,GMFRAM,GMQUIT,GMWHEN,X,Y
+16 SET (GMFRAM,GMFRAM(0))=""
+17 FOR GM=1:1
SET GMDATA=$PIECE($TEXT(FRAMDAT+GM),";;",2)
if GMDATA=U
QUIT
Begin DoDot:1
+18 SET GMFRAM=GMFRAM_U_$$UP^XLFSTR(GMDATA)
+19 SET GMFRAM(0)=GMFRAM(0)_GMDATA_$SELECT(GM<6:", ",1:"")
+20 QUIT
End DoDot:1
+21 FOR
Begin DoDot:1
+22 SET (GMQUIT,GMDONE)=0
+23 SET GMTBEG=$SELECT($GET(GMTBEG)\1?7N:GMTBEG\1,1:"")
+24 SET GMTEND=$SELECT($GET(GMTEND)\1?7N:GMTEND\1,1:"")
+25 SET GMDFLT=$$UP^XLFSTR($GET(GMRANG))_U_GMTBEG_U_GMTEND
+26 IF $GET(GMHEAD)]""
WRITE !,GMHEAD
+27 WRITE !,GMFRAM(0)
+28 WRITE !,"Select date range: "
+29 WRITE $SELECT($TRANSLATE($PIECE(GMDFLT,U),"!")]"":$TRANSLATE($PIECE(GMDFLT,U),"!")_"// ",1:"")
+30 SET GMWHEN=""
+31 IF $PIECE(GMDFLT,U)'["!"
READ GMWHEN:DTIME
if '$TEST
SET GMWHEN=U
+32 IF GMWHEN=""
SET GMWHEN=$TRANSLATE($PIECE(GMDFLT,U),"!")
WRITE GMWHEN
+33 IF (GMWHEN="")!($EXTRACT(GMWHEN)=U)
SET GMQUIT=1
QUIT
+34 SET GMWHEN=$$UP^XLFSTR(GMWHEN)
+35 IF $FIND(GMFRAM,U_GMWHEN)'>0
Begin DoDot:2
+36 DO BELL(GMWHEN)
+37 IF $PIECE(GMDFLT,U)["!"
SET GMQUIT=1
QUIT
+38 WRITE !!?5,"Enter the first few letters of "
+39 WRITE "one of the choices listed below.",!
+40 QUIT
End DoDot:2
QUIT
+41 WRITE $PIECE($PIECE(GMFRAM,U_GMWHEN,2),U)
+42 SET GMWHEN=$EXTRACT(GMWHEN)
+43 SET GMQUIT=$$ASKDATE(GMWHEN,GMDFLT,.GMTBEG,.GMTEND)
+44 IF GMQUIT
Begin DoDot:2
+45 SET GMQUIT=$SELECT($PIECE(GMDFLT,U)'["!":0,1:GMQUIT)
+46 IF GMQUIT'>0
WRITE !
+47 QUIT
End DoDot:2
+48 IF '$TEST
Begin DoDot:2
+49 SET GMDONE=1
+50 QUIT
End DoDot:2
+51 QUIT
End DoDot:1
if GMQUIT!GMDONE
QUIT
+52 SET GMQUIT='$GET(GMQUIT)
+53 IF GMQUIT>0
Begin DoDot:1
+54 WRITE !!,"Range selected: "
+55 WRITE $$FMTE^XLFDT(GMTBEG,"5Z")," to ",$$FMTE^XLFDT(GMTEND,"5Z")
+56 QUIT
End DoDot:1
+57 IF '$TEST
Begin DoDot:1
+58 SET (GMTBEG,GMTEND)=""
+59 QUIT
End DoDot:1
+60 QUIT GMQUIT
+61 ;
FRAMDAT ;; TimeFrameName
+1 ;;Monthly
+2 ;;Quarterly
+3 ;;Semi-Annually
+4 ;;Yearly
+5 ;;Fiscal Yearly
+6 ;;User Selectable
+7 ;;^
+8 ;
ASKDATE(GMWHEN,GMDFLT,GMTBEG,GMTEND) ; *** Prompt for date range
+1 NEW GMQUIT
+2 SET GMQUIT=1
+3 IF GMWHEN="M"
Begin DoDot:1
+4 SET GMQUIT=$$MONTH(GMWHEN,GMDFLT,.GMTBEG,.GMTEND)
+5 QUIT
End DoDot:1
+6 IF (GMWHEN="Q")!(GMWHEN="S")
Begin DoDot:1
+7 SET GMQUIT=$$QUART(GMWHEN,GMDFLT,.GMTBEG,.GMTEND)
+8 QUIT
End DoDot:1
+9 IF (GMWHEN="F")!(GMWHEN="Y")
Begin DoDot:1
+10 SET GMQUIT=$$YEAR(GMWHEN,GMDFLT,.GMTBEG,.GMTEND)
+11 QUIT
End DoDot:1
+12 IF GMWHEN="U"
Begin DoDot:1
+13 SET GMQUIT=$$USERSEL(GMWHEN,GMDFLT,.GMTBEG,.GMTEND)
+14 QUIT
End DoDot:1
+15 QUIT GMQUIT
+16 ;
MONTH(GMWHEN,GMDFLT,GMTBEG,GMTEND) ; *** Monthly
+1 NEW %DT,GM,GMDATA,GMDONE,GMEND,GMEOM,GMMNYR,GMMOE,GMQUIT,GMYEAR,X,Y
+2 FOR GM=1:1
SET GMDATA=$PIECE($TEXT(MONTHDAT+GM),";;",2)
if GMDATA=U
QUIT
Begin DoDot:1
+3 SET GMEOM($PIECE(GMDATA,U))=$PIECE(GMDATA,U,2,3)
+4 QUIT
End DoDot:1
+5 SET (GMQUIT,GMDONE)=0
+6 FOR
Begin DoDot:1
+7 KILL %DT
+8 SET %DT="AE"
+9 SET %DT("A")="Enter Month and Year: "
+10 IF $PIECE(GMDFLT,U,2)]""
Begin DoDot:2
+11 SET GMMNYR=$PIECE(GMDFLT,U,2)
+12 SET %DT("B")=$EXTRACT(GMMNYR,4,5)_"/"_(1700+$EXTRACT(GMMNYR,1,3))
+13 QUIT
End DoDot:2
+14 WRITE !
DO ^%DT
SET GMEND=+$GET(Y)
+15 IF GMEND'>0
SET GMQUIT=1
QUIT
+16 IF ('+$EXTRACT(GMEND,4,5))!(+$EXTRACT(GMEND,6,7))
Begin DoDot:2
+17 DO BELL("")
+18 WRITE !!,"Please enter a month and year"
+19 WRITE $SELECT(+$EXTRACT(GMEND,6,7):" only",1:"")
+20 QUIT
End DoDot:2
QUIT
+21 SET GMMOE=$EXTRACT(GMEND,4,5)
+22 SET GMTEND=$EXTRACT(GMEND,1,5)_$PIECE(GMEOM(GMMOE),U)
+23 IF $EXTRACT(GMTEND,4,5)="02"
Begin DoDot:2
+24 SET GMYEAR=1700+$EXTRACT(GMTEND,1,3)
+25 SET GMTEND=GMTEND+((GMYEAR#4=0)&((GMYEAR#100)!(GMYEAR#400=0)))
+26 QUIT
End DoDot:2
+27 SET GMTBEG=$EXTRACT(GMTEND,1,5)_"01"
+28 SET GMDONE=1
+29 QUIT
End DoDot:1
if (GMQUIT>0)!(GMDONE>0)
QUIT
+30 QUIT GMQUIT
+31 ;
MONTHDAT ;; MonthNumber ^ DaysInMonth ^ MonthName
+1 ;;01^31^JANUARY
+2 ;;02^28^FEBRUARY
+3 ;;03^31^MARCH
+4 ;;04^30^APRIL
+5 ;;05^31^MAY
+6 ;;06^30^JUNE
+7 ;;07^31^JULY
+8 ;;08^31^AUGUST
+9 ;;09^30^SEPTEMBER
+10 ;;10^31^OCTOBER
+11 ;;11^30^NOVEMBER
+12 ;;12^31^DECEMBER
+13 ;;^
+14 ;
QUART(GMWHEN,GMDFLT,GMTBEG,GMTEND) ; *** Quarterly & Semi-Annually
+1 NEW %DT,GM,GMDATA,GMDONE,GMMNDY,GMQU,GMQUIT,GMQUYR,GMSBEG,GMSEMI,GMYR,GMQART
+2 NEW GMQBEG,GMQEND,GMQQUA,X,Y
+3 SET GMSEMI=$SELECT(GMWHEN="S":1,1:0)
+4 FOR GM=1:1
SET GMDATA=$PIECE($TEXT(QUARTDAT+GM),";;",2)
if GMDATA=U
QUIT
Begin DoDot:1
+5 SET GMQQUA(GM)=$PIECE(GMDATA,U)
+6 SET GMQBEG(GM)="000"_$PIECE(GMDATA,U,2)
+7 SET GMSBEG(GM)="000"_$PIECE(GMDATA,U,3)
+8 SET GMQEND(GM)="000"_$PIECE(GMDATA,U,4)
+9 QUIT
End DoDot:1
+10 SET GMQUYR=""
+11 IF $PIECE(GMDFLT,U,2)]""
Begin DoDot:1
+12 SET GMMNDY=$EXTRACT($PIECE(GMDFLT,U,2),4,7)
+13 IF (GMMNDY'<GMQBEG(1))&(GMMNDY'>GMQEND(1))
SET GMQU=1
+14 IF (GMMNDY'<GMQBEG(2))&(GMMNDY'>GMQEND(2))
SET GMQU=2
+15 IF (GMMNDY'<GMQBEG(3))&(GMMNDY'>GMQEND(3))
SET GMQU=3
+16 IF (GMMNDY'<GMQBEG(4))&(GMMNDY'>GMQEND(4))
SET GMQU=4
+17 SET GMQUYR=$SELECT(GMQU>0:GMQU_"/"_(1700+$EXTRACT($PIECE(GMDFLT,U,2),1,3)+(GMQU=1)),1:"")
+18 QUIT
End DoDot:1
+19 SET (GMQUIT,GMDONE)=0
+20 FOR
Begin DoDot:1
+21 IF GMSEMI>0
Begin DoDot:2
+22 WRITE !!,"Enter Quarter Period and FY you "
+23 WRITE "wish Semi-Annual range to end with"
+24 QUIT
End DoDot:2
+25 WRITE !
+26 WRITE !,"Enter Quarter and Year: ",$SELECT(GMQUYR]"":GMQUYR_"// ",1:"")
+27 READ GMQART:DTIME
if '$TEST
SET GMQART=U
+28 IF GMQART=""
SET GMQART=GMQUYR
+29 IF (GMQART=U)!(GMQART="")
SET GMQUIT=1
QUIT
+30 IF (GMQART'?1N1P2N)&(GMQART'?1N1P4N)
Begin DoDot:2
+31 DO BELL(GMQART)
+32 WRITE !!,"Enter Quarter Period in this format: "
+33 WRITE "2nd quarter 1988 would be 2-88, 2/88, 2 88"
+34 QUIT
End DoDot:2
QUIT
+35 IF ($EXTRACT(GMQART)>4)!($EXTRACT(GMQART)<1)
Begin DoDot:2
+36 DO BELL("")
+37 WRITE !!,"Enter Quarter 1 to 4 only"
+38 QUIT
End DoDot:2
QUIT
+39 SET GMQU=$EXTRACT(GMQART)
+40 SET GMYR=$EXTRACT(GMQART,3,6)
+41 KILL %DT
SET X=GMYR
DO ^%DT
SET GMYR=$EXTRACT(Y,1,3)
+42 FOR GM=1:1:4
Begin DoDot:2
+43 SET GMQBEG(GM)=$SELECT(GM=1:GMYR-1,1:GMYR)_$EXTRACT(GMQBEG(GM),4,7)
+44 SET GMSBEG(GM)=$SELECT(GM'>2:GMYR-1,1:GMYR)_$EXTRACT(GMSBEG(GM),4,7)
+45 SET GMQEND(GM)=$SELECT(GM=1:GMYR-1,1:GMYR)_$EXTRACT(GMQEND(GM),4,7)
+46 QUIT
End DoDot:2
+47 SET GMTEND=GMQEND(GMQU)
+48 SET GMTBEG=$SELECT(GMSEMI:GMSBEG(GMQU),1:GMQBEG(GMQU))
+49 SET GMDONE=1
+50 QUIT
End DoDot:1
if (GMQUIT>0)!(GMDONE>0)
QUIT
+51 QUIT GMQUIT
+52 ;
QUARTDAT ;;Name ^ QuarterStart ^ SemiStart ^ QuarterEnd
+1 ;;FIRST^1001^0701^1231
+2 ;;SECOND^0101^1001^0331
+3 ;;THIRD^0401^0101^0630
+4 ;;FOURTH^0701^0401^0930
+5 ;;^
+6 ;
YEAR(GMWHEN,GMDFLT,GMTBEG,GMTEND) ; *** Yearly & Fiscal Yearly
+1 NEW %DT,GMDONE,GMFY,GMQUIT,GMYEAR,GMYR,X,Y
+2 SET GMFY=$SELECT(GMWHEN="F":1,1:0)
+3 SET (GMQUIT,GMDONE)=0
+4 FOR
Begin DoDot:1
+5 WRITE !!,"Enter ",$SELECT(GMFY:"FISCAL ",1:""),"YEAR: "
+6 SET GMYEAR=$SELECT($PIECE(GMDFLT,U,2)]"":1700+$EXTRACT($PIECE(GMDFLT,U,2),1,3),1:"")
+7 WRITE $SELECT(GMYEAR]"":GMYEAR_"// ",1:"")
+8 READ GMYR:DTIME
if '$TEST
SET GMYR=U
+9 IF GMYR=""
SET GMYR=GMYEAR
+10 IF (GMYR=U)!(GMYR="")
SET GMQUIT=1
QUIT
+11 IF (GMYR'?2N)&(GMYR'?4N)
Begin DoDot:2
+12 DO BELL(GMYR)
+13 WRITE !!,"Enter a 2 or 4 digit ",$SELECT(GMFY:"fiscal ",1:""),"year"
+14 QUIT
End DoDot:2
QUIT
+15 KILL %DT
SET X=GMYR
DO ^%DT
SET GMYR=$EXTRACT(Y,1,3)
+16 IF GMFY
Begin DoDot:2
+17 SET GMTBEG=GMYR-1_"1001"
+18 SET GMTEND=GMYR_"0930"
+19 QUIT
End DoDot:2
+20 IF '$TEST
Begin DoDot:2
+21 SET GMTBEG=GMYR_"0101"
+22 SET GMTEND=GMYR_"1231"
+23 QUIT
End DoDot:2
+24 SET GMDONE=1
+25 QUIT
End DoDot:1
if (GMQUIT>0)!(GMDONE>0)
QUIT
+26 QUIT GMQUIT
+27 ;
USERSEL(GMWHEN,GMDFLT,GMTBEG,GMTEND) ; *** User Selectable
+1 NEW %DT,GMBEG,GMEND,GMQUIT,X,Y
+2 SET GMQUIT=0
+3 WRITE !!,"Enter beginning and ending dates for the desired time period:",!
+4 KILL %DT
+5 SET %DT="AEX"
+6 SET %DT("A")="Beginning Date: "
+7 IF $PIECE(GMDFLT,U,2)]""
SET %DT("B")=$$FMTE^XLFDT($PIECE(GMDFLT,U,2),"5Z")
+8 DO ^%DT
SET GMBEG=+$GET(Y)
+9 IF GMBEG>0
Begin DoDot:1
+10 KILL %DT
+11 SET %DT="AEX"
+12 SET %DT(0)=GMBEG
+13 SET %DT("A")="Ending Date: "
+14 IF $PIECE(GMDFLT,U,3)]""
IF $PIECE(GMDFLT,U,3)'<GMBEG
Begin DoDot:2
+15 SET %DT("B")=$$FMTE^XLFDT($PIECE(GMDFLT,U,3),"5Z")
+16 QUIT
End DoDot:2
+17 IF '$TEST
Begin DoDot:2
+18 SET %DT("B")=$$FMTE^XLFDT(GMBEG,"5Z")
+19 QUIT
End DoDot:2
+20 DO ^%DT
SET GMEND=+$GET(Y)
+21 IF GMEND>0
Begin DoDot:2
+22 SET GMTBEG=GMBEG
+23 SET GMTEND=GMEND
+24 QUIT
End DoDot:2
+25 IF '$TEST
Begin DoDot:2
+26 SET GMQUIT=1
+27 QUIT
End DoDot:2
+28 QUIT
End DoDot:1
+29 IF '$TEST
Begin DoDot:1
+30 SET GMQUIT=1
+31 QUIT
End DoDot:1
+32 QUIT GMQUIT
+33 ;
BELL(X) ; *** Write ?? <Beep>
+1 IF $EXTRACT(X)'="?"
WRITE " ??",$CHAR(7)
+2 QUIT
+3 ;
LASTMNTH(GMDATE,GMTBEG,GMTEND) ; *** Compute last month date range
+1 NEW GMMN,GMYR
+2 SET GMYR=1700+$EXTRACT(GMDATE,1,3)
+3 SET GMMN=$EXTRACT(GMDATE,4,5)
+4 IF (GMMN'<1)&(GMMN'>12)
Begin DoDot:1
+5 SET GMMN=GMMN-1
+6 IF GMMN=0
SET GMMN=12
SET GMYR=GMYR-1
+7 IF $LENGTH(GMMN)=1
SET GMMN="0"_GMMN
+8 SET GMTBEG=(GMYR-1700)_GMMN_"01"
+9 SET GMTEND=$$SCH^XLFDT("1M(1)",GMTBEG)\1
+10 QUIT
End DoDot:1
+11 IF '$TEST
Begin DoDot:1
+12 SET (GMTBEG,GMTEND)=""
+13 QUIT
End DoDot:1
+14 QUIT
