10:02 AM  21-MAY-97
AUM v 97.1, Patch 5, SCB Updates from 08May97 Banyan, etc.  Restore 7 routines and DO ^AUM7105.
A9AUM5
A9AUM5 ; IHS/ADC/GTH - STANDARD TABLE UPDATES, 08MAY97 BANYAN, RPI ; [ 05/21/97  10:02 AM ]
 ;;97.1;TABLE MAINTENANCE;**5**;DEC 10,1996
 ;
 D START^AUM7105
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 ;     
 ;;A9AUM4
 ;;AUM7105
 ;;AUM71051
 ;;AUM71052
 ;;AUM7105A
 ;;AUM7105B
 ;;AUM7105M

AUM7105
AUM7105 ; IHS/ADC/GTH - STANDARD TABLE UPDATES, 08MAY97 BANYAN ; [ 05/21/97  10:02 AM ]
 ;;97.1;TABLE MAINTENANCE;**5**;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^AUM7105(""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 AUM7105
 S X=+Y
 D H^%DTC
 S ZTDTH=%H_","_%T
 S ZTRTN="START^AUM7105",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("AUM7105",$J)
 D START^AUM71051,START^AUM71052
 S XMSUB=$P($P($T(+1),";",2)," ",4,99),XMDUZ=$S($G(DUZ):DUZ,1:.5),XMTEXT="^TMP(""AUM7105"",$J,",XMY(1)="",XMY(DUZ)=""
 D ^XMD
 KILL ^TMP("AUM7105",$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^A9AUM5
 Q
 ;
INTRO ;
 ;;This updates standard tables according to the changes specified in
 ;;the Banyan message time stamped 08May97@11:54:46 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
 ;

AUM71051
AUM71051 ; IHS/ADC/GTH - STANDARD TABLE UPDATES, 08MAY97 BANYAN ; [ 05/21/97  10:02 AM ]
 ;;97.1;TABLE MAINTENANCE;**5**;DEC 10,1996
 ;
 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("",5)_$P($T(UPDATE^AUM7105A),";",3))
 D DASH,LOCNEW,DASH,LOCMOD,DASH,COMMNEW,DASH,CSCINAC,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_")")) KILL DA,DIE,DR Q
