- 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
