5:06 PM  3-DEC-96
AUM v 97.1 Patch 1, ICD update support.  Restore 4 routines and DO ^AUM7101.
A9AUM1
A9AUM1 ; IHS/ADC/GTH - STANDARD TABLE UPDATES, ICD 97.1 SUPPORT, RPI ; [ 12/03/96  5:06 PM ]
 ;;97.1;TABLE MAINTENANCE;**1**;DEC 10,1996
 ;
 D START^AUM7101
INTERACT ;EP - Delete routines from interactive call.
 Q:'$L($G(^%ZOSF("DEL")))
 NEW X
 F %=1:1 S X=$P($T(DEL+%),";",3) Q:X=""  X ^%ZOSF("DEL") I '$D(ZTQUEUED) W !,X," (poof'd)"
 Q
DEL ;     
 ;;AUM7101
 ;;AUM71011
 ;;AUM7101A

AUM7101
AUM7101 ; IHS/ADC/GTH - STANDARD TABLE UPDATES, ICD 97.1 SUPPORT ; [ 12/03/96   4:24 PM ]
 ;;97.1;TABLE MAINTENANCE;**1**;DEC 10,1996
 ;
 I '$G(DUZ) W !,"DUZ UNDEFINED OR ZERO.",! Q
 D HOME^%ZIS,DT^DICRW,HELP("INTRO")
 S (DIR(0),DIR("B"))="Y"
 S DIR("A")="Do you want to queue the update to TaskMan"
 S DIR("??")="^D HELP^AUM7101(""Q2"")"
 D ^DIR
 I $D(DIRUT) D HELP("Q2") Q
 G START:'Y
QUE ;
 S %DT="AERSX",%DT("A")="Requested Start Time: ",%DT("B")="T@2015",%DT(0)="NOW"
 D ^%DT
 I Y<1 W !,"QUEUE INFORMATION MISSING - NOT QUEUED" D Q2 G AUM7101
 S X=+Y
 D H^%DTC
 S ZTDTH=%H_","_%T
 S ZTRTN="START^AUM7101",ZTIO="",ZTDESC=$P($P($T(+1),";",2)," ",4,99)
 D ^%ZTLOAD,HOME^%ZIS
 I $D(ZTSK) W !!,"QUEUED TO TASK ",ZTSK,!!,"A mail message with the results will be sent to your MailMan 'IN' basket.",!
 E  W !!,*7,"QUEUE UNSUCCESSFUL.  RESTART UTILITY."
 Q
 ;
START ;EP - From Taskman
 ;
 NEW XMSUB,XMDUZ,XMTEXT,XMY
 KILL ^TMP("AUM7101",$J)
 D START^AUM71011
 S XMSUB=$P($P($T(+1),";",2)," ",4,99),XMDUZ=$S($G(DUZ):DUZ,1:.5),XMTEXT="^TMP(""AUM7101"",$J,",XMY(1)="",XMY(DUZ)=""
 D ^XMD
 KILL ^TMP("AUM7101",$J)
 I $D(ZTQUEUED) S ZTREQ="@" Q
 W !!,"The results are in your MailMan 'IN' basket.",!
 I $L($T(DIR^XBDIR)),$$DIR^XBDIR("Y","Want me to delete the routines in this patch","Y") G INTERACT^A9AUM1
 Q
 ;
INTRO ;
 ;;This updates standard tables according to the changes specified in
 ;;the ICD 97.1 update, affecting recode tables
 ;;           CHA ICD RECODE and
 ;;           RECODE ICD/APC.
 ;;
 ;;###
 ;
Q2 ;
 ;;Answer "Y" if you want to queue this standard table update to TaskMan.
 ;;Answer "N" if you want to run this update interactively.
 ;;
 ;;If you run interactively, results will be displayed on your screen,
 ;;as well as in the mail message sent to you and user 1.  If you queue
 ;;to TaskMan, please read the mail message for results of this update.
 ;;###
 ;
