AUM94033.m

AUM94033 ; DSD/GTH - STANDARD TABLE UPDATES (3), 31MAR94 BANYAN ; [ 04/07/94  5:39 PM ]

 ;;94.1;TABLE MAINTENANCE;**3**;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 EDTNEW,EDTMOD,TRETNEW,MEASNEW

 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

DIK NEW A,C,E,L,N,O,P,R,S,T D ^DIK K DIK 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

 ;

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

 ;

EDTDD ;;K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>6!($L(X)<1)!'(X?1.4UN1"-"1.4UN) X

EDTNEW ;

 S $P(^DD(9999999.09,1,0),U,5,99)=$P($T(EDTDD),";;",2)

 D RSLT("EDUCATION TOPIC, field 1, Input Transform modified.")

 S E="New Education Topics"

 F T=1:1 S L=$T(EDTNEW+T^AUM9403B) Q:$P(L,";",3)="END"  I $P(L,U,$L(L,U))="Y" D ADDEDT

 Q

 ;

ADDEDT ;

 S L=$P(L,";;",2),N=$P(L,U),O=$P(L,U,2),L=N_" "_O

 I $D(^AUTTEDT("B",N)) D RSLT(E(1)_E_" : EDUCATION TOPIC EXISTS => "_N) Q

 S DLAYGO=9999999.09,DIC="^AUTTEDT(",X=N,DIC("DR")="1///"_O D FILE

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

 Q

 ;

EDTMOD ;

 S E="Education Topics Changes"

 F T=1:2 S L=$T(EDTMOD+T^AUM9403B) Q:$P(L,";",3)="END"  S L("TO")=$T(EDTMOD+T+1^AUM9403B) I $P(L("TO"),U,$L(L("TO"),U))="Y" D

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

 .S P=$O(^AUTTEDT("B",N,0))

 .S L=$P(L("TO"),U,2,99),N=$P(L,U),O=$P(L,U,2)

 .I 'P S P=$O(^AUTTEDT("B",N,0)) I 'P S L=";;"_L D ADDEDT Q

 .S L=N_" "_O

 .S DIE="^AUTTEDT(",DA=P,DR=".01///"_N_";1///"_O D DIE

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

 .D MODOK

 .Q

 Q

 ;

TRTDD ;;K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>6!($L(X)<6)!'(X?6NU) X I $D(X),$D(^AUTTTRT("C",X)),'$D(^AUTTTRT("C",X,DA)) K X W:'$D(ZTQUEUED) "    Already used! "

TRETNEW ;

 S $P(^DD(9999999.17,.02,0),U,5,99)=$P($T(TRTDD),";;",2)

 D RSLT("TREATMENT, field .02, Input Transform modified.")

 S E="New Treatments"

 F T=1:1 S L=$T(TRETNEW+T^AUM9403C) Q:$P(L,";",3)="END"  I $P(L,U,$L(L,U))="Y" D ADDTRET

 Q

 ;

ADDTRET ;

 S L=$P(L,";;",2),N=$P(L,U),C=$P(L,U,2),S=$P(L,U,3),O=$P(L,U,4),L=N_" "_C_"  "_S_"  "_O

 I $D(^AUTTTRT("B",N)) D RSLT(E(1)_E_" : TREATMENT EXISTS => "_N) Q

 S DLAYGO=9999999.17,DIC="^AUTTTRT(",X=N,DIC("DR")=".02///"_C_";.03///"_S_";8801///"_O D FILE

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

 Q

 ;

MEASNEW ;

 S E="New Measurement Type"

 F T=1:1 S L=$T(MEASNEW+T^AUM9403C) Q:$P(L,";",3)="END"  I $P(L,U,$L(L,U))="Y" D ADDMEAS

 Q

 ;

ADDMEAS ;

 S L=$P(L,";;",2),N=$P(L,U),S=$P(L,U,2),C=$P(L,U,3),L=N_" "_S_"  "_C_"  "_O

 I $D(^AUTTMSR("C",C)) D RSLT(E(1)_E_" : MEASUREMENT TYPE CODE EXISTS => "_C) Q

 S DLAYGO=9999999.07,DIC="^AUTTMSR(",X=N,DIC("DR")=".02///"_S_";.03///"_C D FILE

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

 Q

 ;

AUM94033  ; DSD/GTH - STANDARD TABLE UPDATES (3), 31MAR94 BANYAN ; [ 04/07/94  5:39 PM ]

 +1       ;;94.1;TABLE MAINTENANCE;**3**;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 EDTNEW

           DO EDTMOD

           DO TRETNEW

           DO MEASNEW

 +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 

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

           DO ^DIK

           KILL DIK

           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       ;

