4:26 PM  24-NOV-97
AUM v 98.1, Patch 1, in support of Annual ICD updates.  Restore 4 routines and DO ^AUM8101.
A9AUM1
A9AUM1 ; IHS/ADC/GTH - STANDARD TABLE UPDATES, ICD 98.1 SUPPORT, RPI ; [ 11/24/97   4:25 PM ]
 ;;98.1;TABLE MAINTENANCE;**1**;NOV 17,1997
 ;
 D START^AUM8101
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 ;     
 ;;AUM8101
 ;;AUM81011
 ;;AUM8101A

AUM8101
AUM8101 ; IHS/ADC/GTH - STANDARD TABLE UPDATES, ICD 98.1 SUPPORT ; [ 11/24/97   4:25 PM ]
 ;;98.1;TABLE MAINTENANCE;**1**;NOV 17,1997
 ;
 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^AUM8101(""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 AUM8101
 S X=+Y
 D H^%DTC
 S ZTDTH=%H_","_%T
 S ZTRTN="START^AUM8101",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("AUM8101",$J)
 D START^AUM81011
 S XMSUB=$P($P($T(+1),";",2)," ",4,99),XMDUZ=$S($G(DUZ):DUZ,1:.5),XMTEXT="^TMP(""AUM8101"",$J,",XMY(1)="",XMY(DUZ)=""
 D ^XMD
 KILL ^TMP("AUM8101",$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 98.1 update, affecting recode tables
 ;;           CHA ICD RECODE.
 ;;
 ;;###
 ;
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
 ;

AUM81011
AUM81011 ; IHS/ADC/GTH - STANDARD TABLE UPDATES, ICD 98.1 SUPPORT ; [ 11/24/97   4:25 PM ]
 ;;98.1;TABLE MAINTENANCE;**1**;NOV 17,1997
 ;
 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
 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("AUM8101",$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^AUM8101A) 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^AUM8101A) 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^AUM8101A) 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
 ;

AUM8101A
AUM8101A ; IHS/ADC/GTH - STANDARD TABLE UPDATES DATA, ICD 98.1 SUPPORT ; [ 11/24/97   4:25 PM ]
 ;;98.1;TABLE MAINTENANCE;**1**;NOV 17,1997
 ;
CHADEL ; CHA ICD RECODE TABLE: CODE^NARRATIVE^LO ICD9^HI ICD9
 ;;85^ABUSED OR BATTERED INDIVIDUAL^9955^99585
 ;;END
 ;
CHAADD ; CHA ICD RECODE TABLE: CODE^NARRATIVE^LO ICD9^HI ICD9
 ;;85^ABUSED OR BATTERED INDIVIDUAL^9955^99559
 ;;85^ABUSED OR BATTERED INDIVIDUAL^99581^99585
 ;;END
 ;