HELP(L) ;EP - Display text at label L.
 W !
 F %=1:1 W !?4,$P($T(@L+%),";",3) Q:$P($T(@L+%+1),";",3)="###"
 Q
 ;

AUM71011
AUM71011 ; IHS/ADC/GTH - STANDARD TABLE UPDATES, ICD 97.1 SUPPORT ; [ 12/03/96  5:03 PM ]
 ;;97.1;TABLE MAINTENANCE;**1**;DEC 10,1996
 ;
 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,CHADEL,DASH,CHAADD,DASH,RCDDEL,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,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
DIK NEW A,C,E,L,N,O,P,R,S,T D ^DIK KILL DIK Q
FILE NEW A,C,E,L,N,O,P,R,S,T KILL DD,DO S DIC(0)="L" D FILE^DICN KILL DIC Q
MODOK D RSLT($J("",5)_"Changed : "_L) Q
RSLT(%) S ^(0)=$G(^TMP("AUM7101",$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)
 ;
 ; =================================
 ;
CHANEW ;
 D RSLT("New CHA ICD Recode Table")
 F T=1:1 S L=$T(CHANEW+T^AUM7101A) Q:$P(L,";",3)="END"  D ADDCHA
 Q
 ;
ADDCHA ;
 S L=$P(L,";;",2),C=$P(L,U),N=$P(L,U,2),L=C_" "_N
 I $D(^AUTTCHA("B",C)) D RSLT($J("",5)_E(1)_" : CHA ICD RECODE EXISTS => "_C) Q
 S DLAYGO=9999999.74,DIC="^AUTTCHA(",X=C,DIC("DR")=".03///"_N
 D FILE,ADDFAIL:Y<0,ADDOK:Y>0
 I Y>0,'$D(^AUTTCHA(+Y,11)) S %=$$ZEROTH(9999999.74,1101) I '(%=-1) S ^AUTTCHA(+Y,11,0)=%
 Q
 ;
CHAADD ;
 D RSLT("CHA ICD Recode, Add Range")
 F T=1:1 S L=$T(CHAADD+T^AUM7101A) Q:$P(L,";",3)="END"  D
 . S L=$P(L,";;",2),C=$P(L,U),N=$P(L,U,2),O=$P(L,U,3),S=$P(L,U,4)
 . S P=$O(^AUTTCHA("B",C,0))
 . I 'P S L=";;"_L D ADDCHA Q:Y<0
 . S L=C_" "_N_"  "_O_"  "_S
 . I $O(^AUTTCHA(P,11,"B",$E(O,1,30),0)),$O(^AUTTCHA(P,11,"B",$E(O,1,30),0))=$O(^AUTTCHA("AH",S_" ",P,0)) D RSLT($J("",5)_"Range Exists (That's OK)"),RSLT($J("",10)_"=> "_L) Q
 . I '$D(^AUTTCHA(P,11)) S %=$$ZEROTH(9999999.74,1101) I '(%=-1) S ^AUTTCHA(P,11,0)=%
 . S DIC="^AUTTCHA("_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="^AUTTCHA("_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="^AUTTCHA("_DA(1)_",11," D DIK Q
 . D RSLT($J("",5)_"Added => "_L)
 .Q
 Q
 ;
CHADEL ;
 D RSLT("CHA ICD Recode, Delete Range")
 F T=1:1 S L=$T(CHADEL+T^AUM7101A) Q:$P(L,";",3)="END"  D
 . S L=$P(L,";;",2),C=$P(L,U),N=$P(L,U,2),O=$P(L,U,3),S=$P(L,U,4),L=C_" "_N_"  "_O_"  "_S
 . S P=$O(^AUTTCHA("B",C,0))
 . I 'P D RSLT($J("",5)_"Code does not exist (That's OK) => "_L) Q
 . I '$O(^AUTTCHA(P,11,"B",$E(O,1,30),0)) D RSLT($J("",5)_"Range does not exist (That's OK)"),RSLT($J("",10)_"=> "_L) Q
 . I $O(^AUTTCHA(P,11,"B",$E(O,1,30),0))'=$O(^AUTTCHA("AH",S_" ",P,0)) D RSLT($J("",5)_"Range does not exist (That's OK)"),RSLT($J("",10)_"=> "_L) Q
 . S DA(1)=P,DA=$O(^AUTTCHA(P,11,"B",$E(O,1,30),0)),DIK="^AUTTCHA("_DA(1)_",11,"
 . D DIK,RSLT($J("",5)_"Deleted => "_L)
 .Q
 Q
 ;
