ACRFNY3 ;IHS/OIRM/DSD/THL,AEF - CONVERT TO NEW FINANCE INFO FOR M&M; [ 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
EN D EN1
EXIT K ACRPROC,ACRMMAPP,ACRMMALW
Q
EN1 K ACRMM
D HEAD
S DIR(0)="YO"
S DIR("A")="Convert to the new ACCOUNTING data"
S DIR("B")="NO"
W !
D DIR^ACRFDIC
Q:+Y'=1
S DIC="^AUTTPRO("
S DIC(0)="AEMQZ"
S DIC("A")="Which appropriation...: "
W !
D DIC^ACRFDIC
I +Y<1 S ACRQUIT="" Q
S ACRAPPDA=+Y
S ACRAPP=$P(^AUTTPRO(+Y,0),U)
S ACRMMAPP=X_U_ACRAPP
S DIC="^AUTTALLW("
S DIC(0)="AEMQZ"
S DIC("A")="Which ALLOWANCE.......: "
W !
D DIC^ACRFDIC
I +Y<1 K ACRMM S ACRQUIT="" Q
S ACRALWDA=+Y
S ACRALW=$P(Y(0),U)
S DIC="^AUTTSSA("
S DIC(0)="AEMQZ"
S DIC("A")="Which SUB-SUB-ACTIVITY: "
W !
D DIC^ACRFDIC
I +Y<1 K ACRMM S ACRQUIT="" Q
S ACRSSADA=+Y
S ACRSSA=$P(Y(0),U)
S ACRMM=+$G(ACRAPPDA)_U_+$G(ACRALWDA)_U_+Y
W @IOF
W !?10,"APPROPRIATION...: ",ACRAPP
W !?10,"ALLOWANCE.......: ",ACRALW
W !?10,"SUB-SUB-ACTIVITY: ",ACRSSA
S DIR(0)="YO"
S DIR("A",1)="Are you CERTAIN you want to CONVERT EXISTING"
S DIR("A")="accounts to the new Finance information listed above"
S DIR("B")="NO"
W !
D DIR^ACRFDIC
I +Y'=1 S ACRQUIT="" Q
D PROC
I ACRPROC=2 S ACRQUIT=""
Q
HEAD ;
W @IOF
W !?10,"Are you CREATING or CONVERTING Medicaid or Medicare accounts which"
W !?10,"require the new finance information? If so, please indicate 'YES'"
W !?10,"below then provide the correct information for the conversion."
W !
Q
UP ;EP;TO UPDATE FINANCE INFO
S DIE=ACRDIK
S DA=ACRNEWDA
S DR="40////"_+ACRMM_";50////"_$P(ACRMM,U,2)_";80////"_$P(ACRMM,U,3)
D DIE^ACRFDIC
Q
PROC ;UP DATE EXISTING ACCOUNTS
S DA=ACRACTDA
S DIE="^ACRAPP("
D UP
S ACRALWDA=0
F S ACRALWDA=$O(^ACRALW("M",ACRACTDA,ACRALWDA)) Q:'ACRALWDA D
.S ACRDIK="^ACRALW("
.S ACRNEWDA=ACRALWDA
.D UP
.S ACRALCDA=0
.F S ACRALCDA=$O(^ACRALC("M",ACRALWDA,ACRALCDA)) Q:'ACRALCDA D
..S ACRDIK="^ACRALC("
..S ACRNEWDA=ACRALCDA
..D UP
..S ACRLBDA=0
..F S ACRLBDA=$O(^ACRLOCB("M",ACRALCDA,ACRLBDA)) Q:'ACRLBDA D
...S ACRDIK="^ACRLOCB("
...S ACRNEWDA=ACRLBDA
...D UP
Q
ACRFNY3 ;IHS/OIRM/DSD/THL,AEF - CONVERT TO NEW FINANCE INFO FOR M&M; [ 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
EN DO EN1
EXIT KILL ACRPROC,ACRMMAPP,ACRMMALW
+1 QUIT
EN1 KILL ACRMM
+1 DO HEAD
+2 SET DIR(0)="YO"
+3 SET DIR("A")="Convert to the new ACCOUNTING data"
+4 SET DIR("B")="NO"
+5 WRITE !
+6 DO DIR^ACRFDIC
+7 IF +Y'=1
QUIT
+8 SET DIC="^AUTTPRO("
+9 SET DIC(0)="AEMQZ"
+10 SET DIC("A")="Which appropriation...: "
+11 WRITE !
+12 DO DIC^ACRFDIC
+13 IF +Y<1
SET ACRQUIT=""
QUIT
+14 SET ACRAPPDA=+Y
+15 SET ACRAPP=$PIECE(^AUTTPRO(+Y,0),U)
+16 SET ACRMMAPP=X_U_ACRAPP
+17 SET DIC="^AUTTALLW("
+18 SET DIC(0)="AEMQZ"
+19 SET DIC("A")="Which ALLOWANCE.......: "
+20 WRITE !
+21 DO DIC^ACRFDIC
+22 IF +Y<1
KILL ACRMM
SET ACRQUIT=""
QUIT
+23 SET ACRALWDA=+Y
+24 SET ACRALW=$PIECE(Y(0),U)
+25 SET DIC="^AUTTSSA("
+26 SET DIC(0)="AEMQZ"
+27 SET DIC("A")="Which SUB-SUB-ACTIVITY: "
+28 WRITE !
+29 DO DIC^ACRFDIC
+30 IF +Y<1
KILL ACRMM
SET ACRQUIT=""
QUIT
+31 SET ACRSSADA=+Y
+32 SET ACRSSA=$PIECE(Y(0),U)
+33 SET ACRMM=+$GET(ACRAPPDA)_U_+$GET(ACRALWDA)_U_+Y
+34 WRITE @IOF
+35 WRITE !?10,"APPROPRIATION...: ",ACRAPP
+36 WRITE !?10,"ALLOWANCE.......: ",ACRALW
+37 WRITE !?10,"SUB-SUB-ACTIVITY: ",ACRSSA
+38 SET DIR(0)="YO"
+39 SET DIR("A",1)="Are you CERTAIN you want to CONVERT EXISTING"
+40 SET DIR("A")="accounts to the new Finance information listed above"
+41 SET DIR("B")="NO"
+42 WRITE !
+43 DO DIR^ACRFDIC
+44 IF +Y'=1
SET ACRQUIT=""
QUIT
+45 DO PROC
+46 IF ACRPROC=2
SET ACRQUIT=""
+47 QUIT
HEAD ;
+1 WRITE @IOF
+2 WRITE !?10,"Are you CREATING or CONVERTING Medicaid or Medicare accounts which"
+3 WRITE !?10,"require the new finance information? If so, please indicate 'YES'"
+4 WRITE !?10,"below then provide the correct information for the conversion."
+5 WRITE !
+6 QUIT
UP ;EP;TO UPDATE FINANCE INFO
+1 SET DIE=ACRDIK
+2 SET DA=ACRNEWDA
+3 SET DR="40////"_+ACRMM_";50////"_$PIECE(ACRMM,U,2)_";80////"_$PIECE(ACRMM,U,3)
+4 DO DIE^ACRFDIC
+5 QUIT
PROC ;UP DATE EXISTING ACCOUNTS
+1 SET DA=ACRACTDA
+2 SET DIE="^ACRAPP("
+3 DO UP
+4 SET ACRALWDA=0
+5 FOR
SET ACRALWDA=$ORDER(^ACRALW("M",ACRACTDA,ACRALWDA))
IF 'ACRALWDA
QUIT
Begin DoDot:1
+6 SET ACRDIK="^ACRALW("
+7 SET ACRNEWDA=ACRALWDA
+8 DO UP
+9 SET ACRALCDA=0
+10 FOR
SET ACRALCDA=$ORDER(^ACRALC("M",ACRALWDA,ACRALCDA))
IF 'ACRALCDA
QUIT
Begin DoDot:2
+11 SET ACRDIK="^ACRALC("
+12 SET ACRNEWDA=ACRALCDA
+13 DO UP
+14 SET ACRLBDA=0
+15 FOR
SET ACRLBDA=$ORDER(^ACRLOCB("M",ACRALCDA,ACRLBDA))
IF 'ACRLBDA
QUIT
Begin DoDot:3
+16 SET ACRDIK="^ACRLOCB("
+17 SET ACRNEWDA=ACRLBDA
+18 DO UP
End DoDot:3
End DoDot:2
End DoDot:1
+19 QUIT
