- 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