RCDNEW ;
 D RSLT("New Recode ICD/APC")
 F T=1:1 S L=$T(RCDNEW+T^AUM7101A) Q:$P(L,";",3)="END"  D ADDRCD
 Q
 ;
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("Recode ICD/APC, Add Range")
 F T=1:1 S L=$T(RCDADD+T^AUM7101A) 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_"  "_N_"  "_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("",10)_"=> "_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
 ;
RCDDEL ;
 D RSLT("Recode ICD/APC, Delete Range")
 F T=1:1 S L=$T(RCDDEL+T^AUM7101A) 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),L=C_" "_R_"  "_N_"  "_O_"  "_S
 . S P=$O(^AUTTRCD("B",C,0))
 . I 'P D RSLT($J("",5)_"Code does not exist (That's OK)"),RSLT($J("",10)_"=> "_L) Q
 . I '$O(^AUTTRCD(P,11,"B",$E(O,1,30),0)) D RSLT($J("",5)_"Range does not exist (That's OK)"),RSLT($J("",10)_"=> "_L) Q
 . I $O(^AUTTRCD(P,11,"B",$E(O,1,30),0))'=$O(^AUTTRCD("AH",S_" ",P,0)) D RSLT($J("",5)_"Range does not exist (That's OK)"),RSLT($J("",10)_"=> "_L) Q
 . S DA(1)=P,DA=$O(^AUTTRCD(P,11,"B",$E(O,1,30),0)),DIK="^AUTTRCD("_DA(1)_",11,"
 . D DIK,RSLT($J("",5)_"Deleted => "_L)
 .Q
 Q
 ;

AUM7101A
AUM7101A ; IHS/ADC/GTH - STANDARD TABLE UPDATES DATA, ICD 97.1 SUPPORT ; [ 12/03/96  4:26 PM ]
 ;;97.1;TABLE MAINTENANCE;**1**;DEC 10,1996
 ;
CHADEL ; CHA ICD RECODE TABLE: CODE^NARRATIVE^LO ICD9^HI ICD9
 ;;85^ABUSED OR BATTERED INDIVIDUAL^9955^99559
 ;;85^ABUSED OR BATTERED INDIVIDUAL^99581^99581
 ;;END
 ;
CHAADD ; CHA ICD RECODE TABLE: CODE^NARRATIVE^LO ICD9^HI ICD9
 ;;85^ABUSED OR BATTERED INDIVIDUAL^9955^99585
 ;;88^POSTOPERATIVE INFECTION^99883^99883
 ;;END
 ;
RCDDEL ; RECODE ICD/APC: CODE^ICD9 CODE^NARRATIVE^LO ICD9^HI ICD9
 ;;826^09V629^ENVIRONMENTAL PROBLEM^09V62^09V6399
 ;;END
 ;
RCDADD ; RECODE ICD/APC: CODE^ICD9 CODE^NARRATIVE^LO ICD9^HI ICD9
 ;;825^09V609^SOCIO-ECONOMIC PROBLEM^09V6283^09V6283
 ;;826^09V629^ENVIRONMENTAL PROBLEM^09V6281^09V6282
 ;;826^09V629^ENVIRONMENTAL PROBLEM^09V6289^09V6399
 ;;END
 ;