APCLFY.m

APCLFY ; IHS/CMI/LAB - FISCAL YEAR process routine ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ;CMI/TUCSON/LAB - patch 3 Y2K and fixed FY prompting

 ;

START ;beginning of routine 

 ;beginning Y2K.  This entire routine has been modified.

 ;It was not properly handling FY's that begin in a month other

 ;than October or January.  This really isn't related to the Year

 ;2000.  Years were being handled properly, it is the calculating

 ;of the beginning and ending dates of the FY that was not

 ;working right.  CMI/TUCSON/LAB 11/4/1998

 ;Y2000

 K APCL

 I $P($G(^APCCCTRL(DUZ(2),0)),U,8)]"" D MONTH

 E  S APCL("FY MONTH")=10

GETFY ;get FY

 K %DT S %DT="AE",%DT("A")="Enter FISCAL YEAR:  ",%DT("B")=(1700+$E(DT,1,3)) D ^%DT K %DT

 I Y=-1 S APCL("FY")=-1 D XIT Q

 S APCL("FY")=1700+$E(Y,1,3) ;external year (e.g. 1998, 2000)

 S APCL("FY YEAR")=Y

 I APCL("FY MONTH")'=10 D GETDATES,XIT Q  ;if a beginning month other than 10 or 1 get beginning and ending dates from user

 S APCL("FY BEG DATE")=($E(APCL("FY YEAR"),1,3)-1)_1001

 S APCL("FY WORKING DT")=$$FMADD^XLFDT(APCL("FY BEG DATE"),-1)

 S APCL("FY END DATE")=$E(APCL("FY BEG DATE"),1,3)+1_$E(APCL("FY WORKING DT"),4,7)

 D XIT

 Q

 ;

GETDATES ;new subroutine

 W !!!,"The PCC Master Control file indicates that your FY begins in a month other",!,"than October so you must indicate the beginning and ending dates",!,"for your FY ",APCL("FY"),".",!

B ;get beginning date

 W ! S DIR(0)="D^:DT:EP",DIR("A")="Enter beginning date of FY "_APCL("FY") D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) S APCL("FY")=-1 D XIT Q

 S APCL("FY BEG DATE")=Y

E ;get ending date

 W ! S DIR(0)="D^"_APCL("FY BEG DATE")_"::EP",DIR("A")="Enter ending Date of FY "_APCL("FY") D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) G B

 S APCL("FY END DATE")=Y

 S X1=APCL("FY BEG DATE"),X2=-1 D C^%DTC S APCL("FY WORKING DT")=X

 D XIT

 Q

 ;Y2000

 ;end Y2K

 ;K APCL

 ;I $D(^APCCCTRL(DUZ(2))),($P(^(DUZ(2),0),U,8)]"") D MONTH

 ;E  S APCL("FY MONTH")=10

 ;S Y=DT D DD^%DT S APCL("FY TODAY")=Y

FYYEAR ;process FISCAL YEAR 

 ;S %DT="AE",%DT("A")="Enter FISCAL YEAR:  ",%DT("B")=$E(DT,2,3) D ^%DT K %DT

 ;G:Y=-1 XIT

 ;S APCL("FY")=X

 ;I $E(APCL("FY MONTH"),1)=1 S APCL("FY YEAR")=$E(Y,1,3),APCL("FY YEAR")=APCL("FY YEAR")-1

 ;S:'$D(APCL("FY YEAR")) APCL("FY YEAR")=$E(Y,1,3)

FYDATE ;process beginning DATE for fiscal year

 ;S APCL("FY BEG DATE")=APCL("FY YEAR")_APCL("FY MONTH")_"01"

 ;S Y=APCL("FY BEG DATE") X ^DD("DD")

 ;S APCL("FY PRINTABLE BDATE")=Y

WORKDATE ;setup WORKING start day

 ;S X1=APCL("FY BEG DATE"),X2=-1 D C^%DTC

 ;S APCL("FY WORKING DT")=X_".9999"

