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
