ACRFNY ;IHS/OIRM/DSD/THL,AEF - CREATE FINANCIAL ACCOUNTS FOR THE NEW FISCAL YEAR, ALL ACCOUNTS; [ 01/02/2003 8:02 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**5**;NOV 05, 2001
;;ROUTINE TO CREATE FINANCIAL ACCOUNTS FOR THE NEW FISCAL YEAR
EN D EXIT
D EN1
EXIT K ACR,^TMP("ACRAPP",$J),ACR0,ACR1,ACR2,ACR3,ACR4,ACRACTDA,ACRALC,ACRALW,ACRAPP,ACRAPPDA,ACRDAC,ACRFY,ACRFYN,ACRFYNEW,ACRRTN,ACRY,ACRNO,ACRNEWDA,ACRALCDA,ACRALWDA,ACRMM,ACRDIK,ACRQUIT,ACROUT,ACRLBDA,ACROLD,ACRAPPX
Q
EN1 D SELECT
Q:$D(ACRQUIT)
S ACRAPPX=""
I ACRAPP["/" D Q:$D(ACRQUIT)
.N X,Y,Z
.S X=$P(ACRAPP,"/")
.S Y=$P(ACRAPP,"/",2)
.S Z=$E(X,$L(X))+1
.S:$L(Z)=2 Z=$E(Z,2)
.S X=$E(X,1,$L(X)-1)_Z
.S Z=$E(Y)+1
.S:$L(Z)=2 Z=$E(Z,2)
.S Y=Z_$E(Y,2,99)
.S ACRAPPX=X_"/"_Y
.S DIR(0)="SO^1:Create FY "_$E(X,$L(X))_" Dept. Accts for "_ACRAPP_";2:Create FY "_$E(X,$L(X))_" Dept. Accts for "_ACRAPPX
.S DIR("A")="Which one"
.W !
.D DIR^ACRFDIC
.I +Y<1 S ACRQUIT="" Q
.S ACRAPP=$S(Y=1:ACRAPP,1:ACRAPPX)
.S ACRAPPX=$S(Y=2:"",1:ACRAPPX)
.D ^ACRFNY2
S DIR(0)="PO^9999999.51:AENQ"
S DIR("A")="Create NEXT FY Accounts for APPROPRIATION NO."
S DIR("B")=ACRAPP
W !
D DIR^ACRFDIC:$G(ACRNO)'=2
Q:+Y<1
S ACRAPPDA=$S($G(ACRNO)'=2:+Y,1:ACRAPPDA)
I $G(ACRNO)=2 S DA=ACRAPPDA,DIE="^ACRAPP(" D NO
D NFY
Q:$G(ACRFYNEW)=""
W !!,"Create NEW ",$S($G(ACRNO)'=2:"Allowances, Sub-Allowances and ",1:""),"Department Accounts"
W !,"for APPROPRIATION ",$P(^AUTTPRO(ACRAPPDA,0),U)," (FY ",ACRFYNEW,")"
W !,"Based on accounts from Fiscal Year ",ACRFY
S DIR(0)="YO"
S DIR("A")="Is that correct"
S DIR("B")="NO"
W !
D DIR^ACRFDIC
Q:Y'=1
D ZIS
Q
NO Q:$G(DIE)=""!($G(DA)="")
N X,Y,Z
S DR=".16////2"
D DIE^ACRFDIC
Q
SELECT ;EP;SELECT APPROPRIATION ACCOUNT
S DIR(0)="PO^9002185:AENQ"
S DIR("A")="Select THIS FY appropriation account ID NO."
W !
D DIR^ACRFDIC
I +Y<1 S ACRQUIT="" Q
S ACRACTDA=+Y
S ACRFY=$P(^ACRAPP(+Y,"DT"),U) ; fiscal year in in the format 9999
S ACRAPPDA=$P(^ACRAPP(+Y,"DT"),U,4)
S ACRAPP=$P(^AUTTPRO(ACRAPPDA,0),U)
;S:ACRAPP["X" ACRNO=2 ;ACR*2.1*5.07
S ACRFYN=ACRFY+1
S:$L(ACRFYN)=4 ACRFYN=$E(ACRFYN,4)
S ACRAPP=$S(ACRAPP'["X"&(ACRAPP'["/"):(75_ACRFYN_$E(ACRAPP,4,7)),1:ACRAPP)
Q
CREATE ;EP;TO CREATE NEW FY ACCOUNTS
D APP,CREATE^ACRFNY1
Q
APP ;CREATE TMP ARRAY OF ALL CURRENT YEAR ACCOUNTS FROM THE APPROPRIAITON
;LEVEL DOWN TO THE DEPARTMENT ACCOUNT LEVEL
N X,Y,Z,J
K ACRNO
S X=ACRACTDA
S ACRAPP=$P(^AUTTPRO($P(^ACRAPP(X,"DT"),U,4),0),U)
;S:ACRAPP["X" ACRNO=2 ;ACR*2.1*5.07
;S:ACRAPP["X"&'$D(ACRMM) ACRNO=2 ;ACR*2.1*5.07
S ^TMP("ACRAPP",$J,X)=""
S Y=0
F S Y=$O(^ACRALW("M",X,Y)) Q:'Y I $D(^ACRALW(Y,0)),$D(^ACRALW(Y,"DT")) D
.I $G(ACRNO)=2 S DA=Y,DIE="^ACRALW(" D NO
.S ^TMP("ACRAPP",$J,X,Y)=""
.S Z=0
.F S Z=$O(^ACRALC("M",Y,Z)) Q:'Z I $D(^ACRALC(Z,0)),$D(^ACRALC(Z,"DT")) D
..I $G(ACRNO)=2 S DA=Z,DIE="^ACRALC(" D NO
..S ^TMP("ACRAPP",$J,X,Y,Z)=""
..S J=0
..F S J=$O(^ACRLOCB("M",Z,J)) Q:'J I $D(^ACRLOCB(J,0)),$D(^ACRLOCB(J,"DT")) D
...S ACR0=^ACRLOCB(J,0)
...I $P(ACR0,U,16)=1 S ^TMP("ACRAPP",$J,X,Y,Z,J)=""
Q
ZIS S ACRRTN="CREATE^ACRFNY"
S ZTDESC="ARMS FUND ACCOUNT CREATION REPORT"
D ^ACRFZIS
Q
NFY ;SELECT FISCAL YEAR FOR NEW ACCOUNTS
I ACRAPP'["X",ACRAPP'["/" S ACRFYNEW=ACRFY+1
E S ACRFYNEW=$S($E(DT,4,5)<7:DT\10000,1:DT\10000+1)+1700
S DIR(0)="NO^1000:9999"
S DIR("A")="Fiscal Year for new Accounts"
S DIR("B")=ACRFYNEW
D DIR^ACRFDIC
I $L(Y)'=4 K ACRFYNEW S ACDQUIT="" Q
S ACRFYNEW=Y
Q
ACRFNY ;IHS/OIRM/DSD/THL,AEF - CREATE FINANCIAL ACCOUNTS FOR THE NEW FISCAL YEAR, ALL ACCOUNTS; [ 01/02/2003 8:02 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**5**;NOV 05, 2001
+2 ;;ROUTINE TO CREATE FINANCIAL ACCOUNTS FOR THE NEW FISCAL YEAR
EN DO EXIT
+1 DO EN1
EXIT KILL ACR,^TMP("ACRAPP",$JOB),ACR0,ACR1,ACR2,ACR3,ACR4,ACRACTDA,ACRALC,ACRALW,ACRAPP,ACRAPPDA,ACRDAC,ACRFY,ACRFYN,ACRFYNEW,ACRRTN,ACRY,ACRNO,ACRNEWDA,ACRALCDA,ACRALWDA,ACRMM,ACRDIK,ACRQUIT,ACROUT,ACRLBDA,ACROLD,ACRAPPX
+1 QUIT
EN1 DO SELECT
+1 IF $DATA(ACRQUIT)
QUIT
+2 SET ACRAPPX=""
+3 IF ACRAPP["/"
Begin DoDot:1
+4 NEW X,Y,Z
+5 SET X=$PIECE(ACRAPP,"/")
+6 SET Y=$PIECE(ACRAPP,"/",2)
+7 SET Z=$EXTRACT(X,$LENGTH(X))+1
+8 IF $LENGTH(Z)=2
SET Z=$EXTRACT(Z,2)
+9 SET X=$EXTRACT(X,1,$LENGTH(X)-1)_Z
+10 SET Z=$EXTRACT(Y)+1
+11 IF $LENGTH(Z)=2
SET Z=$EXTRACT(Z,2)
+12 SET Y=Z_$EXTRACT(Y,2,99)
+13 SET ACRAPPX=X_"/"_Y
+14 SET DIR(0)="SO^1:Create FY "_$EXTRACT(X,$LENGTH(X))_" Dept. Accts for "_ACRAPP_";2:Create FY "_$EXTRACT(X,$LENGTH(X))_" Dept. Accts for "_ACRAPPX
+15 SET DIR("A")="Which one"
+16 WRITE !
+17 DO DIR^ACRFDIC
+18 IF +Y<1
SET ACRQUIT=""
QUIT
+19 SET ACRAPP=$SELECT(Y=1:ACRAPP,1:ACRAPPX)
+20 SET ACRAPPX=$SELECT(Y=2:"",1:ACRAPPX)
+21 DO ^ACRFNY2
End DoDot:1
IF $DATA(ACRQUIT)
QUIT
+22 SET DIR(0)="PO^9999999.51:AENQ"
+23 SET DIR("A")="Create NEXT FY Accounts for APPROPRIATION NO."
+24 SET DIR("B")=ACRAPP
+25 WRITE !
+26 IF $GET(ACRNO)'=2
DO DIR^ACRFDIC
+27 IF +Y<1
QUIT
+28 SET ACRAPPDA=$SELECT($GET(ACRNO)'=2:+Y,1:ACRAPPDA)
+29 IF $GET(ACRNO)=2
SET DA=ACRAPPDA
SET DIE="^ACRAPP("
DO NO
+30 DO NFY
+31 IF $GET(ACRFYNEW)=""
QUIT
+32 WRITE !!,"Create NEW ",$SELECT($GET(ACRNO)'=2:"Allowances, Sub-Allowances and ",1:""),"Department Accounts"
+33 WRITE !,"for APPROPRIATION ",$PIECE(^AUTTPRO(ACRAPPDA,0),U)," (FY ",ACRFYNEW,")"
+34 WRITE !,"Based on accounts from Fiscal Year ",ACRFY
+35 SET DIR(0)="YO"
+36 SET DIR("A")="Is that correct"
+37 SET DIR("B")="NO"
+38 WRITE !
+39 DO DIR^ACRFDIC
+40 IF Y'=1
QUIT
+41 DO ZIS
+42 QUIT
NO IF $GET(DIE)=""!($GET(DA)="")
QUIT
+1 NEW X,Y,Z
+2 SET DR=".16////2"
+3 DO DIE^ACRFDIC
+4 QUIT
SELECT ;EP;SELECT APPROPRIATION ACCOUNT
+1 SET DIR(0)="PO^9002185:AENQ"
+2 SET DIR("A")="Select THIS FY appropriation account ID NO."
+3 WRITE !
+4 DO DIR^ACRFDIC
+5 IF +Y<1
SET ACRQUIT=""
QUIT
+6 SET ACRACTDA=+Y
+7 ; fiscal year in in the format 9999
SET ACRFY=$PIECE(^ACRAPP(+Y,"DT"),U)
+8 SET ACRAPPDA=$PIECE(^ACRAPP(+Y,"DT"),U,4)
+9 SET ACRAPP=$PIECE(^AUTTPRO(ACRAPPDA,0),U)
+10 ;S:ACRAPP["X" ACRNO=2 ;ACR*2.1*5.07
+11 SET ACRFYN=ACRFY+1
+12 IF $LENGTH(ACRFYN)=4
SET ACRFYN=$EXTRACT(ACRFYN,4)
+13 SET ACRAPP=$SELECT(ACRAPP'["X"&(ACRAPP'["/"):(75_ACRFYN_$EXTRACT(ACRAPP,4,7)),1:ACRAPP)
+14 QUIT
CREATE ;EP;TO CREATE NEW FY ACCOUNTS
+1 DO APP
DO CREATE^ACRFNY1
+2 QUIT
APP ;CREATE TMP ARRAY OF ALL CURRENT YEAR ACCOUNTS FROM THE APPROPRIAITON
+1 ;LEVEL DOWN TO THE DEPARTMENT ACCOUNT LEVEL
+2 NEW X,Y,Z,J
+3 KILL ACRNO
+4 SET X=ACRACTDA
+5 SET ACRAPP=$PIECE(^AUTTPRO($PIECE(^ACRAPP(X,"DT"),U,4),0),U)
+6 ;S:ACRAPP["X" ACRNO=2 ;ACR*2.1*5.07
+7 ;S:ACRAPP["X"&'$D(ACRMM) ACRNO=2 ;ACR*2.1*5.07
+8 SET ^TMP("ACRAPP",$JOB,X)=""
+9 SET Y=0
+10 FOR
SET Y=$ORDER(^ACRALW("M",X,Y))
IF 'Y
QUIT
IF $DATA(^ACRALW(Y,0))
IF $DATA(^ACRALW(Y,"DT"))
Begin DoDot:1
+11 IF $GET(ACRNO)=2
SET DA=Y
SET DIE="^ACRALW("
DO NO
+12 SET ^TMP("ACRAPP",$JOB,X,Y)=""
+13 SET Z=0
+14 FOR
SET Z=$ORDER(^ACRALC("M",Y,Z))
IF 'Z
QUIT
IF $DATA(^ACRALC(Z,0))
IF $DATA(^ACRALC(Z,"DT"))
Begin DoDot:2
+15 IF $GET(ACRNO)=2
SET DA=Z
SET DIE="^ACRALC("
DO NO
+16 SET ^TMP("ACRAPP",$JOB,X,Y,Z)=""
+17 SET J=0
+18 FOR
SET J=$ORDER(^ACRLOCB("M",Z,J))
IF 'J
QUIT
IF $DATA(^ACRLOCB(J,0))
IF $DATA(^ACRLOCB(J,"DT"))
Begin DoDot:3
+19 SET ACR0=^ACRLOCB(J,0)
+20 IF $PIECE(ACR0,U,16)=1
SET ^TMP("ACRAPP",$JOB,X,Y,Z,J)=""
End DoDot:3
End DoDot:2
End DoDot:1
+21 QUIT
ZIS SET ACRRTN="CREATE^ACRFNY"
+1 SET ZTDESC="ARMS FUND ACCOUNT CREATION REPORT"
+2 DO ^ACRFZIS
+3 QUIT
NFY ;SELECT FISCAL YEAR FOR NEW ACCOUNTS
+1 IF ACRAPP'["X"
IF ACRAPP'["/"
SET ACRFYNEW=ACRFY+1
+2 IF '$TEST
SET ACRFYNEW=$SELECT($EXTRACT(DT,4,5)<7:DT\10000,1:DT\10000+1)+1700
+3 SET DIR(0)="NO^1000:9999"
+4 SET DIR("A")="Fiscal Year for new Accounts"
+5 SET DIR("B")=ACRFYNEW
+6 DO DIR^ACRFDIC
+7 IF $LENGTH(Y)'=4
KILL ACRFYNEW
SET ACDQUIT=""
QUIT
+8 SET ACRFYNEW=Y
+9 QUIT
