ASUL07ET ; IHS/ITSC/LMH -TABLE 7 EDIT ROUTINE ;
;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
;This routine is a utility that provides an entry point to accept
;data entry to properly create an entry in the Category code Table.
S ASUV("QUO")=""""
G ENTER
ASKAGAIN ;
W !
S DIR("A")="WANT TO EDIT ANOTHER CATEGORY TABLE ENTRY",DIR("B")="Y",DIR(0)="Y" D ^DIR K DIR
I 'Y G DONE
ENTER ;
D CLS^ASUUHDG K Y
S DIR("A")="ENTER CATEGORY NAME OR OBJECT SUB OBJECT CODE "
S DIR("?")="^D CATNHELP^ASUL07ET"
S DIR(0)="FO^3:60" D ^DIR K DIR
G:$D(DUOUT)!($D(DIROUT))!($D(DTOUT)) DONE
I X="" G ASKAGAIN
S DIC="^ASUL(7,"
S DIC(0)="EZM",D="C" D IX^DIC
G:$D(DUOUT)!($D(DIROUT))!($D(DTOUT)) DONE
I Y<0 S ASUR("ENTRY")=X W !,ASUR("ENTRY")," NOT CURRENTLY IN TABLE" G CKADD
S ASUR("ENTRY")=X
S ASUL(7,"CAT","E#")=+Y,ASUL(7,"CAT","NM")=Y(0),ASUL(6,"CAT","CD")=^ASUL(7,ASUL(7,"CAT","E#",1))
I $E(ASUR("ENTRY"))=2 G DXRF
S ASUL(7,"CAT","NM")=ASUR("ENTRY")
S ASUL(7,"SOBJ","E#")=$O(^ASUL(7,"C",ASUL(7,"CAT","NM"),ASUL(7,"CAT","E#"),""))
I ASUL(7,"SOBJ","E#")']"" W !,"ERROR IN NAME LOOKUP",! G ASKAGAIN
G UPDATE
CATNHELP ;EP ;CATEGORY NAME HELP
S DIC="^ASUL(7,",DIC(0)="EM",D="C",DZ="??" D DQ^DICQ K DZ
W !!,"OR YOU MAY ENTER A NEW CATEGORY NAME OR SUB OBJECT (29..) TO ADD TO THE TABLE"
Q
DXRF ;
S ASUL("SOBJ")=ASUR("ENTRY")
S ASUL(7,"SOBJ","E#")=$O(^ASUL(7,"D",ASUL("SOBJ"),ASUL(7,"CAT","E#"),""))
I ASUL(7,"SOBJ","E#")']"" W !,"ERROR IN SUB OBJECT LOOKUP",! G ASKAGAIN
UPDATE ;
S DR=".01;1;2"
S DIE="^ASUL(7,ASUL(7,""E#"",""CAT""),1,"
S DA=ASUL(7,"SOBJ","E#"),DA(1)=ASUL(7,"CAT","E#")
D ^DIE
G ASKAGAIN
CKADD ;
S DIR("A")="DO YOU WISH TO ADD "_ASUR("ENTRY")_" AS A NEW TABLE ENTRY",DIR("B")="N",DIR(0)="Y" D ^DIR K DIR
G:$D(DUOUT)!($D(DIROUT))!($D(DTOUT)) DONE
I 'Y W ! G ASKAGAIN
I $E(ASUR("ENTRY"),1,2)=29 S ASUL("SOBJ")=ASUR("ENTRY"),ASUL(7,"CAT","NM")="" G ADDIT
S ASUL(7,"CAT","NM")=ASUR("ENTRY"),ASUL("SOBJ")=""
ADDIT ;
K ASUR("ENTRY")
S DIC("A")="ENTER CATEGORY CODE FOR "_ASUL(7,"CAT","NM")_" "
S ASUL(7,"CAT","CD")=X,DIC="^ASUL(7,",DIC(0)="AEZ",D="B" D IX^DIC
G:$D(DUOUT)!($D(DIROUT))!($D(DTOUT)) ASKAGAIN
I Y<0 W !," NOT FOUND" G ASKAGAIN
S ASUL(7,"CAT","E#")=+Y
RACC ;
S DIR(0)="P^9002039.09:EMZ^",DIR("A")="ENTER ACCOUNT CODE" D ^DIR K DIR
G:$D(DUOUT)!($D(DIROUT))!($D(DTOUT)) ASKAGAIN
I Y<0 G ASKAGAIN
S ASUL(9,"ACC")=$P(Y(0),U)
S DR=".01///"_ASUL(7,"CAT","NM")_";1///"_ASUV("QUO")_ASUL(9,"ACC")_ASUV("QUO")
S DR(2,902039.71,1)=".01///"_ASUV("QUO")_ASUL(9,"ACC")_ASUV("QUO")_";1//"_ASUL("SOBJ")_";2//"_ASUL(7,"CAT","CD")
S DIE="^ASUL(7,"
S DA=ASUL(7,"CAT","E#")
D ^DIE
G ASKAGAIN
DONE ;
K ASUL,ASUV,X,Y,DR,DA,DIC,DIE,DUOUT,DTOUT,DIROUT
Q
ASUL07ET ; IHS/ITSC/LMH -TABLE 7 EDIT ROUTINE ;
+1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
+2 ;This routine is a utility that provides an entry point to accept
+3 ;data entry to properly create an entry in the Category code Table.
+4 SET ASUV("QUO")=""""
+5 GOTO ENTER
ASKAGAIN ;
+1 WRITE !
+2 SET DIR("A")="WANT TO EDIT ANOTHER CATEGORY TABLE ENTRY"
SET DIR("B")="Y"
SET DIR(0)="Y"
DO ^DIR
KILL DIR
+3 IF 'Y
GOTO DONE
ENTER ;
+1 DO CLS^ASUUHDG
KILL Y
+2 SET DIR("A")="ENTER CATEGORY NAME OR OBJECT SUB OBJECT CODE "
+3 SET DIR("?")="^D CATNHELP^ASUL07ET"
+4 SET DIR(0)="FO^3:60"
DO ^DIR
KILL DIR
+5 IF $DATA(DUOUT)!($DATA(DIROUT))!($DATA(DTOUT))
GOTO DONE
+6 IF X=""
GOTO ASKAGAIN
+7 SET DIC="^ASUL(7,"
+8 SET DIC(0)="EZM"
SET D="C"
DO IX^DIC
+9 IF $DATA(DUOUT)!($DATA(DIROUT))!($DATA(DTOUT))
GOTO DONE
+10 IF Y<0
SET ASUR("ENTRY")=X
WRITE !,ASUR("ENTRY")," NOT CURRENTLY IN TABLE"
GOTO CKADD
+11 SET ASUR("ENTRY")=X
+12 SET ASUL(7,"CAT","E#")=+Y
SET ASUL(7,"CAT","NM")=Y(0)
SET ASUL(6,"CAT","CD")=^ASUL(7,ASUL(7,"CAT","E#",1))
+13 IF $EXTRACT(ASUR("ENTRY"))=2
GOTO DXRF
+14 SET ASUL(7,"CAT","NM")=ASUR("ENTRY")
+15 SET ASUL(7,"SOBJ","E#")=$ORDER(^ASUL(7,"C",ASUL(7,"CAT","NM"),ASUL(7,"CAT","E#"),""))
+16 IF ASUL(7,"SOBJ","E#")']""
WRITE !,"ERROR IN NAME LOOKUP",!
GOTO ASKAGAIN
+17 GOTO UPDATE
CATNHELP ;EP ;CATEGORY NAME HELP
+1 SET DIC="^ASUL(7,"
SET DIC(0)="EM"
SET D="C"
SET DZ="??"
DO DQ^DICQ
KILL DZ
+2 WRITE !!,"OR YOU MAY ENTER A NEW CATEGORY NAME OR SUB OBJECT (29..) TO ADD TO THE TABLE"
+3 QUIT
DXRF ;
+1 SET ASUL("SOBJ")=ASUR("ENTRY")
+2 SET ASUL(7,"SOBJ","E#")=$ORDER(^ASUL(7,"D",ASUL("SOBJ"),ASUL(7,"CAT","E#"),""))
+3 IF ASUL(7,"SOBJ","E#")']""
WRITE !,"ERROR IN SUB OBJECT LOOKUP",!
GOTO ASKAGAIN
UPDATE ;
+1 SET DR=".01;1;2"
+2 SET DIE="^ASUL(7,ASUL(7,""E#"",""CAT""),1,"
+3 SET DA=ASUL(7,"SOBJ","E#")
SET DA(1)=ASUL(7,"CAT","E#")
+4 DO ^DIE
+5 GOTO ASKAGAIN
CKADD ;
+1 SET DIR("A")="DO YOU WISH TO ADD "_ASUR("ENTRY")_" AS A NEW TABLE ENTRY"
SET DIR("B")="N"
SET DIR(0)="Y"
DO ^DIR
KILL DIR
+2 IF $DATA(DUOUT)!($DATA(DIROUT))!($DATA(DTOUT))
GOTO DONE
+3 IF 'Y
WRITE !
GOTO ASKAGAIN
+4 IF $EXTRACT(ASUR("ENTRY"),1,2)=29
SET ASUL("SOBJ")=ASUR("ENTRY")
SET ASUL(7,"CAT","NM")=""
GOTO ADDIT
+5 SET ASUL(7,"CAT","NM")=ASUR("ENTRY")
SET ASUL("SOBJ")=""
ADDIT ;
+1 KILL ASUR("ENTRY")
+2 SET DIC("A")="ENTER CATEGORY CODE FOR "_ASUL(7,"CAT","NM")_" "
+3 SET ASUL(7,"CAT","CD")=X
SET DIC="^ASUL(7,"
SET DIC(0)="AEZ"
SET D="B"
DO IX^DIC
+4 IF $DATA(DUOUT)!($DATA(DIROUT))!($DATA(DTOUT))
GOTO ASKAGAIN
+5 IF Y<0
WRITE !," NOT FOUND"
GOTO ASKAGAIN
+6 SET ASUL(7,"CAT","E#")=+Y
RACC ;
+1 SET DIR(0)="P^9002039.09:EMZ^"
SET DIR("A")="ENTER ACCOUNT CODE"
DO ^DIR
KILL DIR
+2 IF $DATA(DUOUT)!($DATA(DIROUT))!($DATA(DTOUT))
GOTO ASKAGAIN
+3 IF Y<0
GOTO ASKAGAIN
+4 SET ASUL(9,"ACC")=$PIECE(Y(0),U)
+5 SET DR=".01///"_ASUL(7,"CAT","NM")_";1///"_ASUV("QUO")_ASUL(9,"ACC")_ASUV("QUO")
+6 SET DR(2,902039.71,1)=".01///"_ASUV("QUO")_ASUL(9,"ACC")_ASUV("QUO")_";1//"_ASUL("SOBJ")_";2//"_ASUL(7,"CAT","CD")
+7 SET DIE="^ASUL(7,"
+8 SET DA=ASUL(7,"CAT","E#")
+9 DO ^DIE
+10 GOTO ASKAGAIN
DONE ;
+1 KILL ASUL,ASUV,X,Y,DR,DA,DIC,DIE,DUOUT,DTOUT,DIROUT
+2 QUIT
