AFSHTBUP.m

AFSHTBUP ;OKC/RDC/DRS - FINANCE TABLE UPDATE PROGRAM; [ 10/27/2004   4:20 PM ]

 ;;3.0T1;A0 FINANCIAL DATA MGMT SYSTEM;**1,13**;FEB 02, 1999

 ;;MODIFIED FOR CACHE' COMPLIANCE ;ACR*2.1*9

 ;D CRTSETUP^AFSTCK1                  ;ACR*2.1*13.02 IM13574

 D CRTSETUP^AFSHCK1                   ;ACR*2.1*13.02 IM13574

A0 ;

 D HDRM

 ;

 ;IHS/AANHS/MAW MODIFIED TO ALLOW BUDGET ACTIVITY EDIT

 ;IHS/AANHS/REM ADDED COST CENTER EDIT

PCC1 K DIR S DIR("A")="Enter Table you want to update ('X' to Exit)"

 ;S DIR(0)="S^A:Allowance/Allotment;C:Common Accounting Number (CAN);D:Document Reference Code;L:Location Code;O:Object Class Code;B:Budget Activity;S:Sub Activity;SS:Sub Sub Activity;CC:Cost Center Code;X:EXIT"  ;ACR*2.1*13.02 IM13574

 S DIR(0)="S^A:Allowance/Allotment"                ;ACR*2.1*13.02 IM13574

 S DIR(0)=DIR(0)_";C:Common Accounting Number (CAN)" ;ACR*2.1*13.02 IM13574

 S DIR(0)=DIR(0)_";D:Document Reference Code"      ;ACR*2.1*13.02 IM13574

 S DIR(0)=DIR(0)_";L:Location Code"                ;ACR*2.1*13.02 IM13574

 S DIR(0)=DIR(0)_";O:Object Class Code"            ;ACR*2.1*13.02 IM13574

 S DIR(0)=DIR(0)_";B:Budget Activity"              ;ACR*2.1*13.02 IM13574

 S DIR(0)=DIR(0)_";S:Sub Activity"                 ;ACR*2.1*13.02 IM13574

 S DIR(0)=DIR(0)_";SS:Sub Sub Activity"            ;ACR*2.1*13.02 IM13574

 S DIR(0)=DIR(0)_";CC:Cost Center Code"            ;ACR*2.1*13.02 IM13574

 S DIR(0)=DIR(0)_";X:EXIT"                         ;ACR*2.1*13.02 IM13574

 D ^DIR

 ;

 I $D(DTOUT)!($D(DUOUT)) G ABEND

 S AFSOPT=Y

 I AFSOPT="X" G FINI

 U IO(0) W !!

 G ALLOW:AFSOPT="A",CAN:AFSOPT="C",DREF:AFSOPT="D",LOCAT:AFSOPT="L",OBJCL:AFSOPT="O",BUDGET:AFSOPT="B",SUB:AFSOPT="S",SUBSUB:AFSOPT="SS",COST:AFSOPT="CC"

 G ABEND2

 ;

 ;IHS/AANHS/REM MODIFIED FOR COST CENTER CODE 

COST ;;ENTRY POINT

 K DIC,DIE,DIR,DR,DO S DIC="^AUTTCCT(",DIC(0)="QAZEML" D ^DIC

 G A0:$D(DUOUT)!($D(DTOUT))!($D(DLOUT))

 G ABEND:+Y<1 S DA=+Y,DR=".01;1;10",DIE=DIC D ^DIE

 G COST                                        ;ACR*2.1*13.02 IM13574

 ;

 ;IHS/AANHS/MAW MODIFIED FOR BUDGET ACTIVITY

SUB ;;ENTRY POINT

 K DIC,DIE,DIR,DR,DO S DIC="^AUTTSA(",DIC(0)="QAZEML" D ^DIC

 G A0:$D(DUOUT)!($D(DTOUT))!($D(DLOUT))

 G ABEND:+Y<1 S DA=+Y,DR=".01;.02;.03",DIE=DIC D ^DIE

 G ALLOW

 ;

SUBSUB ;;ENTRY POINT

 K DIC,DIE,DIR,DR,DO S DIC="^AUTTSSA(",DIC(0)="QAZEML" D ^DIC

 G A0:$D(DUOUT)!($D(DTOUT))!($D(DLOUT))

 G ABEND:+Y<1 S DA=+Y,DR=".01;.02;.03;.04;.05;10;20;30",DIE=DIC D ^DIE

 G ALLOW

 ;

