ACRFNY2 ;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,ACRMMSSA
Q
EN1 K ACRMM
D HEAD
S DIR(0)="YO"
S DIR("A")="Convert to the new M&M Finance information"
S DIR("B")="NO"
W !
D DIR^ACRFDIC
Q:+Y'=1
S DIR(0)="SO^1:Create NEW FY accounts;2:Convert Finance Data on existing accounts"
S DIR("A")="Which action"
W !
D DIR^ACRFDIC
I Y'=1&(Y'=2) S ACRQUIT="" Q
S ACRPROC=+Y
S X=$O(^AUTTPRO("B","75X0390",0))
I 'X D Q
.W !!,"The APPROPRIATION number '75X0390' is not on your system.",!,"Contact your ARMS manager to have this added."
.D PAUSE^ACRFWARN
.S ACRQUIT=""
S ACRMMAPP=X_U_^AUTTPRO(X,0)
S ACRAPP="75X0390"
S DIC="^AUTTALLW("
S DIC(0)="AEMQZ"
S DIC("A")="Which ALLOWANCE: "
S DIC("S")="I $E($P(^(0),U),1,3)=421!($E($P(^(0),U),1,3)=422)"
W !
D DIC^ACRFDIC
I +Y<1 K ACRMM S ACRQUIT="" Q
S ACRMMALW=+Y_U_Y(0)
I '$D(^AUTTSSA("D","01.01.21"))!'$D(^AUTTSSA("D","01.01.41"))!'$D(^AUTTSSA("D","02.01.22"))!'$D(^AUTTSSA("D","02.01.42")) D Q
.W !!,"Required SUB-SUB-ACTIVITY entries are not on file."
.W !,"Contract your ARMS manager."
.D PAUSE^ACRFWARN
.S ACRQUIT=""
I $E($P(ACRMMALW,U,2),1,3)=421 S X="01.01.21",Z="01.01.41"
I $E($P(ACRMMALW,U,2),1,3)=422 S X="02.01.22",Z="02.01.42"
S Y=$O(^AUTTSSA("D",X,0))
I +Y<1 K ACRMM S ACRQUIT="" Q
S ACRMMSSA=+Y_U_X
S Y=$O(^AUTTSSA("D",Z,0))
I +Y<1 K ACRMM S ACRQUIT="" Q
S ACRMMSSA=ACRMMSSA_U_+Y_U_Z
S X=^AUTTSSA(+Y,"DT")
S ACRMM=+$G(ACRMMAPP)_U_+$G(ACRMMALW)_U_$P(X,U)_U_U_$G(ACRMMSSA)
W @IOF
W !?10,"APPROPRIATION...: ",$P(ACRMMAPP,U,2)
W !?10,"ALLOWANCE.......: ",$P(ACRMMALW,U,2)
W !?10,"SUB-SUB-ACTIVITY: ",$P(ACRMMSSA,U,2)," or ",$P(ACRMMSSA,U,4)
S DIR(0)="YO"
S DIR("A",1)="Are you CERTAIN you want to "_$S(ACRPROC=1:"CREATE NEW",1:"CONVERT EXISTING")
S DIR("A")="accounts "_$S(ACRPROC=1:"with",1:"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
I $G(ACROLD),ACROLD'=ACRNEWDA S X=$P(@$E(ACRDIK,1,$L(ACRDIK)-1)@(ACROLD,"DT"),U,8) S:X X=$P($G(^AUTTSSA(X,"DT")),U,4) I $E(X,7,8)=92!($E(X,7,8)=93) S X="TRIB"
S DIE=ACRDIK
S DA=ACRNEWDA
S DR="40////"_+ACRMM_";50////"_$P(ACRMM,U,2)_";60////"_+^AUTTSSA($P(ACRMM,U,$S(X'="TRIB":1,1:7)),"DT")_";80////"_$P(ACRMM,U,$S($G(X)'="TRIB":5,1:7))
D DIE^ACRFDIC
Q
PROC ;UP DATE EXISTING ACCOUNTS
I ACRPROC=1 S $P(^ACRAPP(ACRACTDA,0),U,16)=1
S ACRALWDA=0
F S ACRALWDA=$O(^ACRALW("M",ACRACTDA,ACRALWDA)) Q:'ACRALWDA D
.S ACRDIK="^ACRALW("
.S ACRNEWDA=ACRALWDA
.I ACRPROC=1 S $P(^ACRALW(ACRALWDA,0),U,16)=1
.E D UP
.S ACRALCDA=0
.F S ACRALCDA=$O(^ACRALC("M",ACRALWDA,ACRALCDA)) Q:'ACRALCDA D
..S ACRDIK="^ACRALC("
..S ACRNEWDA=ACRALCDA
..I ACRPROC=1 S $P(^ACRALC(ACRALCDA,0),U,16)=1
..E D UP
..S ACRLBDA=0
..F S ACRLBDA=$O(^ACRLOCB("M",ACRALCDA,ACRLBDA)) Q:'ACRLBDA D
...S ACRDIK="^ACRLOCB("
...S ACRNEWDA=ACRLBDA
...I ACRPROC=1 S $P(^ACRLOCB(ACRLBDA,0),U,16)=1
...E D UP
Q
ACRFNY2 ;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,ACRMMSSA
+1 QUIT
EN1 KILL ACRMM
+1 DO HEAD
+2 SET DIR(0)="YO"
+3 SET DIR("A")="Convert to the new M&M Finance information"
+4 SET DIR("B")="NO"
+5 WRITE !
+6 DO DIR^ACRFDIC
+7 IF +Y'=1
QUIT
+8 SET DIR(0)="SO^1:Create NEW FY accounts;2:Convert Finance Data on existing accounts"
+9 SET DIR("A")="Which action"
+10 WRITE !
+11 DO DIR^ACRFDIC
+12 IF Y'=1&(Y'=2)
SET ACRQUIT=""
QUIT
+13 SET ACRPROC=+Y
+14 SET X=$ORDER(^AUTTPRO("B","75X0390",0))
+15 IF 'X
Begin DoDot:1
+16 WRITE !!,"The APPROPRIATION number '75X0390' is not on your system.",!,"Contact your ARMS manager to have this added."
+17 DO PAUSE^ACRFWARN
+18 SET ACRQUIT=""
End DoDot:1
QUIT
+19 SET ACRMMAPP=X_U_^AUTTPRO(X,0)
+20 SET ACRAPP="75X0390"
+21 SET DIC="^AUTTALLW("
+22 SET DIC(0)="AEMQZ"
+23 SET DIC("A")="Which ALLOWANCE: "
+24 SET DIC("S")="I $E($P(^(0),U),1,3)=421!($E($P(^(0),U),1,3)=422)"
+25 WRITE !
+26 DO DIC^ACRFDIC
+27 IF +Y<1
KILL ACRMM
SET ACRQUIT=""
QUIT
+28 SET ACRMMALW=+Y_U_Y(0)
+29 IF '$DATA(^AUTTSSA("D","01.01.21"))!'$DATA(^AUTTSSA("D","01.01.41"))!'$DATA(^AUTTSSA("D","02.01.22"))!'$DATA(^AUTTSSA("D","02.01.42"))
Begin DoDot:1
+30 WRITE !!,"Required SUB-SUB-ACTIVITY entries are not on file."
+31 WRITE !,"Contract your ARMS manager."
+32 DO PAUSE^ACRFWARN
+33 SET ACRQUIT=""
End DoDot:1
QUIT
+34 IF $EXTRACT($PIECE(ACRMMALW,U,2),1,3)=421
SET X="01.01.21"
SET Z="01.01.41"
+35 IF $EXTRACT($PIECE(ACRMMALW,U,2),1,3)=422
SET X="02.01.22"
SET Z="02.01.42"
+36 SET Y=$ORDER(^AUTTSSA("D",X,0))
+37 IF +Y<1
KILL ACRMM
SET ACRQUIT=""
QUIT
+38 SET ACRMMSSA=+Y_U_X
+39 SET Y=$ORDER(^AUTTSSA("D",Z,0))
+40 IF +Y<1
KILL ACRMM
SET ACRQUIT=""
QUIT
+41 SET ACRMMSSA=ACRMMSSA_U_+Y_U_Z
+42 SET X=^AUTTSSA(+Y,"DT")
+43 SET ACRMM=+$GET(ACRMMAPP)_U_+$GET(ACRMMALW)_U_$PIECE(X,U)_U_U_$GET(ACRMMSSA)
+44 WRITE @IOF
+45 WRITE !?10,"APPROPRIATION...: ",$PIECE(ACRMMAPP,U,2)
+46 WRITE !?10,"ALLOWANCE.......: ",$PIECE(ACRMMALW,U,2)
+47 WRITE !?10,"SUB-SUB-ACTIVITY: ",$PIECE(ACRMMSSA,U,2)," or ",$PIECE(ACRMMSSA,U,4)
+48 SET DIR(0)="YO"
+49 SET DIR("A",1)="Are you CERTAIN you want to "_$SELECT(ACRPROC=1:"CREATE NEW",1:"CONVERT EXISTING")
+50 SET DIR("A")="accounts "_$SELECT(ACRPROC=1:"with",1:"to")_" the new Finance information listed above"
+51 SET DIR("B")="NO"
+52 WRITE !
+53 DO DIR^ACRFDIC
+54 IF +Y'=1
SET ACRQUIT=""
QUIT
+55 DO PROC
+56 IF ACRPROC=2
SET ACRQUIT=""
+57 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 IF $GET(ACROLD)
IF ACROLD'=ACRNEWDA
SET X=$PIECE(@$EXTRACT(ACRDIK,1,$LENGTH(ACRDIK)-1)@(ACROLD,"DT"),U,8)
IF X
SET X=$PIECE($GET(^AUTTSSA(X,"DT")),U,4)
IF $EXTRACT(X,7,8)=92!($EXTRACT(X,7,8)=93)
SET X="TRIB"
+2 SET DIE=ACRDIK
+3 SET DA=ACRNEWDA
+4 SET DR="40////"_+ACRMM_";50////"_$PIECE(ACRMM,U,2)_";60////"_+^AUTTSSA($PIECE(ACRMM,U,$SELECT(X'="TRIB":1,1:7)),"DT")_";80////"_$PIECE(ACRMM,U,$SELECT($GET(X)'="TRIB":5,1:7))
+5 DO DIE^ACRFDIC
+6 QUIT
PROC ;UP DATE EXISTING ACCOUNTS
+1 IF ACRPROC=1
SET $PIECE(^ACRAPP(ACRACTDA,0),U,16)=1
+2 SET ACRALWDA=0
+3 FOR
SET ACRALWDA=$ORDER(^ACRALW("M",ACRACTDA,ACRALWDA))
IF 'ACRALWDA
QUIT
Begin DoDot:1
+4 SET ACRDIK="^ACRALW("
+5 SET ACRNEWDA=ACRALWDA
+6 IF ACRPROC=1
SET $PIECE(^ACRALW(ACRALWDA,0),U,16)=1
+7 IF '$TEST
DO UP
+8 SET ACRALCDA=0
+9 FOR
SET ACRALCDA=$ORDER(^ACRALC("M",ACRALWDA,ACRALCDA))
IF 'ACRALCDA
QUIT
Begin DoDot:2
+10 SET ACRDIK="^ACRALC("
+11 SET ACRNEWDA=ACRALCDA
+12 IF ACRPROC=1
SET $PIECE(^ACRALC(ACRALCDA,0),U,16)=1
+13 IF '$TEST
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 IF ACRPROC=1
SET $PIECE(^ACRLOCB(ACRLBDA,0),U,16)=1
+19 IF '$TEST
DO UP
End DoDot:3
End DoDot:2
End DoDot:1
+20 QUIT