EDTDD     ;;K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>6!($L(X)<1)!'(X?1.4UN1"-"1.4UN) X

EDTNEW    ;

 +1        SET $PIECE(^DD(9999999.09,1,0),U,5,99)=$PIECE($TEXT(EDTDD),";;",2)

 +2        DO RSLT("EDUCATION TOPIC, field 1, Input Transform modified.")

 +3        SET E="New Education Topics"

 +4        FOR T=1:1

               SET L=$TEXT(EDTNEW+T^AUM9403B)

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

                   QUIT 

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

                   DO ADDEDT

 +5        QUIT 

 +6       ;

ADDEDT    ;

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

           SET N=$PIECE(L,U)

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

           SET L=N_" "_O

 +2        IF $DATA(^AUTTEDT("B",N))

               DO RSLT(E(1)_E_" : EDUCATION TOPIC EXISTS => "_N)

               QUIT 

 +3        SET DLAYGO=9999999.09

           SET DIC="^AUTTEDT("

           SET X=N

           SET DIC("DR")="1///"_O

           DO FILE

 +4        IF Y<0

               DO ADDFAIL

           IF Y>0

               DO ADDOK

 +5        QUIT 

 +6       ;

EDTMOD    ;

 +1        SET E="Education Topics Changes"

 +2        FOR T=1:2

               SET L=$TEXT(EDTMOD+T^AUM9403B)

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

                   QUIT 

               SET L("TO")=$TEXT(EDTMOD+T+1^AUM9403B)

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

                   Begin DoDot:1

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

                       SET N=$PIECE(L,U)

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

 +4                    SET P=$ORDER(^AUTTEDT("B",N,0))

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

                       SET N=$PIECE(L,U)

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

 +6                    IF 'P

                           SET P=$ORDER(^AUTTEDT("B",N,0))

                           IF 'P

                               SET L=";;"_L

                               DO ADDEDT

                               QUIT 

 +7                    SET L=N_" "_O

 +8                    SET DIE="^AUTTEDT("

                       SET DA=P

                       SET DR=".01///"_N_";1///"_O

                       DO DIE

 +9                    IF $DATA(Y)

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

                           QUIT 

 +10                   DO MODOK

 +11                   QUIT 

                   End DoDot:1

 +12       QUIT 

 +13      ;

TRTDD     ;;K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>6!($L(X)<6)!'(X?6NU) X I $D(X),$D(^AUTTTRT("C",X)),'$D(^AUTTTRT("C",X,DA)) K X W:'$D(ZTQUEUED) "    Already used! "

TRETNEW   ;

 +1        SET $PIECE(^DD(9999999.17,.02,0),U,5,99)=$PIECE($TEXT(TRTDD),";;",2)

 +2        DO RSLT("TREATMENT, field .02, Input Transform modified.")

 +3        SET E="New Treatments"

 +4        FOR T=1:1

               SET L=$TEXT(TRETNEW+T^AUM9403C)

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

                   QUIT 

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

                   DO ADDTRET

 +5        QUIT 

 +6       ;

ADDTRET   ;

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

           SET N=$PIECE(L,U)

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

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

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

           SET L=N_" "_C_"  "_S_"  "_O

 +2        IF $DATA(^AUTTTRT("B",N))

               DO RSLT(E(1)_E_" : TREATMENT EXISTS => "_N)

               QUIT 

 +3        SET DLAYGO=9999999.17

           SET DIC="^AUTTTRT("

           SET X=N

           SET DIC("DR")=".02///"_C_";.03///"_S_";8801///"_O

           DO FILE

 +4        IF Y<0

               DO ADDFAIL

           IF Y>0

               DO ADDOK

 +5        QUIT 

 +6       ;

MEASNEW   ;

 +1        SET E="New Measurement Type"

 +2        FOR T=1:1

               SET L=$TEXT(MEASNEW+T^AUM9403C)

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

                   QUIT 

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

                   DO ADDMEAS

 +3        QUIT 

 +4       ;

ADDMEAS   ;

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

           SET N=$PIECE(L,U)

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

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

           SET L=N_" "_S_"  "_C_"  "_O

 +2        IF $DATA(^AUTTMSR("C",C))

               DO RSLT(E(1)_E_" : MEASUREMENT TYPE CODE EXISTS => "_C)

               QUIT 

 +3        SET DLAYGO=9999999.07

           SET DIC="^AUTTMSR("

           SET X=N

           SET DIC("DR")=".02///"_S_";.03///"_C

           DO FILE

 +4        IF Y<0

               DO ADDFAIL

           IF Y>0

               DO ADDOK

 +5        QUIT 

 +6       ;