BUDGET ;;ENTRY POINT

 K DIC,DIE,DIR,DR,DO S DIC="^AUTTBA(",DIC(0)="QAZEML" D ^DIC

 G A0:$D(DUOUT)!($D(DTOUT))!($D(DLOUT))

 G ABEND:+Y<1 S DA=+Y,DR=".01;.02",DIE=DIC D ^DIE

 G ALLOW

 ;

ALLOW ;;ENTRY POINT

 K DIC,DIE,DIR,DR,DO S DIC="^AUTTALLW(",DIC(0)="QAZEML" D ^DIC

 G A0:$D(DUOUT)!($D(DTOUT))!($D(DLOUT))

 G ABEND:+Y<1 S DA=+Y,DR=".01;.03;.02",DIE=DIC D ^DIE

 G ALLOW

CAN ;;ENTRY POINT

 K DIC,DIE,DIR,DR,DO S DIC="^AUTTCAN(",DIC(0)="QAZEML" D ^DIC

 G A0:$D(DUOUT)!($D(DTOUT))!($D(DLOUT))

 G ABEND:+Y<1 S DA=+Y,DR=".01;.11;.04;.03;1;2;.05;.06;4;.17;.15;3",DIE=DIC D ^DIE

 G CAN

DREF ;;ENTRY POINT

 K DIC,DIE,DIR,DR,DO S DIC="^AUTTDOCR(",DIC(0)="QAZEML" D ^DIC

 G A0:$D(DUOUT)!($D(DTOUT))!($D(DLOUT))

 G ABEND:+Y<1 S DA=+Y,DR=".01;1;2;3;10",DIE=DIC D ^DIE

 G DREF

LOCAT ;;ENTRY POINT

 K DIC,DIE,DIR,DR,DO S DIC="^AUTTLCOD(",DIC(0)="QAZEML" D ^DIC

 G A0:$D(DUOUT)!($D(DTOUT))!($D(DLOUT))

 G ABEND:+Y<1 S DA=+Y,DR=".01;.02;.03;.04;1;2",DIE=DIC D ^DIE

 G LOCAT

OBJCL ;;ENTRY POINT

 K DIC,DIE,DIR,DR,DO S DIC="^AUTTOBJC(",DIC(0)="QAZEML" D ^DIC

 G A0:$D(DUOUT)!($D(DTOUT))!($D(DLOUT))

 G ABEND:+Y<1 S DA=+Y,DR=".01;3;.03;.03;.04;1",DIE=DIC D ^DIE

 G OBJCL

ABEND K DO,DA,DIC,DIE,DR,X,Y,Z G A0

ABEND2 K AFSOPT G A0

HDRM ;MAIN HEADER

 D ^XBCLS

 U IO(0) W !,?15

 F AFSI=1:1:50 W "*"

 W !,?15,@AFSRVON,"*    AREA OFFICE FINANCE TABLE UPDATE PROGRAMS   *",@AFSRVOF,!,?15

 F AFSI=1:1:50 W "*"

 W !

 Q

FINI ;

 K DO,DA,DIC,DIE,DR,X,Y,Z,AFSOPT

 Q

AFSHTBUP  ;OKC/RDC/DRS - FINANCE TABLE UPDATE PROGRAM; [ 10/27/2004   4:20 PM ]

 +1       ;;3.0T1;A0 FINANCIAL DATA MGMT SYSTEM;**1,13**;FEB 02, 1999

 +2       ;;MODIFIED FOR CACHE' COMPLIANCE ;ACR*2.1*9

 +3       ;D CRTSETUP^AFSTCK1                  ;ACR*2.1*13.02 IM13574

 +4       ;ACR*2.1*13.02 IM13574

           DO CRTSETUP^AFSHCK1

A0        ;

 +1        DO HDRM

 +2       ;

 +3       ;IHS/AANHS/MAW MODIFIED TO ALLOW BUDGET ACTIVITY EDIT

 +4       ;IHS/AANHS/REM ADDED COST CENTER EDIT

