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 ;