E(L) Q $P($P($T(@L^AUM7105A),";",3),":",1)
IEN(X,%,Y) ;
 S Y=$O(@(X_"""C"",%,0)"))
 I 'Y S Y=$$VAL^AUM7105M(X,%) 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 D RSLT("(Add Missing Area)") D ADDAREA D RSLT("(END Add Missing Area)") Q
 . I X["SU" NEW X D RSLT("(Add Missing SU)") D ADDSU D RSLT("(END Add Missing SU)") Q
 . I X["CTY" NEW X D RSLT("(Add Missing County)") D ADDCNTY D RSLT("(END Add Missing County)") 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 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
MODOK D RSLT($J("",5)_"Changed : "_L) Q
RSLT(%) S ^(0)=$G(^TMP("AUM7105",$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)
 ;
 ; -----------------------------------------------------
 ;
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
 ;
 ; -----------------------------------------------------
 ;
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
 ;
 ; -----------------------------------------------------
 ;
LOCNEW ;
 S E=$$E("LOCNEW")
 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^AUM7105A) 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=$$E("LOCMOD")
 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^AUM7105A) Q:$P(L,";",3)="END"  S L("TO")=$T(LOCMOD+T+1^AUM7105A) 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
 ; Locations were name changes, only.  Following line commented.
 ; D DASH,RSLT($$LOCMOD^AUMXPORT("AUM7105A")_" patients marked for export because of the Location Code changes.")
 ;
 Q
 ;
 ; -----------------------------------------------------
 ;
COMMNEW ;
 NEW AUMRTN
 S E=$$E("COMMNEW")
 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^AUM7105A) 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^AUM71051("^AUTTCTY(",S_O)
 Q:'P("O")
 S P("A")=$$IEN^AUM71051("^AUTTAREA(",A)
 Q:'P("A")
 S P("V")=$$IEN^AUM71051("^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
 ;
 ; -----------------------------------------------------
 ;
CSCINAC ;
 S E=$$E("CSCINAC")
 D RSLT(E)
 D RSLT($J("",11)_"CODE NAME")
 D RSLT($J("",11)_"---- ----")
 F T=1:1 S L=$T(CSCINAC+T^AUM7105A) Q:$P(L,";",3)="END"  D INACCSC
 Q
 ;
INACCSC ;
 S L=$P(L,";;",2),C=$P(L,U),N=$P(L,U,2),L=C_" "_N
 S DA=$O(^DIC(45.7,"CIHS",C,0))
 I 'DA D RSLT($J("",5)_"CODE NOT FOUND (That's OK) => "_C) Q
 S DIE="^DIC(45.7,",DR=".01///x<Inactivated>"
 D DIE
 I $D(Y) D RSLT($J("",5)_E(0)_"Edit of "_L_" Failed.") Q
 D RSLT($J("",13)_L_" (Marked <Inactivated>)")
 Q
 ;
 ; -----------------------------------------------------
 ;

AUM71052
AUM71052 ; IHS/ADC/GTH - STANDARD TABLE UPDATES, 08MAY97 BANYAN ; [ 05/21/97  10:02 AM ]
 ;;97.1;TABLE MAINTENANCE;**5**;DEC 10,1996
 ;
 Q
 ;
START ;EP
 ;
 NEW A,AUMCNTR,C,DIC,DIE,DLAYGO,DR,E,L,M,N,O,P,R,S,T
 ;
 S E(0)="ERROR : ",E(1)="NOT ADDED : "
 ;
 S (AUMCNTR("EXIST"),AUMCNTR("PROCESSED"),AUMCNTR("ADDED"),AUMCNTR("FAILED"))=0
 D DASH,CLINNEW,DASH
 D RSLT($J("",5)_"              Clinics processed..."_$J($FN(AUMCNTR("PROCESSED"),","),6))
 D RSLT($J("",5)_"Clinics already on your machine..."_$J($FN(AUMCNTR("EXIST"),","),6))
 D RSLT($J("",5)_"                  Clinics added..."_$J($FN(AUMCNTR("ADDED"),","),6))
 D RSLT($J("",5)_"     Clinics that failed to add..."_$J($FN(AUMCNTR("FAILED"),","),6))
 ;
 S (AUMCNTR("EXIST"),AUMCNTR("PROCESSED"),AUMCNTR("ADDED"),AUMCNTR("FAILED"))=0
 D DASH,PCLASNEW,DASH
 D RSLT($J("",5)_"              Provider Classes processed..."_$J($FN(AUMCNTR("PROCESSED"),","),6))
 D RSLT($J("",5)_"Provider Classes already on your machine..."_$J($FN(AUMCNTR("EXIST"),","),6))
 D RSLT($J("",5)_"                  Provider Classes added..."_$J($FN(AUMCNTR("ADDED"),","),6))
 D RSLT($J("",5)_"     Provider Classes that failed to add..."_$J($FN(AUMCNTR("FAILED"),","),6))
 ;
 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_")")) KILL DA,DIE,DR Q
E(L) Q $P($P($T(@L^AUM7105B),";",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
MODOK D RSLT($J("",5)_"Changed : "_L) Q
RSLT(%) S ^(0)=$G(^TMP("AUM7105",$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)
 ;
 ; -----------------------------------------------------
 ;
CLINNEW ;
 S E=$$E("CLINNEW")
 D RSLT(E)
 D RSLT($J("",11)_"CODE NAME")
 D RSLT($J("",11)_"---- ----")
 F T=1:1 S L=$T(CLINNEW+T^AUM7105B) Q:$P(L,";",3)="END"  D ADDCLIN
 KILL DLAYGO
 Q
 ;
ADDCLIN ;
 W:'$D(ZTQUEUED) "."
 S AUMCNTR("PROCESSED")=AUMCNTR("PROCESSED")+1
 S L=$P(L,";;",2),C=$P(L,U),N=$P(L,U,2),L=C_" "_N
 I $D(^DIC(40.7,"C",C)) S AUMCNTR("EXIST")=AUMCNTR("EXIST")+1 Q
 S DLAYGO=40.7,DIC="^DIC(40.7,",X=N,DIC("DR")="1///"_C
 D FILE
 I Y<0 D ADDFAIL S AUMCNTR("FAILED")=AUMCNTR("FAILED")+1 Q
 I Y>0 D ADDOK S AUMCNTR("ADDED")=AUMCNTR("ADDED")+1 Q
 Q
 ;
 ; -----------------------------------------------------
 ;
PCLASNEW ;
 S E=$$E("PCLASNEW")
 D RSLT(E)
 D RSLT($J("",11)_"CODE NAME"_$J("",28)_"ABRV.")
 D RSLT($J("",11)_"---- ----"_$J("",28)_"-----")
 F T=1:1 S L=$T(PCLASNEW+T^AUM7105B) Q:$P(L,";",3)="END"  D ADDPCLAS
 KILL DLAYGO
 Q
 ;
ADDPCLAS ;
 W:'$D(ZTQUEUED) "."
 S AUMCNTR("PROCESSED")=AUMCNTR("PROCESSED")+1
 S L=$P(L,";;",2),C=$P(L,U),N=$P(L,U,2),A=$P(L,U,3),L=C_" "_N_$J("",(32-$L(N)))_A
 I $D(^DIC(7,"D",C)) S AUMCNTR("EXIST")=AUMCNTR("EXIST")+1 Q
 S DLAYGO=7,DIC="^DIC(7,",X=N,DIC("DR")="1///"_A_";9999999.01///"_C
 D FILE
 I Y<0 D ADDFAIL S AUMCNTR("FAILED")=AUMCNTR("FAILED")+1 Q
 I Y>0 D ADDOK S AUMCNTR("ADDED")=AUMCNTR("ADDED")+1 Q
 Q
 ;
 ; -----------------------------------------------------

AUM7105A
AUM7105A ; IHS/ADC/GTH - STANDARD TABLE UPDATES, 08MAY97 BANYAN ; [ 05/21/97  10:02 AM ]
 ;;97.1;TABLE MAINTENANCE;**5**;DEC 10,1996
 ;
UPDATE ;;IHS STANDARD CODE BOOK MODIFICATIONS - APRIL 1997  5/8/97
 ;
LOCNEW ;;A.  NEW FACILITY CODES (SECTION VIII-C): AREA^S.U.^FAC^NAME^PSEUDO
 ;;18^23^37^HURON HL^DBL
 ;;30^31^12^ANCHORAGE PRIMARY CARE CENTER^ABV
 ;;END
 ;
LOCMOD ;;B.  FACILITY CODE CHANGES  (SECTION VIII-C): AREA^S.U.^FAC^NAME^PSEUDO
 ;;FROM^30^32^01^BARROW PHS HOSPITAL^ABZ
 ;;  TO^30^32^01^SAMUEL SIMMONDS MEM HOSP^ABZ
 ;;FROM^10^19^01^QUENTIN M BURDICK MEM HLTH FAC^CKA
 ;;  TO^10^19^01^QUENTIN N BURDICK MEM HLTH FAC^CKA
 ;;END
 ;
COMMNEW ;;C.  NEW COMMUNITY CODES  (SECTION V-C): STATE^CNTY^COMM^NAME^AREA^S.U.
 ;;19^78^143^COUNCIL BLUFFS^15^37
 ;;19^78^144^MACEDONIA^15^37
 ;;19^78^145^TREYNOR^15^37
 ;;19^78^146^CARSON^15^37
 ;;19^78^147^OAKLAND^15^37
 ;;19^78^148^NEOLA^15^37
 ;;19^78^149^MCCLELLAND^15^37
 ;;19^78^150^WESTON^15^37
 ;;19^78^151^CRESCENT^15^37
 ;;19^78^152^UNDERWOOD^15^37
 ;;19^78^153^HANCOCK^15^37
 ;;19^78^154^AVOCA^15^37
 ;;19^78^155^MINDEN^15^37
 ;;19^78^156^WALNUT^15^37
 ;;27^61^410^GLENWOOD^11^00
 ;;27^86^463^BUFFALO^11^00
 ;;31^40^110^GRAND ISLAND^15^37
 ;;31^40^111^CAIRO^15^37
 ;;31^40^112^WOOD RIVER^15^37
 ;;31^40^113^DONIPHAN^15^37
 ;;31^40^114^ALDA^15^37
 ;;31^45^115^O'NEILL^15^37
 ;;31^45^116^EMMET^15^37
 ;;31^45^117^ATKINSON^15^37
 ;;31^45^118^STUART^15^37
 ;;31^45^119^AMELIA^15^37
 ;;31^45^120^CHAMBERS^15^37
 ;;31^45^121^INMAN^15^37
 ;;31^45^122^PAGE^15^37
 ;;31^45^123^EWING^15^37
 ;;31^60^124^TILDON^15^37
 ;;31^71^125^LINDSAY^15^37
 ;;31^71^126^ST. BERNARD^15^37
 ;;31^71^127^CORNLEA^15^37
 ;;31^71^128^CRESTON^15^37
 ;;31^71^129^HUMPHREY^15^37
 ;;31^71^130^TARNOV^15^37
 ;;31^71^131^COLUMBUS^15^37
 ;;31^71^132^PLATTE CENTER^15^37
 ;;31^71^133^MONROE^15^37
 ;;31^71^134^DUNCAN^15^37
 ;;31^71^135^NEWMAN GROVE^15^37
 ;;31^77^136^CHALCO^15^37
 ;;31^77^137^PAPILLION^15^37
 ;;31^77^138^GRETNA^15^37
 ;;31^77^139^SPRINGFIELD^15^37
 ;;31^77^140^BELLEVUE^15^37
 ;;31^77^141^RICHFIELD^15^37
 ;;31^77^142^LAVISTA^15^37
 ;;31^84^157^STANTON^15^37
 ;;31^84^158^PILGER^15^37
 ;;END
 ;
CSCINAC ;;D.  INACTIVATED CLINICAL SERVICE CODE  (SECTION X): CODE^NAME
 ;;99^OTHER
 ;;END
 ;

AUM7105B
AUM7105B ; IHS/ADC/GTH - STANDARD TABLE UPDATES, 08MAY97 BANYAN ; [ 05/21/97  10:02 AM ]
 ;;97.1;TABLE MAINTENANCE;**5**;DEC 10,1996
 ;
 ;
CLINNEW ;;XIX. TYPE OF CLINIC CODES - ANNUAL COMPREHENSIVE DISTRIBUTION: CODE^NAME
 ;;01^GENERAL
 ;;02^CARDIAC
 ;;03^CHEST AND TB
 ;;04^CRIPPLED CHILDREN
 ;;05^DERMATOLOGY
 ;;06^DIABETIC
 ;;07^ENT
 ;;08^FAMILY PLANNING
 ;;09^GROUPED SERVICES
 ;;10^GYNECOLOGY
 ;;11^HOME CARE
 ;;12^IMMUNIZATION
 ;;13^INTERNAL MEDICINE
 ;;14^MENTAL HEALTH (PSYCHIATRY)
 ;;15^OBESITY
 ;;16^OBSTETRICS
 ;;17^OPHTHALMOLOGY
 ;;18^OPTOMETRY
 ;;19^ORTHOPEDIC
 ;;20^PEDIATRIC
 ;;21^REHABILITATION
 ;;22^SCHOOL
 ;;23^SURGICAL
 ;;24^WELL CHILD
 ;;25^OTHER
 ;;26^HIGH RISK
 ;;27^GENERAL PREVENTIVE
 ;;28^FAMILY PRACTICE
 ;;29^PLASTIC SURGERY
 ;;30^EMERGENCY MEDICINE
 ;;31^HYPERTENSIVE
 ;;32^POSTPARTUM
 ;;33^INHALATION THERAPY
 ;;34^PHYSICAL THERAPY
 ;;35^AUDIOLOGY
 ;;36^W. I. C.
 ;;37^NEUROLOGY
 ;;38^RHEUMATOLOGY
 ;;39^PHARMACY
 ;;40^INFANT STIMULATION
 ;;41^INDIRECT
 ;;42^MAIL
 ;;43^ALCOHOL AND SUBSTANCE
 ;;44^DAY SURGERY
 ;;45^PHN CLINIC VISIT
 ;;46^NIH CLINIC
 ;;47^FETAL ALCOHOL SYNDROME
 ;;48^MEDICAL SOCIAL SERVICES
 ;;49^NEPHROLOGY
 ;;50^CHRONIC DISEASE
 ;;51^TELEPHONE CALL
 ;;52^CHART REV/REC MOD
 ;;53^FOLLOW-UP LETTER
 ;;54^RADIO CALL
 ;;55^CAST ROOM
 ;;56^DENTAL
 ;;57^EPSDT
 ;;58^CANCER SCREENING
 ;;59^VENEREAL DISEASE
 ;;60^EDUCATION CLASSES
 ;;61^DEVEL. ASSESSMENT
 ;;62^CANCER CHEMOTHERAPY
 ;;63^RADIOLOGY
 ;;64^RETINOPATHY
 ;;65^PODIATRY
 ;;66^ULTRASOUND
 ;;67^DIETARY
 ;;68^EMPLOYEE HEALTH UN
 ;;69^ENDOCRINOLOGY
 ;;70^WOMEN'S HEALTH SCREENING
 ;;71^COMPUTED TOMOGRAPHY
 ;;72^MAMMOGRAPHY
 ;;73^GENETICS
 ;;74^SPEECH PATHOLOGY
 ;;75^UROLOGY
 ;;76^LABORATORY SERVICES
 ;;77^CASE MANAGEMENT SERVICES
 ;;78^OTC MEDICATIONS
 ;;79^TRIAGE
 ;;80^URGENT CARE
 ;;81^MEN'S HEALTH SCREENING
 ;;99^THIRD PARTY DENTAL
 ;;END
 ;
PCLASNEW ;;XV. SERVICES RENDERED BY (PROVIDER CLASS) - ANN. COMP. DISTRIBUTION: CODE^NAME^ABBREVIATION
 ;;00^PHYSICIAN^MD
 ;;01^CLINIC RN^RN
 ;;02^ENVIRONMENTAL HEALTH^SAN
 ;;03^HEALTH AIDE^HA
 ;;04^HEALTH EDUCATOR^HE
 ;;05^LICENSED PRACTICAL NURSE^LPN
 ;;06^MEDICAL SOCIAL WORKER^MSW
 ;;07^NUTRITIONIST^NTR
 ;;08^OPTOMETRIST^OPT
 ;;09^PHARMACIST^PHR
 ;;10^PHYSICAL THERAPIST^PT
 ;;11^PHYSICIAN ASSISTANT^CHM
 ;;12^PSYCHOLOGIST^PSY
 ;;13^PUBLIC HEALTH NURSE^CHN
 ;;14^SCHOOL NURSE^SRN
 ;;15^OTHER^OTH
 ;;16^PEDIATRIC NURSE PRACTITIONER^PNP
 ;;17^NURSE MIDWIFE^MID
 ;;18^CONTRACT PHYSICIAN^CPH
 ;;19^MENTAL HEALTH^MHW
 ;;20^MEDICAL STUDENT^MST
 ;;21^NURSE PRACTICIONER^NPR
 ;;22^NURSE ASSISTANT^NAS
 ;;23^LABORATORY TECHNICIAN^LAB
 ;;24^CONTRACT OPTOMETRTIST^COP
 ;;25^CONTRACT PODIATRIST^CPO
 ;;26^INHALATION THERAPIST^ITH
 ;;27^STUDENT NURSES^STN
 ;;28^AUDIOLOGIST^AUD
 ;;29^DIETICIAN^DIE
 ;;30^PHARMACY PRACTICIONERS^PHP
 ;;31^OPTOMETRIC ASSISTANT^OPA
 ;;32^CONTRACT PUBLIC HEALTH NURSE^CPN
 ;;33^PODIATRIST^PDD
 ;;34^TRIBAL/CONTRACT NUTRITIONIST^TCN
 ;;35^OUTREACH WORKER^OUT
 ;;36^EYE CARE SPECIALIST^EYE
 ;;37^FAMILY PLANNING COUNSELOR^FPC
 ;;38^EMT/PARAMEDIC^EMT
 ;;39^SPEECH THERAPIST^SPT
 ;;40^AMBULANCE DRIVER^AMBD
 ;;41^CONTRACT OB/GYN^COB
 ;;42^SPEECH/LANGUAGE PATH^SLP
 ;;43^AUDIOMETRIC TECHNICIAN^SMT
 ;;44^TRIBAL PHYSICIAN^TP
 ;;45^OSTEOPATHIC MEDICINE^DO
 ;;46^DENTAL HYGIENIST^DHY
 ;;47^CRNA^CRN
 ;;48^ALCOHOLISM COUNSELOR^ALC
 ;;49^CONTRACT PSYCHIATRIST^CPY
 ;;50^CONTRACT PSYCHOLOGIST^CPC
 ;;51^PAPAGO NUTRITION PROGRAM^NTR
 ;;52^DENTIST^DEN
 ;;53^COMMUNITY HEALTH REPRESENTATIV^CHR
 ;;54^DENTAL ASSISTANT (PRENATAL)^DAP
 ;;55^DISEASE CONTROL PROGRAM^DCP
 ;;56^HEALTH RECORDS^HR
 ;;57^ADMINISTRATIVE^ADM
 ;;59^X-RAY TECHNICIAN^XRY
 ;;60^DENTAL ASSISTANT^DA
 ;;61^DENTAL LAB^DL
 ;;62^LICENSED MEDICAL SOCIAL WORKER^LMSW
 ;;63^CONTRACT SOCIAL WORKER^CSW
 ;;64^NEPHROLOGIST^NEPH
 ;;65^OPTOMETRY STUDENT^OPTOM
 ;;66^CASE MANAGERS^CM
 ;;70^CARDIOLOGIST^CAR
 ;;71^INTERNAL MEDICINE^INT
 ;;72^OB/GYN^GYN
 ;;73^ORTHOPEDIST^ORT
 ;;74^OTOLARYNGOL^OTO
 ;;75^PEDIATRICIAN^PED
 ;;76^RADIOLOGIST^RAD
 ;;77^SURGEON^SUR
 ;;78^UROLOGIST^URO
 ;;79^OPHTHALMOLOGIST^OPH
 ;;80^FAMILY PRACTICE^FP
 ;;81^PSYCHIATRIST^PSC
 ;;82^ANESTHESIOLOGIST^ANE
 ;;83^PATHOLOGIST^PAT
 ;;85^NEUROLOGIST^NEU
 ;;86^DERMATOLOGIST^DER
 ;;88^CODING/DATA ENTRY^CDE
 ;;97^NUTRITION TECHNICIAN^NTC
 ;;98^FOOD SERVICE SUPERVISOR^FSS
 ;;99^DIETETIC TECHNICIAN^DTC
 ;;END
 ;

AUM7105M
AUM7105M ; IHS/ADC/GTH -  BACKGROUND VALUES FOR STANDARD TABLE UPDATES, 08MAY97 BANYAN ; [ 05/21/97  10:02 AM ]
 ;;97.1;TABLE MAINTENANCE;**5**;DEC 10,1996
 ;
VAL(X,%,Y) ;EP - return background info.
 I X["AREA" Q $T(@%)
 S Y=0
 I X["SU" D  Q Y
 . NEW C,T
 . F C=1:1 S T=$P($T(SU+C),";",3) Q:T="END"  I $P(T,U,1,2)=($E(%,1,2)_U_$E(%,3,4)) S Y=1_";;"_T Q
 .Q
 I '(X["CTY") Q 0
 NEW C,T
 F C=1:1 S T=$P($T(COUNTY+C),";",3) Q:T="END"  I $P(T,U,1,2)=($E(%,1,2)_U_$E(%,3,4)) S Y=1_";;"_T Q
 Q Y
 ;
AREA ; CODE^NAME^PREFIX/REGION^CAN PREFIX
10 ;;10^ABERDEEN^C^J45
11 ;;11^BEMIDJI^D^J46
15 ;;15^ABERDEEN TRIBE/638^C^J45
18 ;;18^BEMIDJI NON-IHS^D^J46
30 ;;30^ALASKA^A^J59
 ;;END
 ;
SU ; AREA^SU^NAME
 ;;10^19^TURTLE MOUNT
 ;;11^00^NON SERVICE UNIT
 ;;15^37^NORTHERN PONCA
 ;;18^23^EASTERN MICHIGAN
 ;;30^31^ANCHORAGE
 ;;30^32^BARROW
 ;;END
 ;
COUNTY ; STATE^COUNTY^NAME
 ;;19^78^POTTAWATTAMI
 ;;27^61^POPE
 ;;27^86^WRIGHT
 ;;31^40^HALL
 ;;31^45^HOLT
 ;;31^60^MADISON
 ;;31^71^PLATTE
 ;;31^77^SARPY
 ;;31^84^STANTON
 ;;END
 ;