PCC1       KILL DIR

           SET DIR("A")="Enter Table you want to update ('X' to Exit)"

 +1       ;S DIR(0)="S^A:Allowance/Allotment;C:Common Accounting Number (CAN);D:Document Reference Code;L:Location Code;O:Object Class Code;B:Budget Activity;S:Sub Activity;SS:Sub Sub Activity;CC:Cost Center Code;X:EXIT"  ;ACR*2.1*13.02 IM13574

 +2       ;ACR*2.1*13.02 IM13574

           SET DIR(0)="S^A:Allowance/Allotment"

 +3       ;ACR*2.1*13.02 IM13574

           SET DIR(0)=DIR(0)_";C:Common Accounting Number (CAN)"

 +4       ;ACR*2.1*13.02 IM13574

           SET DIR(0)=DIR(0)_";D:Document Reference Code"

 +5       ;ACR*2.1*13.02 IM13574

           SET DIR(0)=DIR(0)_";L:Location Code"

 +6       ;ACR*2.1*13.02 IM13574

           SET DIR(0)=DIR(0)_";O:Object Class Code"

 +7       ;ACR*2.1*13.02 IM13574

           SET DIR(0)=DIR(0)_";B:Budget Activity"

 +8       ;ACR*2.1*13.02 IM13574

           SET DIR(0)=DIR(0)_";S:Sub Activity"

 +9       ;ACR*2.1*13.02 IM13574

           SET DIR(0)=DIR(0)_";SS:Sub Sub Activity"

 +10      ;ACR*2.1*13.02 IM13574

           SET DIR(0)=DIR(0)_";CC:Cost Center Code"

 +11      ;ACR*2.1*13.02 IM13574

           SET DIR(0)=DIR(0)_";X:EXIT"

 +12       DO ^DIR

 +13      ;

 +14       IF $DATA(DTOUT)!($DATA(DUOUT))

               GOTO ABEND

 +15       SET AFSOPT=Y

 +16       IF AFSOPT="X"

               GOTO FINI

 +17       USE IO(0)

           WRITE !!

 +18       IF AFSOPT="A"

               GOTO ALLOW

           IF AFSOPT="C"

               GOTO CAN

           IF AFSOPT="D"

               GOTO DREF

           IF AFSOPT="L"

               GOTO LOCAT

           IF AFSOPT="O"

               GOTO OBJCL

           IF AFSOPT="B"

               GOTO BUDGET

           IF AFSOPT="S"

               GOTO SUB

           IF AFSOPT="SS"

               GOTO SUBSUB

           IF AFSOPT="CC"

               GOTO COST

 +19       GOTO ABEND2

 +20      ;

 +21      ;IHS/AANHS/REM MODIFIED FOR COST CENTER CODE 

COST      ;;ENTRY POINT

 +1        KILL DIC,DIE,DIR,DR,DO

           SET DIC="^AUTTCCT("

           SET DIC(0)="QAZEML"

           DO ^DIC

 +2        IF $DATA(DUOUT)!($DATA(DTOUT))!($DATA(DLOUT))

               GOTO A0

 +3        IF +Y<1

               GOTO ABEND

           SET DA=+Y

           SET DR=".01;1;10"

           SET DIE=DIC

           DO ^DIE

 +4       ;ACR*2.1*13.02 IM13574

           GOTO COST

 +5       ;

 +6       ;IHS/AANHS/MAW MODIFIED FOR BUDGET ACTIVITY

SUB       ;;ENTRY POINT

 +1        KILL DIC,DIE,DIR,DR,DO

           SET DIC="^AUTTSA("

           SET DIC(0)="QAZEML"

           DO ^DIC

 +2        IF $DATA(DUOUT)!($DATA(DTOUT))!($DATA(DLOUT))

               GOTO A0

 +3        IF +Y<1

               GOTO ABEND

           SET DA=+Y

           SET DR=".01;.02;.03"

           SET DIE=DIC

           DO ^DIE

 +4        GOTO ALLOW

 +5       ;

SUBSUB    ;;ENTRY POINT

 +1        KILL DIC,DIE,DIR,DR,DO

           SET DIC="^AUTTSSA("

           SET DIC(0)="QAZEML"

           DO ^DIC

 +2        IF $DATA(DUOUT)!($DATA(DTOUT))!($DATA(DLOUT))

               GOTO A0

 +3        IF +Y<1

               GOTO ABEND

           SET DA=+Y

           SET DR=".01;.02;.03;.04;.05;10;20;30"

           SET DIE=DIC

           DO ^DIE

 +4        GOTO ALLOW

 +5       ;

