ACRFNY1 ;IHS/OIRM/DSD/THL,AEF - CREATE FINANCIAL ACCOUNTS FOR THE NEW FISCAL YEAR, ALL ACCOUNTS; [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
;;ROUTINE TO CREATE FINANCIAL ACCOUNTS FOR THE NEW FISCAL YEAR
CREATE ;EP;TO CREATE NEXT FY ACCOUNTS
S ACR1=0
F S ACR1=$O(^TMP("ACRAPP",$J,ACR1)) Q:'ACR1 D
.I '$P(^ACRAPP(ACR1,0),U,6),'$P(^(0),U,7),$P(^(0),U,16)=1 D APPC I 1
.I '$P(^ACRAPP(ACR1,0),U,6),'$P(^(0),U,7),$P(^(0),U,16)'=1 S ACRAPP=ACR1
.S ACRAPP=$P(^ACRAPP(ACR1,0),U,7)
.Q:'$G(ACRAPP)
.S ACR2=0
.F S ACR2=$O(^TMP("ACRAPP",$J,ACR1,ACR2)) Q:'ACR2 D
..I '$P(^ACRALW(ACR2,0),U,6),'$P(^(0),U,7),$P(^(0),U,16)=1 D ALWC I 1
..E I '$P(^ACRALW(ACR2,0),U,6),'$P(^(0),U,7),$P(^(0),U,16)'=1 S ACRALW=ACR2
..E S ACRALW=$P(^ACRALW(ACR2,0),U,7)
..Q:'$G(ACRALW)
..S ACR3=0
..F S ACR3=$O(^TMP("ACRAPP",$J,ACR1,ACR2,ACR3)) Q:'ACR3 D
...I '$P(^ACRALC(ACR3,0),U,6),'$P(^(0),U,7),$P(^(0),U,16)=1 D ALCC I 1
...E I '$P(^ACRALC(ACR3,0),U,6),'$P(^(0),U,7),$P(^(0),U,16)'=1 S ACRALC=ACR3
...E S ACRALC=$P(^ACRALC(ACR3,0),U,7)
...Q:'$G(ACRALC)
...S ACR4=0
...F S ACR4=$O(^TMP("ACRAPP",$J,ACR1,ACR2,ACR3,ACR4)) Q:'ACR4 D
....I '$P(^ACRLOCB(ACR4,0),U,6),'$P(^(0),U,7),$P(^(0),U,16)=1 D ADAC
Q
APPC ;CREATE APPROPRIATION
S X=0
S DIC="^ACRAPP("
S DIC(0)="L"
D FILE^ACRFDIC
W !,"NEW APPROPRIATION ",+Y," CREATED FOR APPROPRIATION: ",ACR1
S (DA,ACRAPP,ACRNEWDA)=+Y
S ^ACRAPP(ACRNEWDA,0)=^ACRAPP(ACR1,0)
S $P(^ACRAPP(ACRNEWDA,0),U,2)=ACRAPPDA
S ^ACRAPP(ACRNEWDA,"DT")=^ACRAPP(ACR1,"DT")
S ^ACRAPP(ACRNEWDA,"CMT")=$G(^ACRAPP(ACR1,"CMT"))
S ^ACRAPP(ACRNEWDA,"PURP")=$G(^ACRAPP(ACR1,"PURP"))
S X=^ACRAPP(ACRNEWDA,"DT")
S $P(X,U,10)=""
S $P(X,U,11)=""
S ^ACRAPP(ACRNEWDA,"DT")=X
S %X="^ACRAPP("_ACR1_",""SC"","
S %Y="^ACRAPP("_ACRNEWDA_",""SC"","
S (ACRDIK,DIK)="^ACRAPP("
S ACROLD=ACR1
D DIK
S ACRTOT=+^ACRAPP(ACRNEWDA,0)
D APPC1
S DA=ACR1
S DIE="^ACRAPP("
S DR=".06////1;.07////"_ACRNEWDA
D DIE^ACRFDIC
S DA=ACRNEWDA
S DIE="^ACRAPP("
S DR="10////"_ACRFYNEW_";.15////"_ACR1
D DIE^ACRFDIC
Q
APPC1 ;CALCULATE RECURRING TOTAL
N ACRX
S ACRX=0
F S ACRX=$O(^ACRAPP("ORIG",ACR1,ACRX)) Q:'ACRX I $P(^ACRAPP(ACRX,0),U,6)'=1,$P($G(^ACRAPP(ACRX,"DT")),U,3)="R" S ACRTOT=ACRTOT+^ACRAPP(ACRX,0)
Q
ALWC ;CREATE ALLOWANCE
S X=0
S DIC="^ACRALW("
S DIC(0)="L"
D FILE^ACRFDIC
W !,"NEW ALLOWANCE ",+Y," CREATED FOR ALLOWANCE: ",ACR2
S (DA,ACRALW,ACRNEWDA)=+Y
S ^ACRALW(ACRNEWDA,0)=^ACRALW(ACR2,0)
S ^ACRALW(ACRNEWDA,"DT")=^ACRALW(ACR2,"DT")
S $P(^ACRALW(ACRNEWDA,"DT"),U,4)=ACRAPPDA
S ^ACRALW(ACRNEWDA,"CMT")=$G(^ACRALW(ACR2,"CMT"))
S ^ACRALW(ACRNEWDA,"PURP")=$G(^ACRALW(ACR2,"PURP"))
S X=^ACRALW(ACRNEWDA,0)
S $P(X,U,2)=ACRAPP
S $P(X,U,10)=""
S $P(X,U,11)=""
S ^ACRALW(ACRNEWDA,0)=X
S %X="^ACRALW("_(ACR2)_",""SC"","
S %Y="^ACRALW("_ACRNEWDA_",""SC"","
S (ACRDIK,DIK)="^ACRALW("
S ACROLD=ACR2
D DIK
S ACRTOT=+^ACRALW(ACRNEWDA,0)
D ALWC1
S DA=ACR2
S DIE="^ACRALW("
S DR=".06////1;.07////"_ACRNEWDA
D DIE^ACRFDIC
S DA=ACRNEWDA
S DIE="^ACRALW("
S DR="10////"_ACRFYNEW_";.15////"_ACR2
D DIE^ACRFDIC
Q
ALWC1 ;CALCULATE RECURRING TOTAL
N ACRX
S ACRX=0
F S ACRX=$O(^ACRALW("ORIG",ACR2,ACRX)) Q:'ACRX I $P(^ACRALW(ACRX,0),U,6)'=1,$P($G(^ACRALW(ACRX,"DT")),U,3)="R" S ACRTOT=ACRTOT+^ACRALW(ACRX,0)
Q
ALCC ;CREATE SUB-ALLOWANCE
S X=0
S DIC="^ACRALC("
S DIC(0)="L"
D FILE^ACRFDIC
W !,"NEW SUB-ALLOWANCE ",+Y," CREATED FOR SUB-ALLOWANCE: ",ACR3
S (DA,ACRALC,ACRNEWDA)=+Y
S ^ACRALC(ACRNEWDA,0)=^ACRALC(ACR3,0)
S ^ACRALC(ACRNEWDA,"DT")=^ACRALC(ACR3,"DT")
S $P(^ACRALC(ACRNEWDA,"DT"),U,4)=ACRAPPDA
S ^ACRALC(ACRNEWDA,"CMT")=$G(^ACRALC(ACR3,"CMT"))
S ^ACRALC(ACRNEWDA,"PURP")=$G(^ACRALC(ACR3,"PURP"))
S X=^ACRALC(ACRNEWDA,0)
S $P(X,U,2)=ACRAPP
S $P(X,U,3)=ACRALW
S $P(X,U,10)=""
S $P(X,U,11)=""
S ^ACRALC(ACRNEWDA,0)=X
S %X="^ACRALC("_(ACR3)_",""SC"","
S %Y="^ACRALC("_ACRNEWDA_",""SC"","
S (ACRDIK,DIK)="^ACRALC("
S ACROLD=ACR3
D DIK
S ACRTOT=+^ACRALC(ACRNEWDA,0)
D ALCC1
S DA=ACR3
S DIE="^ACRALC("
S DR=".06////1;.07////"_ACRNEWDA
D DIE^ACRFDIC
S DA=ACRNEWDA
S DIE="^ACRALC("
S DR="10////"_ACRFYNEW_";.15////"_ACR3
D DIE^ACRFDIC
Q
ALCC1 ;CALCULATE RECURRING TOTAL
N ACRX
S ACRX=0
F S ACRX=$O(^ACRALC("ORIG",ACR3,ACRX)) Q:'ACRX I $P(^ACRALC(ACRX,0),U,6)'=1,$P($G(^ACRALC(ACRX,"DT")),U,3)="R" S ACRTOT=ACRTOT+^ACRALC(ACRX,0)
Q
ADAC ;CREATE DEPARTMENT ACCOUNT
S X=0
S DIC="^ACRLOCB("
S DIC(0)="L"
D FILE^ACRFDIC
W !,"NEW DEPARTMENT ACCOUNT ",+Y," CREATED FOR DEPARTMENT ACCOUNT: ",ACR4
S (DA,ACRDAC,ACRNEWDA)=+Y
S ^ACRLOCB(ACRNEWDA,0)=^ACRLOCB(ACR4,0)
S ^ACRLOCB(ACRNEWDA,"DT")=^ACRLOCB(ACR4,"DT")
S $P(^ACRLOCB(ACRNEWDA,"DT"),U,4)=ACRAPPDA
S ^ACRLOCB(ACRNEWDA,"CMT")=$G(^ACRLOCB(ACR4,"CMT"))
S ^ACRLOCB(ACRNEWDA,"PURP")=$G(^ACRLOCB(ACR4,"PURP"))
S X=^ACRLOCB(ACRNEWDA,0)
S $P(X,U,2)=ACRAPP
S $P(X,U,3)=ACRALW
S $P(X,U,4)=ACRALC
S $P(X,U,10)=""
S $P(X,U,11)=""
S ^ACRLOCB(ACRNEWDA,0)=X
S %X="^ACRLOCB("_ACR4_",""CC"","
S %Y="^ACRLOCB("_ACRNEWDA_",""CC"","
D %XY^%RCR
S %X="^ACRLOCB("_ACR4_",2,"
S %Y="^ACRLOCB("_ACRNEWDA_",2,"
D %XY^%RCR
S %X="^ACRLOCB("_ACR4_",""SC"","
S %Y="^ACRLOCB("_ACRNEWDA_",""SC"","
S (ACRDIK,DIK)="^ACRLOCB("
S ACROLD=ACR4
D DIK
S ACRTOT=+^ACRLOCB(ACRNEWDA,0)
D ADAC1
S DA=ACR4
S DIE="^ACRLOCB("
S DR=".06////1;.07////"_ACRNEWDA
D DIE^ACRFDIC
S DA=ACRNEWDA
S DIE="^ACRLOCB("
S DR="10////"_ACRFYNEW_";.15////"_ACR4
D DIE^ACRFDIC
Q
ADAC1 ;CALCULATE RECURRING TOTAL
N ACRX
S ACRX=0
F S ACRX=$O(^ACRLOCB("ORIG",ACR4,ACRX)) Q:'ACRX I $P(^ACRLOCB(ACRX,0),U,6)'=1,$P($G(^ACRLOCB(ACRX,"DT")),U,3)="R" S ACRTOT=ACRTOT+^ACRLOCB(ACRX,0)
Q
DIK ;RE-INDEX NEWLY CREATED ACCOUNTS
D %XY^%RCR
S DA(1)=ACRNEWDA
D IX1^ACRFDIC
I $D(ACRMM) D UP^ACRFNY2
Q
ACRFNY1 ;IHS/OIRM/DSD/THL,AEF - CREATE FINANCIAL ACCOUNTS FOR THE NEW FISCAL YEAR, ALL ACCOUNTS; [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
+2 ;;ROUTINE TO CREATE FINANCIAL ACCOUNTS FOR THE NEW FISCAL YEAR
CREATE ;EP;TO CREATE NEXT FY ACCOUNTS
+1 SET ACR1=0
+2 FOR
SET ACR1=$ORDER(^TMP("ACRAPP",$JOB,ACR1))
IF 'ACR1
QUIT
Begin DoDot:1
+3 IF '$PIECE(^ACRAPP(ACR1,0),U,6)
IF '$PIECE(^(0),U,7)
IF $PIECE(^(0),U,16)=1
DO APPC
IF 1
+4 IF '$PIECE(^ACRAPP(ACR1,0),U,6)
IF '$PIECE(^(0),U,7)
IF $PIECE(^(0),U,16)'=1
SET ACRAPP=ACR1
+5 SET ACRAPP=$PIECE(^ACRAPP(ACR1,0),U,7)
+6 IF '$GET(ACRAPP)
QUIT
+7 SET ACR2=0
+8 FOR
SET ACR2=$ORDER(^TMP("ACRAPP",$JOB,ACR1,ACR2))
IF 'ACR2
QUIT
Begin DoDot:2
+9 IF '$PIECE(^ACRALW(ACR2,0),U,6)
IF '$PIECE(^(0),U,7)
IF $PIECE(^(0),U,16)=1
DO ALWC
IF 1
+10 IF '$TEST
IF '$PIECE(^ACRALW(ACR2,0),U,6)
IF '$PIECE(^(0),U,7)
IF $PIECE(^(0),U,16)'=1
SET ACRALW=ACR2
+11 IF '$TEST
SET ACRALW=$PIECE(^ACRALW(ACR2,0),U,7)
+12 IF '$GET(ACRALW)
QUIT
+13 SET ACR3=0
+14 FOR
SET ACR3=$ORDER(^TMP("ACRAPP",$JOB,ACR1,ACR2,ACR3))
IF 'ACR3
QUIT
Begin DoDot:3
+15 IF '$PIECE(^ACRALC(ACR3,0),U,6)
IF '$PIECE(^(0),U,7)
IF $PIECE(^(0),U,16)=1
DO ALCC
IF 1
+16 IF '$TEST
IF '$PIECE(^ACRALC(ACR3,0),U,6)
IF '$PIECE(^(0),U,7)
IF $PIECE(^(0),U,16)'=1
SET ACRALC=ACR3
+17 IF '$TEST
SET ACRALC=$PIECE(^ACRALC(ACR3,0),U,7)
+18 IF '$GET(ACRALC)
QUIT
+19 SET ACR4=0
+20 FOR
SET ACR4=$ORDER(^TMP("ACRAPP",$JOB,ACR1,ACR2,ACR3,ACR4))
IF 'ACR4
QUIT
Begin DoDot:4
+21 IF '$PIECE(^ACRLOCB(ACR4,0),U,6)
IF '$PIECE(^(0),U,7)
IF $PIECE(^(0),U,16)=1
DO ADAC
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+22 QUIT
APPC ;CREATE APPROPRIATION
+1 SET X=0
+2 SET DIC="^ACRAPP("
+3 SET DIC(0)="L"
+4 DO FILE^ACRFDIC
+5 WRITE !,"NEW APPROPRIATION ",+Y," CREATED FOR APPROPRIATION: ",ACR1
+6 SET (DA,ACRAPP,ACRNEWDA)=+Y
+7 SET ^ACRAPP(ACRNEWDA,0)=^ACRAPP(ACR1,0)
+8 SET $PIECE(^ACRAPP(ACRNEWDA,0),U,2)=ACRAPPDA
+9 SET ^ACRAPP(ACRNEWDA,"DT")=^ACRAPP(ACR1,"DT")
+10 SET ^ACRAPP(ACRNEWDA,"CMT")=$GET(^ACRAPP(ACR1,"CMT"))
+11 SET ^ACRAPP(ACRNEWDA,"PURP")=$GET(^ACRAPP(ACR1,"PURP"))
+12 SET X=^ACRAPP(ACRNEWDA,"DT")
+13 SET $PIECE(X,U,10)=""
+14 SET $PIECE(X,U,11)=""
+15 SET ^ACRAPP(ACRNEWDA,"DT")=X
+16 SET %X="^ACRAPP("_ACR1_",""SC"","
+17 SET %Y="^ACRAPP("_ACRNEWDA_",""SC"","
+18 SET (ACRDIK,DIK)="^ACRAPP("
+19 SET ACROLD=ACR1
+20 DO DIK
+21 SET ACRTOT=+^ACRAPP(ACRNEWDA,0)
+22 DO APPC1
+23 SET DA=ACR1
+24 SET DIE="^ACRAPP("
+25 SET DR=".06////1;.07////"_ACRNEWDA
+26 DO DIE^ACRFDIC
+27 SET DA=ACRNEWDA
+28 SET DIE="^ACRAPP("
+29 SET DR="10////"_ACRFYNEW_";.15////"_ACR1
+30 DO DIE^ACRFDIC
+31 QUIT
APPC1 ;CALCULATE RECURRING TOTAL
+1 NEW ACRX
+2 SET ACRX=0
+3 FOR
SET ACRX=$ORDER(^ACRAPP("ORIG",ACR1,ACRX))
IF 'ACRX
QUIT
IF $PIECE(^ACRAPP(ACRX,0),U,6)'=1
IF $PIECE($GET(^ACRAPP(ACRX,"DT")),U,3)="R"
SET ACRTOT=ACRTOT+^ACRAPP(ACRX,0)
+4 QUIT
ALWC ;CREATE ALLOWANCE
+1 SET X=0
+2 SET DIC="^ACRALW("
+3 SET DIC(0)="L"
+4 DO FILE^ACRFDIC
+5 WRITE !,"NEW ALLOWANCE ",+Y," CREATED FOR ALLOWANCE: ",ACR2
+6 SET (DA,ACRALW,ACRNEWDA)=+Y
+7 SET ^ACRALW(ACRNEWDA,0)=^ACRALW(ACR2,0)
+8 SET ^ACRALW(ACRNEWDA,"DT")=^ACRALW(ACR2,"DT")
+9 SET $PIECE(^ACRALW(ACRNEWDA,"DT"),U,4)=ACRAPPDA
+10 SET ^ACRALW(ACRNEWDA,"CMT")=$GET(^ACRALW(ACR2,"CMT"))
+11 SET ^ACRALW(ACRNEWDA,"PURP")=$GET(^ACRALW(ACR2,"PURP"))
+12 SET X=^ACRALW(ACRNEWDA,0)
+13 SET $PIECE(X,U,2)=ACRAPP
+14 SET $PIECE(X,U,10)=""
+15 SET $PIECE(X,U,11)=""
+16 SET ^ACRALW(ACRNEWDA,0)=X
+17 SET %X="^ACRALW("_(ACR2)_",""SC"","
+18 SET %Y="^ACRALW("_ACRNEWDA_",""SC"","
+19 SET (ACRDIK,DIK)="^ACRALW("
+20 SET ACROLD=ACR2
+21 DO DIK
+22 SET ACRTOT=+^ACRALW(ACRNEWDA,0)
+23 DO ALWC1
+24 SET DA=ACR2
+25 SET DIE="^ACRALW("
+26 SET DR=".06////1;.07////"_ACRNEWDA
+27 DO DIE^ACRFDIC
+28 SET DA=ACRNEWDA
+29 SET DIE="^ACRALW("
+30 SET DR="10////"_ACRFYNEW_";.15////"_ACR2
+31 DO DIE^ACRFDIC
+32 QUIT
ALWC1 ;CALCULATE RECURRING TOTAL
+1 NEW ACRX
+2 SET ACRX=0
+3 FOR
SET ACRX=$ORDER(^ACRALW("ORIG",ACR2,ACRX))
IF 'ACRX
QUIT
IF $PIECE(^ACRALW(ACRX,0),U,6)'=1
IF $PIECE($GET(^ACRALW(ACRX,"DT")),U,3)="R"
SET ACRTOT=ACRTOT+^ACRALW(ACRX,0)
+4 QUIT
ALCC ;CREATE SUB-ALLOWANCE
+1 SET X=0
+2 SET DIC="^ACRALC("
+3 SET DIC(0)="L"
+4 DO FILE^ACRFDIC
+5 WRITE !,"NEW SUB-ALLOWANCE ",+Y," CREATED FOR SUB-ALLOWANCE: ",ACR3
+6 SET (DA,ACRALC,ACRNEWDA)=+Y
+7 SET ^ACRALC(ACRNEWDA,0)=^ACRALC(ACR3,0)
+8 SET ^ACRALC(ACRNEWDA,"DT")=^ACRALC(ACR3,"DT")
+9 SET $PIECE(^ACRALC(ACRNEWDA,"DT"),U,4)=ACRAPPDA
+10 SET ^ACRALC(ACRNEWDA,"CMT")=$GET(^ACRALC(ACR3,"CMT"))
+11 SET ^ACRALC(ACRNEWDA,"PURP")=$GET(^ACRALC(ACR3,"PURP"))
+12 SET X=^ACRALC(ACRNEWDA,0)
+13 SET $PIECE(X,U,2)=ACRAPP
+14 SET $PIECE(X,U,3)=ACRALW
+15 SET $PIECE(X,U,10)=""
+16 SET $PIECE(X,U,11)=""
+17 SET ^ACRALC(ACRNEWDA,0)=X
+18 SET %X="^ACRALC("_(ACR3)_",""SC"","
+19 SET %Y="^ACRALC("_ACRNEWDA_",""SC"","
+20 SET (ACRDIK,DIK)="^ACRALC("
+21 SET ACROLD=ACR3
+22 DO DIK
+23 SET ACRTOT=+^ACRALC(ACRNEWDA,0)
+24 DO ALCC1
+25 SET DA=ACR3
+26 SET DIE="^ACRALC("
+27 SET DR=".06////1;.07////"_ACRNEWDA
+28 DO DIE^ACRFDIC
+29 SET DA=ACRNEWDA
+30 SET DIE="^ACRALC("
+31 SET DR="10////"_ACRFYNEW_";.15////"_ACR3
+32 DO DIE^ACRFDIC
+33 QUIT
ALCC1 ;CALCULATE RECURRING TOTAL
+1 NEW ACRX
+2 SET ACRX=0
+3 FOR
SET ACRX=$ORDER(^ACRALC("ORIG",ACR3,ACRX))
IF 'ACRX
QUIT
IF $PIECE(^ACRALC(ACRX,0),U,6)'=1
IF $PIECE($GET(^ACRALC(ACRX,"DT")),U,3)="R"
SET ACRTOT=ACRTOT+^ACRALC(ACRX,0)
+4 QUIT
ADAC ;CREATE DEPARTMENT ACCOUNT
+1 SET X=0
+2 SET DIC="^ACRLOCB("
+3 SET DIC(0)="L"
+4 DO FILE^ACRFDIC
+5 WRITE !,"NEW DEPARTMENT ACCOUNT ",+Y," CREATED FOR DEPARTMENT ACCOUNT: ",ACR4
+6 SET (DA,ACRDAC,ACRNEWDA)=+Y
+7 SET ^ACRLOCB(ACRNEWDA,0)=^ACRLOCB(ACR4,0)
+8 SET ^ACRLOCB(ACRNEWDA,"DT")=^ACRLOCB(ACR4,"DT")
+9 SET $PIECE(^ACRLOCB(ACRNEWDA,"DT"),U,4)=ACRAPPDA
+10 SET ^ACRLOCB(ACRNEWDA,"CMT")=$GET(^ACRLOCB(ACR4,"CMT"))
+11 SET ^ACRLOCB(ACRNEWDA,"PURP")=$GET(^ACRLOCB(ACR4,"PURP"))
+12 SET X=^ACRLOCB(ACRNEWDA,0)
+13 SET $PIECE(X,U,2)=ACRAPP
+14 SET $PIECE(X,U,3)=ACRALW
+15 SET $PIECE(X,U,4)=ACRALC
+16 SET $PIECE(X,U,10)=""
+17 SET $PIECE(X,U,11)=""
+18 SET ^ACRLOCB(ACRNEWDA,0)=X
+19 SET %X="^ACRLOCB("_ACR4_",""CC"","
+20 SET %Y="^ACRLOCB("_ACRNEWDA_",""CC"","
+21 DO %XY^%RCR
+22 SET %X="^ACRLOCB("_ACR4_",2,"
+23 SET %Y="^ACRLOCB("_ACRNEWDA_",2,"
+24 DO %XY^%RCR
+25 SET %X="^ACRLOCB("_ACR4_",""SC"","
+26 SET %Y="^ACRLOCB("_ACRNEWDA_",""SC"","
+27 SET (ACRDIK,DIK)="^ACRLOCB("
+28 SET ACROLD=ACR4
+29 DO DIK
+30 SET ACRTOT=+^ACRLOCB(ACRNEWDA,0)
+31 DO ADAC1
+32 SET DA=ACR4
+33 SET DIE="^ACRLOCB("
+34 SET DR=".06////1;.07////"_ACRNEWDA
+35 DO DIE^ACRFDIC
+36 SET DA=ACRNEWDA
+37 SET DIE="^ACRLOCB("
+38 SET DR="10////"_ACRFYNEW_";.15////"_ACR4
+39 DO DIE^ACRFDIC
+40 QUIT
ADAC1 ;CALCULATE RECURRING TOTAL
+1 NEW ACRX
+2 SET ACRX=0
+3 FOR
SET ACRX=$ORDER(^ACRLOCB("ORIG",ACR4,ACRX))
IF 'ACRX
QUIT
IF $PIECE(^ACRLOCB(ACRX,0),U,6)'=1
IF $PIECE($GET(^ACRLOCB(ACRX,"DT")),U,3)="R"
SET ACRTOT=ACRTOT+^ACRLOCB(ACRX,0)
+4 QUIT
DIK ;RE-INDEX NEWLY CREATED ACCOUNTS
+1 DO %XY^%RCR
+2 SET DA(1)=ACRNEWDA
+3 DO IX1^ACRFDIC
+4 IF $DATA(ACRMM)
DO UP^ACRFNY2
+5 QUIT