FYEND ;set up END date for fiscal year

 ;S APCL("FY YR ADD")=$E(APCL("FY WORKING DT"),1,3)+1

 ;S APCL("FY END DATE")=APCL("FY YR ADD")_$E(APCL("FY WORKING DT"),4,7)

 ;S Y=APCL("FY END DATE") X ^DD("DD")

 ;S APCL("FY PRINTABLE EDATE")=Y

XIT ;end of routine

 K %DT

 Q

 ;---------------------------------------------------------------------

MONTH ;setup MONTH for process

 S APCL("FY MONTH")=$P(^APCCCTRL(DUZ(2),0),U,8)

 S APCL("FY MONTH NAME")=$$EXTSET^XBFUNC(9001000,.08,APCL("FY MONTH"))

 S:$L(APCL("FY MONTH"))'=2 APCL("FY MONTH")=0_APCL("FY MONTH")

 Q

FYENDDT ;set up END date for fiscal year

 S APCL("FY YR ADD")=$E(APCL("FY WORKING DT"),1,3)+1

 S APCL("FY END DATE")=APCL("FY YR ADD")_$E(APCL("FY WORKING DT"),4,7)

 S Y=APCL("FY END DATE") X ^DD("DD")

 S APCL("FY PRINTABLE EDATE")=Y

 Q

ENDDATE ;if FLAG=1

 D:APCL("FYEND FLAG")=1 FYENDDT

APCLFY    ; IHS/CMI/LAB - FISCAL YEAR process routine ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;CMI/TUCSON/LAB - patch 3 Y2K and fixed FY prompting

 +3       ;

START     ;beginning of routine 

 +1       ;beginning Y2K.  This entire routine has been modified.

 +2       ;It was not properly handling FY's that begin in a month other

 +3       ;than October or January.  This really isn't related to the Year

 +4       ;2000.  Years were being handled properly, it is the calculating

 +5       ;of the beginning and ending dates of the FY that was not

 +6       ;working right.  CMI/TUCSON/LAB 11/4/1998

 +7       ;Y2000

 +8        KILL APCL

 +9        IF $PIECE($GET(^APCCCTRL(DUZ(2),0)),U,8)]""

               DO MONTH

 +10      IF '$TEST

               SET APCL("FY MONTH")=10

GETFY     ;get FY

 +1        KILL %DT

           SET %DT="AE"

           SET %DT("A")="Enter FISCAL YEAR:  "

           SET %DT("B")=(1700+$EXTRACT(DT,1,3))

           DO ^%DT

           KILL %DT

 +2        IF Y=-1

               SET APCL("FY")=-1

               DO XIT

               QUIT 

 +3       ;external year (e.g. 1998, 2000)

           SET APCL("FY")=1700+$EXTRACT(Y,1,3)

 +4        SET APCL("FY YEAR")=Y

 +5       ;if a beginning month other than 10 or 1 get beginning and ending dates from user

           IF APCL("FY MONTH")'=10

               DO GETDATES

               DO XIT

               QUIT 

 +6        SET APCL("FY BEG DATE")=($EXTRACT(APCL("FY YEAR"),1,3)-1)_1001

 +7        SET APCL("FY WORKING DT")=$$FMADD^XLFDT(APCL("FY BEG DATE"),-1)

 +8        SET APCL("FY END DATE")=$EXTRACT(APCL("FY BEG DATE"),1,3)+1_$EXTRACT(APCL("FY WORKING DT"),4,7)

 +9        DO XIT

 +10       QUIT 

 +11      ;

GETDATES  ;new subroutine

 +1        WRITE !!!,"The PCC Master Control file indicates that your FY begins in a month other",!,"than October so you must indicate the beginning and ending dates",!,"for your FY ",APCL("FY"),".",!

