5:04 PM  18-JUN-96
AUM v 96.1 patch 8, SCB updates from 04Jun96 Banyan, and ADA Code changes.
A9AUM8
A9AUM8 ; IHS/ADC/GTH - STANDARD TABLE UPDATES, 04JUN96 BANYAN, RPI ; [ 06/18/96  5:03 PM ]
 ;;96.1;TABLE MAINTENANCE;**8**;OCT 26,1995
 ;
 D START^AUM6108
INTERACT ;EP - Delete routines from interactive call.
 Q:'$L($G(^%ZOSF("DEL")))
 NEW AUM,X
 F AUM=1:1 S X=$P($T(DEL+AUM),";",3) Q:X=""  X ^%ZOSF("DEL") I '$D(ZTQUEUED) W !,X,$E("...........",1,11-$L(X)),"<poof'd>"
 Q
DEL ;     
 ;;A9AUM7
 ;;AUM6108
 ;;AUM61081
 ;;AUM6108A
 ;;AUM6108M

AUM6108
AUM6108 ; IHS/ADC/GTH - STANDARD TABLE UPDATES, 04JUN96 BANYAN ; [ 06/04/96  12:08 PM ]
 ;;96.1;TABLE MAINTENANCE;**8**;OCT 26,1995
 ;
 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^AUM6108(""Q2"")"
 D ^DIR
 KILL 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 AUM6108
 S X=+Y
 D H^%DTC
 S ZTDTH=%H_","_%T
 S ZTRTN="START^AUM6108",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("AUM6108",$J)
 D START^AUM61081
 S XMSUB=$P($P($T(+1),";",2)," ",4,99),XMDUZ=$S($G(DUZ):DUZ,1:.5),XMTEXT="^TMP(""AUM6108"",$J,",XMY(1)="",XMY(DUZ)=""
 D ^XMD
 KILL ^TMP("AUM6108",$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^A9AUM8
 Q
 ;
INTRO ;
 ;;This updates standard tables according to the changes specified in
 ;;the Banyan message time stamped 04Jun96@09:53:36 MDT. Please consult
 ;;that message, and the mail message produced by this update.
 ;;
 ;;###
 ;
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
 ;

AUM61081
AUM61081 ; IHS/ADC/GTH - STANDARD TABLE UPDATES, 04JUN96 BANYAN ; [ 06/18/96  4:40 PM ]
 ;;96.1;TABLE MAINTENANCE;**8**;OCT 26,1995
 ;
 Q
 ;
START ;EP
 ;
 NEW A,C,DIC,DIE,DLAYGO,DR,E,L,M,N,O,P,R,S,T
 ;
 S E(0)="ERROR : ",E(1)="NOT ADDED : "
 D RSLT($J("",15)_$P($T(UPDATE^AUM6108A),";",3))
 D DASH,SUNEW,DASH,LOCNEW,DASH,LOCMOD,DASH,COMMNEW,DASH,ADAMOD,DASH,ADAADD,DASH
 ;
 Q
 ;
 ; -----------------------------------------------------
 ;
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_")")) K DA,DIE,DR Q
IEN(X,%,Y) ;
 S Y=$O(@(X_"""C"",%,0)"))
 I 'Y S Y=$T(@%^AUM6108M) I Y NEW Z S Z=E D  S:Y<0 Y="" S E=Z
 . NEW A,C,L,M,N,O,P,R,S,V,%
 . S L=Y
 . I X["AREA" NEW X S E=E_" (Add Area) " D ADDAREA Q
 . I X["SU" NEW X S E=E_" (Add SU) " D ADDSU Q
 . I X["CTY" NEW X S E=E_" (Add County) " D ADDCNTY Q
 .Q
 D:'Y RSLT($J("",5)_E(0)_$P(@(X_"0)"),U)_" DOES NOT EXIST => "_%)
 Q +Y
DIK NEW A,C,E,L,M,N,O,P,R,S,T D ^DIK K 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 K DIC Q
MODOK D RSLT($J("",5)_"Changed : "_L) Q
RSLT(%) S ^(0)=$G(^TMP("AUM6108",$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)
 ;
 ; -----------------------------------------------------
 ;
AREANEW ;
 S E="New Area Codes"
 D RSLT(E)
 F T=1:1 S L=$T(AREANEW+T^AUM6108A) Q:$P(L,";",3)="END"  D ADDAREA
 Q
 ;
ADDAREA ; PROGRAMMER NOTE:  This s/r is required for every patch.
 S L=$P(L,";;",2),A=$P(L,U),N=$P(L,U,2),R=$P(L,U,3),C=$P(L,U,4),L=A_" "_N_" "_R_" "_C
 I $D(^AUTTAREA("B",N)) D RSLT($J("",5)_E(1)_"NAME EXISTS => "_N) Q
 I $D(^AUTTAREA("C",A)) D RSLT($J("",5)_E(1)_"CODE EXISTS => "_A) Q
 S DLAYGO=9999999.21,DIC="^AUTTAREA(",X=N,DIC("DR")=".02///"_A_";.03///"_R_";.04///"_C
 D FILE,ADDFAIL:Y<0,ADDOK:Y>0
 KILL DLAYGO
 Q
 ;
 ; -----------------------------------------------------
 ;
ADDCNTY ; PROGRAMMER NOTE:  This s/r is required for every patch.
 S L=$P(L,";;",2),S=$P(L,U),C=$P(L,U,2),N=$P(L,U,3),L=S_" "_C_" "_N
 I $D(^AUTTCTY("C",S_C)) D RSLT($J("",5)_E(1)_"CODE EXISTS => "_S_C) Q
 S P("S")=$$IEN("^DIC(5,",S)
 Q:'P("S")
 S DIC="^AUTTCTY(",X=N,DIC("DR")=".02////"_P("S")_";.03///"_C
 D FILE,ADDFAIL:Y<0,ADDOK:Y>0
 Q
 ;
 ; -----------------------------------------------------
 ;
SUNEW ;
 S E="New Service Unit Codes, Section VIII-B"
 D RSLT(E)
 D RSLT($J("",13)_"AA SU NAME")
 D RSLT($J("",13)_"-- -- ----")
 F T=1:1 S L=$T(SUNEW+T^AUM6108A) Q:$P(L,";",3)="END"  D ADDSU
 Q
 ;
ADDSU ; PROGRAMMER NOTE:  This s/r is required for every patch.
 S L=$P(L,";;",2),A=$P(L,U),S=$P(L,U,2),N=$P(L,U,3),L=A_" "_S_" "_N
 I $D(^AUTTSU("C",A_S)) D RSLT($J("",5)_E(1)_"ASU EXISTS => "_A_S) Q
 S P=$$IEN("^AUTTAREA(",A)
 Q:'P
 S DLAYGO=9999999.22,DIC="^AUTTSU(",X=N,DIC("DR")=".02////"_P_";.03///"_S
 D FILE,ADDFAIL:Y<0,ADDOK:Y>0
 KILL DLAYGO
 Q
 ;
SUMOD ;
 S E="Service Unit Code Changes, Section VIII-B"
 D RSLT(E)
 D RSLT($J("",15)_"AA SU NAME")
 D RSLT($J("",15)_"-- -- ----")
 F T=1:2 S L=$T(SUMOD+T^AUM6108A) Q:$P(L,";",3)="END"  S L("TO")=$T(SUMOD+T+1^AUM6108A) D
 . S L=$P(L,U,2,99),A=$P(L,U),S=$P(L,U,2),N=$P(L,U,3)
 . S P=$O(^AUTTSU("C",A_S,0))
 . S L=$P(L("TO"),U,2,99),A=$P(L,U),S=$P(L,U,2),N=$P(L,U,3)
 . I 'P S P=$O(^AUTTSU("C",A_S,0)) I 'P S L=";;"_L D ADDSU Q
 . S L=A_" "_S_" "_N
 . S P("A")=$$IEN("^AUTTAREA(",A)
 . Q:'P("A")
 . S DIE="^AUTTSU(",DA=P,DR=".01///"_N_";.02////"_P("A")_";.03///"_S
 . D DIE
 . I $D(Y) D RSLT(E(0)_E_" : EDIT SERVICE UNIT FAILED => "_L) Q
 . D MODOK
 .Q
 ;
 Q
 ;
 ; -----------------------------------------------------
 ;
LOCNEW ;
 S E="New Location Codes, Section VIII-C"
 D RSLT(E)
 D RSLT($J("",13)_"AA SU FA NAME"_$J("",28)_"PSEUDO")
 D RSLT($J("",13)_"-- -- -- ----"_$J("",28)_"------")
 F T=1:1 S L=$T(LOCNEW+T^AUM6108A) Q:$P(L,";",3)="END"  D ADDLOC
 Q
 ;
ADDLOC ;
 S L=$P(L,";;",2),A=$P(L,U),S=$P(L,U,2),F=$P(L,U,3),N=$P(L,U,4),P=$P(L,U,5)
 S L=A_" "_S_" "_F_" "_N_$J("",32-$L(N))_P
 S %=A_S_F,%=$O(^AUTTLOC("C",%,0))
 I % D RSLT($J("",5)_E(1)_"ASUFAC EXISTS => "_A_S_F) D  Q
 . I $P($G(^AUTTLOC(%,0)),U,21) S DIE="^AUTTLOC(",DA=%,DR=".27///@" D DIE D:$D(Y) RSLT($J("",5)_E(0)_"DELETE INACTIVE DATE FAILED => "_L) D:'$D(Y) RSLT($J("",5)_"INACTIVE DATE DELETED => "_L)
 . S %=$O(^AUTTLOC("C",A_S_F,0)),%=$P(^AUTTLOC(%,0),U)
 . I %,$D(^DIC(4,%,0)),N'=$P(^DIC(4,%,0),U) S DIE="^DIC(4,",DA=%,DR=".01///"_N D DIE D:$D(Y) RSLT($J("",5)_E(0)_"EDIT INSTITUTION FAILED => "_L) D:'$D(Y) RSLT($J("",5)_"INSTITUTION NAME UPDATED => "_L)
 . S %=$O(^AUTTLOC("C",A_S_F,0))
 . I P'=$P($G(^AUTTLOC(%,1)),U,2) S DIE="^AUTTLOC(",DA=%,DR=".31///"_P D DIE D:$D(Y) RSLT($J("",5)_E(0)_"EDIT PSEUDO PREFIX FAILED => "_L) D:'$D(Y) RSLT($J("",5)_"PSEUDO PREFIX UPDATED => "_L)
 .Q
 S P("A")=$$IEN("^AUTTAREA(",A)
 Q:'P("A")
 S P("S")=$$IEN("^AUTTSU(",A_S)
 Q:'P("S")
 F DINUM=+$P(^DIC(4,0),U,3):1 Q:'$D(^DIC(4,DINUM))&('$D(^AUTTLOC(DINUM)))  I DINUM>99999 D RSLT($J("",5)_E(0)_"DINUM FOR LOC/INSTITUTION TOO BIG. NOTIFY ISC.") Q
 Q:DINUM>99999
 S DLAYGO=4,DIC="^DIC(4,",X=N
 D FILE
 KILL DINUM,DLAYGO
 I Y<0 D RSLT($J("",5)_E(0)_"^DIC(4 ADD FAILED => "_L) Q
 S DINUM=+Y,DLAYGO=9999999.06,DIC="^AUTTLOC(",X=DINUM,DIC("DR")=".04////"_P("A")_";.05////"_P("S")_";.07///"_F_";.31///"_P
 D FILE,ADDFAIL:Y<0,ADDOK:Y>0
 KILL DINUM,DLAYGO
 Q
 ;
LOCMOD ;
 S E="Location Code Changes, Section VIII-C"
 D RSLT(E)
 D RSLT($J("",15)_"AA SU FA NAME"_$J("",28)_"PSEUDO")
 D RSLT($J("",15)_"-- -- -- ----"_$J("",28)_"------")
 F T=1:2 S L=$T(LOCMOD+T^AUM6108A) Q:$P(L,";",3)="END"  S L("TO")=$T(LOCMOD+T+1^AUM6108A) D
 . S L=$P(L,U,2,99),A=$P(L,U),S=$P(L,U,2),F=$P(L,U,3)
 . S P=$O(^AUTTLOC("C",A_S_F,0))
 . S L=$P(L("TO"),U,2,99),A=$P(L,U),S=$P(L,U,2),F=$P(L,U,3),N=$P(L,U,4)
 . I 'P S P=$O(^AUTTLOC("C",A_S_F,0)) I 'P S L=";;"_L D ADDLOC Q
 . S L=A_" "_S_" "_F_" "_N_$J("",32-$L(N))_$P(L("TO"),U,6)
 . S P("A")=$$IEN("^AUTTAREA(",A)
 . Q:'P("A")
 . S P("S")=$$IEN("^AUTTSU(",A_S)
 . Q:'P("S")
 . S DIE="^AUTTLOC(",DA=P,DR=".04////"_P("A")_";.05////"_P("S")_";.07///"_F_";.31///"_$P(L("TO"),U,6)
 . D DIE
 . I $D(Y) D RSLT($J("",5)_E(0)_"EDIT LOCATION FAILED => "_L) Q
 . S DIE="^DIC(4,",DA=$P(^AUTTLOC(P,0),U),DR=".01///"_N
 . D DIE
 . I $D(Y) D RSLT($J("",5)_E(0)_"EDIT INSTITUTION FAILED => "_L) Q
 . D MODOK
 .Q
 D DASH,RSLT($$LOCMOD^AUMXPORT("AUM6108A")_" patients marked for export because of the Location Code changes.")
 ;
 Q
 ;
 ; -----------------------------------------------------
 ;
COMMNEW ;
 S E="New Community Codes, Section V-C"
 D RSLT(E)
 D RSLT($J("",13)_"ST CT COM NAME"_$J("",28)_"AA SU")
 D RSLT($J("",13)_"-- -- --- ----"_$J("",28)_"-- --")
 F T=1:1 S L=$T(COMMNEW+T^AUM6108A) Q:$P(L,";",3)="END"  D ADDCOMM
 Q
 ;
ADDCOMM ;
 S L=$P(L,";;",2),S=$P(L,U),O=$P(L,U,2),C=$P(L,U,3),N=$P(L,U,4),A=$P(L,U,5),V=$P(L,U,6),L=S_" "_O_" "_C_" "_N_$J("",32-$L(N))_A_" "_V
 I $D(^AUTTCOM("C",S_O_C)) D RSLT($J("",5)_E(1)_"STCTYCOM CODE EXISTS => "_S_O_C) Q
 S P("O")=$$IEN^AUM61081("^AUTTCTY(",S_O)
 Q:'P("O")
 S P("A")=$$IEN^AUM61081("^AUTTAREA(",A)
 Q:'P("A")
 S P("V")=$$IEN^AUM61081("^AUTTSU(",A_V)
 Q:'P("V")
 S DLAYGO=9999999.05,DIC="^AUTTCOM(",X=N,DIC("DR")=".02////"_P("O")_";.05////"_P("V")_";.06////"_P("A")_";.07///"_C
 D FILE,ADDFAIL:Y<0,ADDOK:Y>0
 KILL DLAYGO
 Q
 ;
 ; -----------------------------------------------------
 ;
ADAADD ;
 S E="Add ADA Code"
 D RSLT(E)
 F T=1:1 S L=$T(ADAADD+T^AUM6108A) Q:$P(L,";",3)="END"  D ADDADA
 Q
 ;
ADDADA ;
 S L=$P(L,";;",2),C=$P(L,U),N=$P(L,U,2),O=$P(L,U,3),M=$P(L,U,4),R=$P(L,U,5),S=$P(L,U,6),V=$P(L,U,7),A=$P(L,U,8),L=C_" / "_N_" / "_O
 I $E(C,1,4)'=$G(AUMFLAG) KILL AUMFLAG
 Q:$G(AUMFLAG)
 I $E(C,5,7)="USE" D ADAUSE Q
 I $D(^AUTTADA("B",C)) D RSLT(E(1)_E_" : ADA CODE EXISTS => "_C) S AUMFLAG=C Q
 S %=$O(^ICD9("AB",O,0))
 I '% D RSLT(E(1)_E_" : ICD DIAGNOSIS DOES NOT EXIST => "_O) Q
 S O=%,DLAYGO=9999999.31,DIC="^AUTTADA(",X=C,DIC("DR")=".02///"_N_";.03////"_O_";.04///"_M_";.05///"_R_";.06///"_S_";.09///"_V_";8801///"_A
 D FILE,ADDFAIL:Y<0,ADDOK:Y>0
 KILL DLAYGO
 Q
 ;
ADAUSE ;
 S DA=$O(^AUTTADA("B",$E(C,1,4),0))
 I 'DA D RSLT(E(1)_E_" : ADA CODE DOES NOT EXIST TO ADD 'USE' => "_$E(C,1,4)) Q
 ;
 ; WP field must be KILL'd to ensure no duplicates if run again.
 I $E(C,8,11)="KILL" KILL ^AUTTADA(DA,11)
 ;
 ; DT must be set into the 5th piece because FM can't handle WP fields
 ; correctly.
 S DLAYGO=9999999.31,DIC="^AUTTADA("_DA_",11,",X=N,$P(^AUTTADA(DA,11,0),U,5)=DT
 D FILE,ADDFAIL:Y<0
 ;
 ; The update of the 0th node and KILL of the "B" x-ref is because FM
 ; can't handle them correctly.
 I Y>0 S Y=$O(^AUTTADA("B",$E(C,1,4),0)),$P(^AUTTADA(Y,11,0),U,5)=DT KILL ^AUTTADA(Y,11,"B")
 ;
 KILL DLAYGO
 Q
 ;
ADAMOD ;
 S E="ADA Code Changes"
 D RSLT(E)
 D RSLT($J("",15)_"FROM     TO")
 D RSLT($J("",15)_"----     ----")
 F T=1:2 S L=$T(ADAMOD+T^AUM6108A) Q:$P(L,";",3)="END"  S L("TO")=$T(ADAMOD+T+1^AUM6108A) D
 . S N=$P(L,U,3),O=$P(L,U,4)
 . S L=$P(L,U,2),L("TO")=$P(L("TO"),U,2)
 . D RSLT($J("",15)_L_"     "_L("TO"))
 . S DA=$O(^AUTTADA("B",L,0))
 . I 'DA D RSLT(L_" NOT PRESENT, "_L("TO")_" WILL BE ADDED.") Q
 . I $$VAL^XBDIQ1("^AUTTADA(",DA,.02)=N,$$VAL^XBDIQ1("^AUTTADA(",DA,.03)=O D RSLT("Previously changed") Q
 . S DIE="^AUTTADA(",DR=".01///"_L("TO"),L=L_"     "_L("TO")
 . D DIE
 . I $D(Y) D RSLT(E(0)_E_" : EDIT ADA CODE FAILED => "_L) Q
 . D MODOK
 .Q
 Q
 ;

AUM6108A
AUM6108A ; IHS/ADC/GTH - STANDARD TABLE UPDATES DATA A, 04JUN96 BANYAN ; [ 06/18/96  4:31 PM ]
 ;;96.1;TABLE MAINTENANCE;**8**;OCT 26,1995
 ;
UPDATE ;;IHS STANDARD CODE BOOK MODIFICATIONS - MAY 1996    6/4/96
 ;
SUNEW ;;A.  NEW SERVICE UNIT CODES (SECTION VIII-B): AREA^S.U.^NAME
 ;;75^86^SOUTHERN OREGON
 ;;END
 ;
LOCNEW ;;B.  NEW LOCATION CODES (SECTION VIII-C): AREA^S.U.^FAC.^NAME^PSEUDO
 ;;80^86^60^TEEN LIFE CENTER^NIZ
 ;;END
 ;
LOCMOD ;;C.  LOCATION CODE CHANGES (SECTION VIII-C): AREA^S.U.^FAC.^NAME^PSEUDO
 ;;FROM^75^82^50^COW CREEK^PRN
 ;;  TO^75^86^50^COW CREEK^PKX
 ;;FROM^75^82^51^CLUSIT TRIBAL HEALTH PROGRAMS^PAE
 ;;  TO^75^86^51^CLUSIT TRIBAL HEALTH PROGRAMS^PKY
 ;;FROM^75^82^53^COQUILLE TRIBAL HEALTH^PAK
 ;;  TO^75^86^53^COQUILLE TRIBAL HEALTH^PKZ
 ;;END
 ;
COMMNEW ;;D.  NEW COMMUNITY CODES (SECTION V-C): STATE^CNTY^COMM^NAME^AREA^S.U.
 ;;06^02^400^TOPAZ^60^69
 ;;32^03^401^GENOA^60^69
 ;;32^03^402^STATE LINE^60^69
 ;;32^03^403^ZEPHYR COVE^60^69
 ;;32^10^404^WABUSKA^60^69
 ;;32^12^405^ARMARGOSA VALLEY^60^69
 ;;32^14^406^IMLAY^60^69
 ;;32^16^407^BORDERTOWN^60^69
 ;;32^16^408^INCLINE VILLAGE^60^69
 ;;41^23^409^VALE^60^69
 ;;41^23^410^JORDAN VALLEY^60^69
 ;;41^23^411^NYSSA^60^69
 ;;END
 ;
 ;  Changes to ADA CODE authorized by Dr. Horace Whitt, via Banyan
 ;  message date stamped Monday, 20May96, @ 11:38:02 MDT, with cc
 ;  to Candace Jones.
ADAMOD ;; ADA CODE: CODE^DESCRIPTION^DIAGNOSIS ( The values for 0140 are for the NEW 0140, to determine if this has already been done. )
 ;;FROM^0140^ORAL EXAMINATION, EMERGENCY^V72.2
 ;;  TO^0114
 ;;FROM^0130
 ;;  TO^0140
 ;;FROM^0110
 ;;  TO^0150
 ;;END
 ;
ADAADD ; ADA CODE: CODE^DESCRIPTION^DIAGNOSIS^ESTIMATED MINUTES^LEVEL OF SERVICE^SYNONYM^NO OPSITE^MNEMONIC
 ;;0114^SCREENING ORAL EXAM^V72.2^1^0^SCREEN EXAM^NO OPSITE ASKED
 ;;0114USEKILL^When target groups (such as school children) are screened as
 ;;0114USE^groups to plan program activity, the code 0140 ORAL SCREENING
 ;;0114USE^may be reported using one unit per individual screened.  Oral
 ;;0114USE^screening exams may be general in nature or directed at
 ;;0114USE^specific health problems.  Screening is usually done outside
 ;;0114USE^the clinic setting and it does not include filling out an
 ;;0114USE^oral exam form (HSA 42-1).  The 0110 or 0120 should be used
 ;;0114USE^when such examination records are used.
 ;;0140^ORAL EXAMINATION, EMERGENCY^V72.2^5^1^EMERG. EXAM^NO OPSITE ASKED^EOE
 ;;0140USEKILL^Examination of the tissues of a portion of the oral cavity
 ;;0140USE^which involves a patient's chief complaint.  A medical
 ;;0140USE^history and limited charting to support a plan for treatment
 ;;0140USE^to relieve the complaint or symptoms are necessary to
 ;;0140USE^document this procedure (Includes no plan for routine needs).
 ;;0140USE^This code may be reported as often as necessary for a patient
 ;;0140USE^who needs emergency care.
 ;;0140USE^  
 ;;0140USE^The 0130 code can provide a general estimate of emergency
 ;;0140USE^visits in a practice.  However, if local program managers
 ;;0140USE^desire more precise tracking of emergency visits, it is
 ;;0140USE^recommended the 9170 code (emergency encounter) be reported
 ;;0140USE^in addition to the type of examination code used for the
 ;;0140USE^visit.
 ;;0150^ORAL EXAMINATION, INITIAL^V72.2^15^3^ORAL EXAM INIT.^NO OPSITE ASKED^IOE
 ;;0150USEKILL^This code includes visual and tactile scrutiny of the tissues
 ;;0150USE^of and surrounding the oral cavity, including a medical and
 ;;0150USE^dental history, charting and the formulation of a plan of
 ;;0150USE^treatment on the patient's record.  An Initial Oral
 ;;0150USE^Examination will be provided to the patient for whom routine
 ;;0150USE^care has not been previously planned in this practice.
 ;;END
 ;

AUM6108M
AUM6108M ; IHS/ADC/GTH - BACKGROUND VALUES FOR STANDARD TABLE UPDATES, 04JUN96 BANYAN ; [ 06/18/96  10:40 AM ]
 ;;96.1;TABLE MAINTENANCE;**8**;OCT 26,1995
 ;
AREA ; CODE^NAME^PREFIX/REGION^CAN PREFIX
60 ;;60^PHOENIX^X^J40
75 ;;75^PORTLAND TRIBE/638^P^J64
80 ;;80^NAVAJO^N^J54
 ;
SU ; AREA^SU^NAME
6069 ;;60^69^SCHURZ
8086 ;;80^86^SHIPROCK
 ;
COUNTY ; STATE^COUNTY^NAME
0602 ;;06^02^ALPINE
3203 ;;32^03^DOUGLAS
3210 ;;32^10^LYON
3212 ;;32^12^NYE
3214 ;;32^14^PERSHING
3216 ;;32^16^WASHOE
4123 ;;41^23^MALHEUR
 ;