- 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