BUDGET    ;;ENTRY POINT

 +1        KILL DIC,DIE,DIR,DR,DO

           SET DIC="^AUTTBA("

           SET DIC(0)="QAZEML"

           DO ^DIC

 +2        IF $DATA(DUOUT)!($DATA(DTOUT))!($DATA(DLOUT))

               GOTO A0

 +3        IF +Y<1

               GOTO ABEND

           SET DA=+Y

           SET DR=".01;.02"

           SET DIE=DIC

           DO ^DIE

 +4        GOTO ALLOW

 +5       ;

ALLOW     ;;ENTRY POINT

 +1        KILL DIC,DIE,DIR,DR,DO

           SET DIC="^AUTTALLW("

           SET DIC(0)="QAZEML"

           DO ^DIC

 +2        IF $DATA(DUOUT)!($DATA(DTOUT))!($DATA(DLOUT))

               GOTO A0

 +3        IF +Y<1

               GOTO ABEND

           SET DA=+Y

           SET DR=".01;.03;.02"

           SET DIE=DIC

           DO ^DIE

 +4        GOTO ALLOW

CAN       ;;ENTRY POINT

 +1        KILL DIC,DIE,DIR,DR,DO

           SET DIC="^AUTTCAN("

           SET DIC(0)="QAZEML"

           DO ^DIC

 +2        IF $DATA(DUOUT)!($DATA(DTOUT))!($DATA(DLOUT))

               GOTO A0

 +3        IF +Y<1

               GOTO ABEND

           SET DA=+Y

           SET DR=".01;.11;.04;.03;1;2;.05;.06;4;.17;.15;3"

           SET DIE=DIC

           DO ^DIE

 +4        GOTO CAN

DREF      ;;ENTRY POINT

 +1        KILL DIC,DIE,DIR,DR,DO

           SET DIC="^AUTTDOCR("

           SET DIC(0)="QAZEML"

           DO ^DIC

 +2        IF $DATA(DUOUT)!($DATA(DTOUT))!($DATA(DLOUT))

               GOTO A0

 +3        IF +Y<1

               GOTO ABEND

           SET DA=+Y

           SET DR=".01;1;2;3;10"

           SET DIE=DIC

           DO ^DIE

 +4        GOTO DREF

LOCAT     ;;ENTRY POINT

 +1        KILL DIC,DIE,DIR,DR,DO

           SET DIC="^AUTTLCOD("

           SET DIC(0)="QAZEML"

           DO ^DIC

 +2        IF $DATA(DUOUT)!($DATA(DTOUT))!($DATA(DLOUT))

               GOTO A0

 +3        IF +Y<1

               GOTO ABEND

           SET DA=+Y

           SET DR=".01;.02;.03;.04;1;2"

           SET DIE=DIC

           DO ^DIE

 +4        GOTO LOCAT

OBJCL     ;;ENTRY POINT

 +1        KILL DIC,DIE,DIR,DR,DO

           SET DIC="^AUTTOBJC("

           SET DIC(0)="QAZEML"

           DO ^DIC

 +2        IF $DATA(DUOUT)!($DATA(DTOUT))!($DATA(DLOUT))

               GOTO A0

 +3        IF +Y<1

               GOTO ABEND

           SET DA=+Y

           SET DR=".01;3;.03;.03;.04;1"

           SET DIE=DIC

           DO ^DIE

 +4        GOTO OBJCL

ABEND      KILL DO,DA,DIC,DIE,DR,X,Y,Z

           GOTO A0

ABEND2     KILL AFSOPT

           GOTO A0

HDRM      ;MAIN HEADER

 +1        DO ^XBCLS

 +2        USE IO(0)

           WRITE !,?15

 +3        FOR AFSI=1:1:50

               WRITE "*"

 +4        WRITE !,?15,@AFSRVON,"*    AREA OFFICE FINANCE TABLE UPDATE PROGRAMS   *",@AFSRVOF,!,?15

 +5        FOR AFSI=1:1:50

               WRITE "*"

 +6        WRITE !

 +7        QUIT 

FINI      ;

 +1        KILL DO,DA,DIC,DIE,DR,X,Y,Z,AFSOPT

 +2        QUIT