AUM91011 ; IHS/ASDST/GTH - STANDARD TABLE UPDATES, ICD 99.1 SUPPORT ; [ 11/03/1998 5:26 PM ]
;;99.1;TABLE MAINTENANCE;**1**;NOV 6,1998
;
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 DASH,RCDADD,DASH
Q
; === utility sub-routines ====
;
ADDOK D RSLT($J("",5)_"Added : "_L) Q
ADDFAIL D RSLT($J("",5)_E(0)_"ADD FAILED => "_L) Q
DASH D RSLT(""),RSLT($$REPEAT^XLFSTR("-",$S($G(IOM):IOM-10,1:70))),RSLT("") Q
DIE NEW A,C,E,L,M,N,O,P,R,S,T
LOCK +(@(DIE_DA_")")):10 E D RSLT($J("",5)_E(0)_"Entry '"_DIE_DA_"' IS LOCKED. NOTIFY PROGRAMMER.") S Y=1 Q
D ^DIE LOCK -(@(DIE_DA_")")) KILL DA,DIE,DR Q
E(L) Q $P($P($T(@L^AUM9101A),";",3),":",1)
DIK NEW A,C,E,L,M,N,O,P,R,S,T D ^DIK KILL DIK Q
FILE NEW A,C,E,L,M,N,O,P,R,S,T K DD,DO S DIC(0)="L" D FILE^DICN KILL DIC Q
RSLT(%) S ^(0)=$G(^TMP("AUM9101",$J,0))+1,^(^(0))=% W:'$D(ZTQUEUED) !,% Q
ZEROTH(A,B,C,D,E,F,G,H,I,J,K) ; Return 0th node. A is file #, rest fields.
I '$G(A) Q -1
I '$G(B) Q -1
F %=67:1:75 Q:'$G(@($C(%))) S A=+$P(^DD(A,B,0),U,2),B=@($C(%))
I 'A!('B) Q -1
I '$D(^DD(A,B,0)) Q -1
Q U_$P(^DD(A,B,0),U,2)
;
; =================================
;
ADDRCD ;
S L=$P(L,";;",2),C=$P(L,U),R=$P(L,U,2),N=$P(L,U,3),L=C_" "_R_" "_N
I $D(^AUTTRCD("B",C)) D RSLT($J("",5)_E(1)_" : RECODE ICD/APC EXISTS => "_C) Q
S DLAYGO=9999999.08,DIC="^AUTTRCD(",X=C,DIC("DR")=".02///"_R_";.03///"_N
D FILE,ADDFAIL:Y<0,ADDOK:Y>0
I Y>0,'$D(^AUTTRCD(+Y,11)) S %=$$ZEROTH(9999999.08,1101) I '(%=-1) S ^AUTTRCD(+Y,11,0)=%
Q
;
RCDADD ;
D RSLT($$E("RCDADD"))
D RSLT($J("",14)_"CODE ICD CODE NARRATIVE"_$J("",16)_" LO ICD9 HI ICD9")
D RSLT($J("",14)_"---- -------- ---------"_$J("",16)_" ------- -------")
F T=1:1 S L=$T(RCDADD+T^AUM9101A) Q:$P(L,";",3)="END" D
. S L=$P(L,";;",2),C=$P(L,U),R=$P(L,U,2),N=$P(L,U,3),O=$P(L,U,4),S=$P(L,U,5)
. S P=$O(^AUTTRCD("B",C,0))
. I 'P S L=";;"_L D ADDRCD Q:Y<0
. S L=C_" "_R_$J("",7-$L(R))_" "_N_$J("",25-$L(N))_" "_O_$J("",7-$L(O))_" "_S
. I $O(^AUTTRCD(P,11,"B",$E(O,1,30),0)),$O(^AUTTRCD(P,11,"B",$E(O,1,30),0))=$O(^AUTTRCD("AH",S_" ",P,0)) D RSLT($J("",5)_"Range Exists (That's OK)"),RSLT($J("",11)_"=> "_L) Q
. I '$D(^AUTTRCD(P,11)) S ^(11,0)="^9999999.81101^^"
. S DIC="^AUTTRCD("_P_",11,",X=O,DA(1)=P
. D FILE
. I Y<0 D RSLT($J("",5)_E(0)_" : ADD RANGE FAILED => "_L) Q
. S DIE="^AUTTRCD("_P_",11,",DA(1)=P,DA=+Y,P(1)=DA,DR=".02///"_S
. D DIE
. I $D(Y) D RSLT($J("",5)_E(0)_" : ADD RANGE FAILED => "_L) S DA(1)=P,DA=P(1),DIK="^AUTTRCD("_DA(1)_",11," D DIK Q
. D RSLT($J("",5)_"Added => "_L)
.Q
Q
;
AUM91011 ; IHS/ASDST/GTH - STANDARD TABLE UPDATES, ICD 99.1 SUPPORT ; [ 11/03/1998 5:26 PM ]
+1 ;;99.1;TABLE MAINTENANCE;**1**;NOV 6,1998
+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 DASH
DO RCDADD
DO DASH
+5 QUIT
+6 ; === utility sub-routines ====
+7 ;
ADDOK DO RSLT($JUSTIFY("",5)_"Added : "_L)
QUIT
ADDFAIL DO RSLT($JUSTIFY("",5)_E(0)_"ADD FAILED => "_L)
QUIT
DASH DO RSLT("")
DO RSLT($$REPEAT^XLFSTR("-",$SELECT($GET(IOM):IOM-10,1:70)))
DO RSLT("")
QUIT
DIE NEW A,C,E,L,M,N,O,P,R,S,T
+1 LOCK +(@(DIE_DA_")")):10
IF '$TEST
DO RSLT($JUSTIFY("",5)_E(0)_"Entry '"_DIE_DA_"' IS LOCKED. NOTIFY PROGRAMMER.")
SET Y=1
QUIT
+2 DO ^DIE
LOCK -(@(DIE_DA_")"))
KILL DA,DIE,DR
QUIT
E(L) QUIT $PIECE($PIECE($TEXT(@L^AUM9101A),";",3),":",1)
DIK NEW A,C,E,L,M,N,O,P,R,S,T
DO ^DIK
KILL DIK
QUIT
FILE NEW A,C,E,L,M,N,O,P,R,S,T
KILL DD,DO
SET DIC(0)="L"
DO FILE^DICN
KILL DIC
QUIT
RSLT(%) SET ^(0)=$GET(^TMP("AUM9101",$JOB,0))+1
SET ^(^(0))=%
IF '$DATA(ZTQUEUED)
WRITE !,%
QUIT
ZEROTH(A,B,C,D,E,F,G,H,I,J,K) ; Return 0th node. A is file #, rest fields.
+1 IF '$GET(A)
QUIT -1
+2 IF '$GET(B)
QUIT -1
+3 FOR %=67:1:75
IF '$GET(@($CHAR(%)))
QUIT
SET A=+$PIECE(^DD(A,B,0),U,2)
SET B=@($CHAR(%))
+4 IF 'A!('B)
QUIT -1
+5 IF '$DATA(^DD(A,B,0))
QUIT -1
+6 QUIT U_$PIECE(^DD(A,B,0),U,2)
+7 ;
+8 ; =================================
+9 ;
ADDRCD ;
+1 SET L=$PIECE(L,";;",2)
SET C=$PIECE(L,U)
SET R=$PIECE(L,U,2)
SET N=$PIECE(L,U,3)
SET L=C_" "_R_" "_N
+2 IF $DATA(^AUTTRCD("B",C))
DO RSLT($JUSTIFY("",5)_E(1)_" : RECODE ICD/APC EXISTS => "_C)
QUIT
+3 SET DLAYGO=9999999.08
SET DIC="^AUTTRCD("
SET X=C
SET DIC("DR")=".02///"_R_";.03///"_N
+4 DO FILE
IF Y<0
DO ADDFAIL
IF Y>0
DO ADDOK
+5 IF Y>0
IF '$DATA(^AUTTRCD(+Y,11))
SET %=$$ZEROTH(9999999.08,1101)
IF '(%=-1)
SET ^AUTTRCD(+Y,11,0)=%
+6 QUIT
+7 ;
RCDADD ;
+1 DO RSLT($$E("RCDADD"))
+2 DO RSLT($JUSTIFY("",14)_"CODE ICD CODE NARRATIVE"_$JUSTIFY("",16)_" LO ICD9 HI ICD9")
+3 DO RSLT($JUSTIFY("",14)_"---- -------- ---------"_$JUSTIFY("",16)_" ------- -------")
+4 FOR T=1:1
SET L=$TEXT(RCDADD+T^AUM9101A)
IF $PIECE(L,";",3)="END"
QUIT
Begin DoDot:1
+5 SET L=$PIECE(L,";;",2)
SET C=$PIECE(L,U)
SET R=$PIECE(L,U,2)
SET N=$PIECE(L,U,3)
SET O=$PIECE(L,U,4)
SET S=$PIECE(L,U,5)
+6 SET P=$ORDER(^AUTTRCD("B",C,0))
+7 IF 'P
SET L=";;"_L
DO ADDRCD
IF Y<0
QUIT
+8 SET L=C_" "_R_$JUSTIFY("",7-$LENGTH(R))_" "_N_$JUSTIFY("",25-$LENGTH(N))_" "_O_$JUSTIFY("",7-$LENGTH(O))_" "_S
+9 IF $ORDER(^AUTTRCD(P,11,"B",$EXTRACT(O,1,30),0))
IF $ORDER(^AUTTRCD(P,11,"B",$EXTRACT(O,1,30),0))=$ORDER(^AUTTRCD("AH",S_" ",P,0))
DO RSLT($JUSTIFY("",5)_"Range Exists (That's OK)")
DO RSLT($JUSTIFY("",11)_"=> "_L)
QUIT
+10 IF '$DATA(^AUTTRCD(P,11))
SET ^(11,0)="^9999999.81101^^"
+11 SET DIC="^AUTTRCD("_P_",11,"
SET X=O
SET DA(1)=P
+12 DO FILE
+13 IF Y<0
DO RSLT($JUSTIFY("",5)_E(0)_" : ADD RANGE FAILED => "_L)
QUIT
+14 SET DIE="^AUTTRCD("_P_",11,"
SET DA(1)=P
SET DA=+Y
SET P(1)=DA
SET DR=".02///"_S
+15 DO DIE
+16 IF $DATA(Y)
DO RSLT($JUSTIFY("",5)_E(0)_" : ADD RANGE FAILED => "_L)
SET DA(1)=P
SET DA=P(1)
SET DIK="^AUTTRCD("_DA(1)_",11,"
DO DIK
QUIT
+17 DO RSLT($JUSTIFY("",5)_"Added => "_L)
+18 QUIT
End DoDot:1
+19 QUIT
+20 ;
