AUM93083 ; DSD/GTH - STANDARD TABLE UPDATES (3), EXAM & HEALTH FACTORS ; [ 09/23/93 11:59 AM ]
;;93.1;TABLE MAINTENANCE;**6**;MARCH 23, 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 EXAMNEW,EXAMMOD,HFNEW
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
;
; =================================
;
EXAMNEW ;
S E="New Exam Codes"
F T=1:1 S L=$T(EXAMNEW+T^AUM9308B) Q:$P(L,";",3)="END" I $P(L,U,$L(L,U))="Y" D ADDEXAM
Q
;
ADDEXAM ;
S L=$P(L,";;",2),C=$P(L,U),N=$P(L,U,2),L=C_" "_N
I $D(^AUTTEXAM("C",C)) D RSLT(E(1)_E_" : EXAM CODE EXISTS => "_C) Q
S DLAYGO=9999999.15,DIC="^AUTTEXAM(",X=N,DIC("DR")=".02///"_C D FILE
D ADDFAIL:Y<0,ADDOK:Y>0
Q
;
EXAMMOD ;
S E="Exam Name Changes"
F T=1:2 S L=$T(EXAMMOD+T^AUM9308B) Q:$P(L,";",3)="END" S L("TO")=$T(EXAMMOD+T+1^AUM9308B) I $P(L("TO"),U,$L(L("TO"),U))="Y" D
.S L=$P(L,U,2,99),C=$P(L,U),N=$P(L,U,2)
.S DA=$O(^AUTTEXAM("C",C,0))
.S L=$P(L("TO"),U,2,99),C=$P(L,U),N=$P(L,U,2)
.I 'DA S L=";;"_L D ADDEXAM Q
.S L=C_" "_N
.S DIE="^AUTTEXAM(",DR=".01///"_N D DIE
.I $D(Y) D RSLT(E(0)_E_" : CHANGE FAILED => "_L) Q
.D MODOK
.Q
Q
;
HFNEW ;
S E="New Health Factor Entries"
F T=1:1 S L=$T(HFNEW+T^AUM9308B) Q:$P(L,";",3)="END" I $P(L,U,$L(L,U))="Y" D ADDHF
Q
;
ADDHF ;
S L=$P(L,";;",2),N=$P(L,U),C=$P(L,U,2),S=$P(L,U,3),L=N_" "_C_" "_S
I $D(^AUTTHF("B",N)) D RSLT(E(1)_E_" : HEALTH FACTOR EXISTS => "_N) Q
S DLAYGO=9999999.64,DIC="^AUTTHF(",X=N,DIC("DR")=".03///"_C_";.1///"_S D FILE
D ADDFAIL:Y<0,ADDOK:Y>0
Q
;
AUM93083 ; DSD/GTH - STANDARD TABLE UPDATES (3), EXAM & HEALTH FACTORS ; [ 09/23/93 11:59 AM ]
+1 ;;93.1;TABLE MAINTENANCE;**6**;MARCH 23, 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 EXAMNEW
DO EXAMMOD
DO HFNEW
+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 ;
EXAMNEW ;
+1 SET E="New Exam Codes"
+2 FOR T=1:1
SET L=$TEXT(EXAMNEW+T^AUM9308B)
IF $PIECE(L,";",3)="END"
QUIT
IF $PIECE(L,U,$LENGTH(L,U))="Y"
DO ADDEXAM
+3 QUIT
+4 ;
ADDEXAM ;
+1 SET L=$PIECE(L,";;",2)
SET C=$PIECE(L,U)
SET N=$PIECE(L,U,2)
SET L=C_" "_N
+2 IF $DATA(^AUTTEXAM("C",C))
DO RSLT(E(1)_E_" : EXAM CODE EXISTS => "_C)
QUIT
+3 SET DLAYGO=9999999.15
SET DIC="^AUTTEXAM("
SET X=N
SET DIC("DR")=".02///"_C
DO FILE
+4 IF Y<0
DO ADDFAIL
IF Y>0
DO ADDOK
+5 QUIT
+6 ;
EXAMMOD ;
+1 SET E="Exam Name Changes"
+2 FOR T=1:2
SET L=$TEXT(EXAMMOD+T^AUM9308B)
IF $PIECE(L,";",3)="END"
QUIT
SET L("TO")=$TEXT(EXAMMOD+T+1^AUM9308B)
IF $PIECE(L("TO"),U,$LENGTH(L("TO"),U))="Y"
Begin DoDot:1
+3 SET L=$PIECE(L,U,2,99)
SET C=$PIECE(L,U)
SET N=$PIECE(L,U,2)
+4 SET DA=$ORDER(^AUTTEXAM("C",C,0))
+5 SET L=$PIECE(L("TO"),U,2,99)
SET C=$PIECE(L,U)
SET N=$PIECE(L,U,2)
+6 IF 'DA
SET L=";;"_L
DO ADDEXAM
QUIT
+7 SET L=C_" "_N
+8 SET DIE="^AUTTEXAM("
SET DR=".01///"_N
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 ;
HFNEW ;
+1 SET E="New Health Factor Entries"
+2 FOR T=1:1
SET L=$TEXT(HFNEW+T^AUM9308B)
IF $PIECE(L,";",3)="END"
QUIT
IF $PIECE(L,U,$LENGTH(L,U))="Y"
DO ADDHF
+3 QUIT
+4 ;
ADDHF ;
+1 SET L=$PIECE(L,";;",2)
SET N=$PIECE(L,U)
SET C=$PIECE(L,U,2)
SET S=$PIECE(L,U,3)
SET L=N_" "_C_" "_S
+2 IF $DATA(^AUTTHF("B",N))
DO RSLT(E(1)_E_" : HEALTH FACTOR EXISTS => "_N)
QUIT
+3 SET DLAYGO=9999999.64
SET DIC="^AUTTHF("
SET X=N
SET DIC("DR")=".03///"_C_";.1///"_S
DO FILE
+4 IF Y<0
DO ADDFAIL
IF Y>0
DO ADDOK
+5 QUIT
+6 ;
