AUM95032.m

AUM95032 ; DSD/GTH - STANDARD TABLE UPDATES (2), 03MAR95 BANYAN ; [ 03/07/95  3:00 PM ]

 ;;95.1;TABLE MAINTENANCE;**4**;NOV 1, 1994

 ;

 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 COMMMOD

 D RSLT($$COMMMOD^AUMXPORT("AUM9503A")_" patients marked for export because of the Community Code changes.")

 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^AUM9503A) Q:$P(L,";",3)="END"  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^AUM95031("^AUTTCTY(",S_O) Q:'P("O")

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

 S P("V")=$$IEN^AUM95031("^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

 ;

COMMMOD ;

 S E="Community Code Changes"

 F T=1:2 S L=$T(COMMMOD+T^AUM9503A) Q:$P(L,";",3)="END"  S L("TO")=$T(COMMMOD+T+1^AUM9503A) D

 .S L=$P(L,U,2,99),S=$P(L,U),O=$P(L,U,2),C=$P(L,U,3)

 .S P=$O(^AUTTCOM("C",S_O_C,0))

 .S L=$P(L("TO"),U,2,99),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)

 .I 'P S P=$O(^AUTTCOM("C",S_O_C,0)) I 'P S L=";;"_L D ADDCOMM Q

 .S L=S_" "_O_" "_C_" "_N_" "_A_" "_V

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

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

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

 .S DIE="^AUTTCOM(",DA=P,DR=".01///"_N_";.02////"_P("O")_";.05////"_P("V")_";.06////"_P("A")_";.07///"_C D DIE

 .I $D(Y) D RSLT(E(0)_E_" : CHANGE FAILED => "_L) Q

 .D MODOK

 .Q

 Q

 ;

COMMDEL ;

 S E="Community Inactivation"

 F T=1:1 S L=$T(COMMDEL+T^AUM9503A) Q:$P(L,";",3)="END"  D

 .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

 .S P=$O(^AUTTCOM("C",S_O_C,0))

 .I 'P D RSLT(E_" : COMMUNITY NOT FOUND (That's OK) => "_L) Q

 .S DIE="^AUTTCOM(",DA=P,DR=".14///<INACTIVE>" D DIE

 .I $D(Y) D RSLT(E(0)_E_" : EDIT FAILED => "_L) Q

 .D RSLT(E_" : SHORT NAME MARKED '<INACTIVE>' => "_L) Q

 .Q

 Q

 ;

AUM95032  ; DSD/GTH - STANDARD TABLE UPDATES (2), 03MAR95 BANYAN ; [ 03/07/95  3:00 PM ]

 +1       ;;95.1;TABLE MAINTENANCE;**4**;NOV 1, 1994

 +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 COMMMOD

 +5        DO RSLT($$COMMMOD^AUMXPORT("AUM9503A")_" patients marked for export because of the Community Code changes.")

 +6        QUIT 

 +7       ; ===   utility sub-routines   ====

 +8       ;

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^AUM9503A)

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

                   QUIT 

               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^AUM95031("^AUTTCTY(",S_O)

           IF 'P("O")

               QUIT 

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

           IF 'P("A")

               QUIT 

 +5        SET P("V")=$$IEN^AUM95031("^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       ;

COMMMOD   ;

 +1        SET E="Community Code Changes"

 +2        FOR T=1:2

               SET L=$TEXT(COMMMOD+T^AUM9503A)

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

                   QUIT 

               SET L("TO")=$TEXT(COMMMOD+T+1^AUM9503A)

               Begin DoDot:1

 +3                SET L=$PIECE(L,U,2,99)

                   SET S=$PIECE(L,U)

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

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

 +4                SET P=$ORDER(^AUTTCOM("C",S_O_C,0))

 +5                SET L=$PIECE(L("TO"),U,2,99)

                   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)

 +6                IF 'P

                       SET P=$ORDER(^AUTTCOM("C",S_O_C,0))

                       IF 'P

                           SET L=";;"_L

                           DO ADDCOMM

                           QUIT 

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

 +8                SET P("O")=$$IEN^AUM95031("^AUTTCTY(",S_O)

                   IF 'P("O")

                       QUIT 

 +9                SET P("A")=$$IEN^AUM95031("^AUTTAREA(",A)

                   IF 'P("A")

                       QUIT 

 +10               SET P("V")=$$IEN^AUM95031("^AUTTSU(",A_V)

                   IF 'P("V")

                       QUIT 

 +11               SET DIE="^AUTTCOM("

                   SET DA=P

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

                   DO DIE

 +12               IF $DATA(Y)

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

                       QUIT 

 +13               DO MODOK

 +14               QUIT 

               End DoDot:1

 +15       QUIT 

 +16      ;

COMMDEL   ;

 +1        SET E="Community Inactivation"

 +2        FOR T=1:1

               SET L=$TEXT(COMMDEL+T^AUM9503A)

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

                   QUIT 

               Begin DoDot:1

 +3                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

 +4                SET P=$ORDER(^AUTTCOM("C",S_O_C,0))

 +5                IF 'P

                       DO RSLT(E_" : COMMUNITY NOT FOUND (That's OK) => "_L)

                       QUIT 

 +6                SET DIE="^AUTTCOM("

                   SET DA=P

                   SET DR=".14///<INACTIVE>"

                   DO DIE

 +7                IF $DATA(Y)

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

                       QUIT 

 +8                DO RSLT(E_" : SHORT NAME MARKED '<INACTIVE>' => "_L)

                   QUIT 

 +9                QUIT 

               End DoDot:1

 +10       QUIT 

 +11      ;