B         ;get beginning date

 +1        WRITE !

           SET DIR(0)="D^:DT:EP"

           SET DIR("A")="Enter beginning date of FY "_APCL("FY")

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DIRUT)

               SET APCL("FY")=-1

               DO XIT

               QUIT 

 +3        SET APCL("FY BEG DATE")=Y

E         ;get ending date

 +1        WRITE !

           SET DIR(0)="D^"_APCL("FY BEG DATE")_"::EP"

           SET DIR("A")="Enter ending Date of FY "_APCL("FY")

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DIRUT)

               GOTO B

 +3        SET APCL("FY END DATE")=Y

 +4        SET X1=APCL("FY BEG DATE")

           SET X2=-1

           DO C^%DTC

           SET APCL("FY WORKING DT")=X

 +5        DO XIT

 +6        QUIT 

 +7       ;Y2000

 +8       ;end Y2K

 +9       ;K APCL

 +10      ;I $D(^APCCCTRL(DUZ(2))),($P(^(DUZ(2),0),U,8)]"") D MONTH

 +11      ;E  S APCL("FY MONTH")=10

 +12      ;S Y=DT D DD^%DT S APCL("FY TODAY")=Y

FYYEAR    ;process FISCAL YEAR 

 +1       ;S %DT="AE",%DT("A")="Enter FISCAL YEAR:  ",%DT("B")=$E(DT,2,3) D ^%DT K %DT

 +2       ;G:Y=-1 XIT

 +3       ;S APCL("FY")=X

 +4       ;I $E(APCL("FY MONTH"),1)=1 S APCL("FY YEAR")=$E(Y,1,3),APCL("FY YEAR")=APCL("FY YEAR")-1

 +5       ;S:'$D(APCL("FY YEAR")) APCL("FY YEAR")=$E(Y,1,3)

FYDATE    ;process beginning DATE for fiscal year

 +1       ;S APCL("FY BEG DATE")=APCL("FY YEAR")_APCL("FY MONTH")_"01"

 +2       ;S Y=APCL("FY BEG DATE") X ^DD("DD")

 +3       ;S APCL("FY PRINTABLE BDATE")=Y

WORKDATE  ;setup WORKING start day

 +1       ;S X1=APCL("FY BEG DATE"),X2=-1 D C^%DTC

 +2       ;S APCL("FY WORKING DT")=X_".9999"

FYEND     ;set up END date for fiscal year

 +1       ;S APCL("FY YR ADD")=$E(APCL("FY WORKING DT"),1,3)+1

 +2       ;S APCL("FY END DATE")=APCL("FY YR ADD")_$E(APCL("FY WORKING DT"),4,7)

 +3       ;S Y=APCL("FY END DATE") X ^DD("DD")

 +4       ;S APCL("FY PRINTABLE EDATE")=Y

XIT       ;end of routine

 +1        KILL %DT

 +2        QUIT 

 +3       ;---------------------------------------------------------------------

MONTH     ;setup MONTH for process

 +1        SET APCL("FY MONTH")=$PIECE(^APCCCTRL(DUZ(2),0),U,8)

 +2        SET APCL("FY MONTH NAME")=$$EXTSET^XBFUNC(9001000,.08,APCL("FY MONTH"))

 +3        IF $LENGTH(APCL("FY MONTH"))'=2

               SET APCL("FY MONTH")=0_APCL("FY MONTH")

 +4        QUIT 

FYENDDT   ;set up END date for fiscal year

 +1        SET APCL("FY YR ADD")=$EXTRACT(APCL("FY WORKING DT"),1,3)+1

 +2        SET APCL("FY END DATE")=APCL("FY YR ADD")_$EXTRACT(APCL("FY WORKING DT"),4,7)

 +3        SET Y=APCL("FY END DATE")

           XECUTE ^DD("DD")

 +4        SET APCL("FY PRINTABLE EDATE")=Y

 +5        QUIT 

ENDDATE   ;if FLAG=1

 +1        IF APCL("FYEND FLAG")=1

               DO FYENDDT