AUM94052.m

AUM94052 ; DSD/GTH - STANDARD TABLE UPDATES (2), 06MAY94 BANYAN ; [ 05/06/94  3:56 PM ]

 ;;94.1;TABLE MAINTENANCE;**4**;DECEMBER 15, 1993

 ;

 Q

 ;

START ;EP

 ;

 NEW A,C,DIC,DIE,DLAYGO,DR,E,L,N,O,P,R,S,T

 S E(0)="ERROR : ",E(1)="NOT ADDED : "

 D COMMNEW

 Q

 ; ===   utility sub-routines   ====

 ;

ADDOK D RSLT(E_", Added : "_L) Q

ADDFAIL D RSLT(E(0)_E_" : ADD FAILED => "_L) Q

DIE NEW A,C,E,L,N,O,P,R,S,T

 LOCK +(@(DIE_DA_")")):10 E  D RSLT(E(0)_"Entry '"_DIE_DA_"' IS LOCKED.  NOTIFY PROGRAMMER.") S Y=1 Q

 D ^DIE LOCK -(@(DIE_DA_")")) K DA,DIE,DR Q

FILE NEW A,C,E,L,N,O,P,R,S,T K DD,DO S DIC(0)="L" D FILE^DICN K DIC Q

MODOK D RSLT(E_", Changed : "_L) Q

RSLT(%) S ^(0)=$G(^TMP($J,"RSLT",0))+1,^(^(0))=% W:'$D(ZTQUEUED) !,% Q

 ;

 ; =================================

 ;

COMMNEW ;

 S E="New Community Codes"

 F T=1:1 S L=$T(COMMNEW+T^AUM9405A) Q:$P(L,";",3)="END"  I $P(L,U,$L(L,U))="Y" D ADDCOMM

 Q

 ;

ADDCOMM ;

 S L=$P(L,";;",2),S=$P(L,U),O=$P(L,U,2),C=$P(L,U,3),N=$P(L,U,4),A=$P(L,U,5),V=$P(L,U,6),L=S_" "_O_" "_C_" "_N_" "_A_" "_V

 I $D(^AUTTCOM("C",S_O_C)) D RSLT(E(1)_E_" : STCTYCOM CODE EXISTS => "_S_O_C) Q

 S P("O")=$$IEN^AUM94051("^AUTTCTY(",S_O) Q:'P("O")

 S P("A")=$$IEN^AUM94051("^AUTTAREA(",A) Q:'P("A")

 S P("V")=$$IEN^AUM94051("^AUTTSU(",A_V) Q:'P("V")

 S DLAYGO=9999999.05,DIC="^AUTTCOM(",X=N,DIC("DR")=".02////"_P("O")_";.05////"_P("V")_";.06////"_P("A")_";.07///"_C D FILE

 D ADDFAIL:Y<0,ADDOK:Y>0

 Q

 ;

AUM94052  ; DSD/GTH - STANDARD TABLE UPDATES (2), 06MAY94 BANYAN ; [ 05/06/94  3:56 PM ]

 +1       ;;94.1;TABLE MAINTENANCE;**4**;DECEMBER 15, 1993

 +2       ;

 +3        QUIT 

 +4       ;

START     ;EP

 +1       ;

 +2        NEW A,C,DIC,DIE,DLAYGO,DR,E,L,N,O,P,R,S,T

 +3        SET E(0)="ERROR : "

           SET E(1)="NOT ADDED : "

 +4        DO COMMNEW

 +5        QUIT 

 +6       ; ===   utility sub-routines   ====

 +7       ;

ADDOK      DO RSLT(E_", Added : "_L)

           QUIT 

ADDFAIL    DO RSLT(E(0)_E_" : ADD FAILED => "_L)

           QUIT 

DIE        NEW A,C,E,L,N,O,P,R,S,T

 +1        LOCK +(@(DIE_DA_")")):10

          IF '$TEST

               DO RSLT(E(0)_"Entry '"_DIE_DA_"' IS LOCKED.  NOTIFY PROGRAMMER.")

               SET Y=1

               QUIT 

 +2        DO ^DIE

           LOCK -(@(DIE_DA_")"))

           KILL DA,DIE,DR

           QUIT 

FILE       NEW A,C,E,L,N,O,P,R,S,T

           KILL DD,DO

           SET DIC(0)="L"

           DO FILE^DICN

           KILL DIC

           QUIT 

MODOK      DO RSLT(E_", Changed : "_L)

           QUIT 

RSLT(%)    SET ^(0)=$GET(^TMP($JOB,"RSLT",0))+1

           SET ^(^(0))=%

           IF '$DATA(ZTQUEUED)

               WRITE !,%

           QUIT 

 +1       ;

 +2       ; =================================

 +3       ;

COMMNEW   ;

 +1        SET E="New Community Codes"

 +2        FOR T=1:1

               SET L=$TEXT(COMMNEW+T^AUM9405A)

               IF $PIECE(L,";",3)="END"

                   QUIT 

               IF $PIECE(L,U,$LENGTH(L,U))="Y"

                   DO ADDCOMM

 +3        QUIT 

 +4       ;

ADDCOMM   ;

 +1        SET L=$PIECE(L,";;",2)

           SET S=$PIECE(L,U)

           SET O=$PIECE(L,U,2)

           SET C=$PIECE(L,U,3)

           SET N=$PIECE(L,U,4)

           SET A=$PIECE(L,U,5)

           SET V=$PIECE(L,U,6)

           SET L=S_" "_O_" "_C_" "_N_" "_A_" "_V

 +2        IF $DATA(^AUTTCOM("C",S_O_C))

               DO RSLT(E(1)_E_" : STCTYCOM CODE EXISTS => "_S_O_C)

               QUIT 

 +3        SET P("O")=$$IEN^AUM94051("^AUTTCTY(",S_O)

           IF 'P("O")

               QUIT 

 +4        SET P("A")=$$IEN^AUM94051("^AUTTAREA(",A)

           IF 'P("A")

               QUIT 

 +5        SET P("V")=$$IEN^AUM94051("^AUTTSU(",A_V)

           IF 'P("V")

               QUIT 

 +6        SET DLAYGO=9999999.05

           SET DIC="^AUTTCOM("

           SET X=N

           SET DIC("DR")=".02////"_P("O")_";.05////"_P("V")_";.06////"_P("A")_";.07///"_C

           DO FILE

 +7        IF Y<0

               DO ADDFAIL

           IF Y>0

               DO ADDOK

 +8        QUIT 

 +9       ;