3:42 PM  17-JUN-99
AUM v 99.1, Patch 6, SCB Updates from 1999May24 message and Pt Educ Protocols.  Restore 5 routines and DO ^AUM9106.
A9AUM6
A9AUM6 ; IHS/ASDST/GTH - STANDARD TABLE UPDATES, 1999MAY24, RPI ; [ 06/17/1999   3:41 PM ]
 ;;99.1;TABLE MAINTENANCE;**6**;NOV 6,1998
 ;
 D START^AUM9106
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 ;     
 ;;A9AUM5
 ;;AUM9106
 ;;AUM91061
 ;;AUM9106A
 ;;AUM9106M

AUM9106
AUM9106 ; IHS/ASDST/GTH - STANDARD TABLE UPDATES, 1999MAY24 ; [ 06/17/1999   3:41 PM ]
 ;;99.1;TABLE MAINTENANCE;**6**;NOV 6,1998
 ;
 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^AUM9106(""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 HELP("Q2") G AUM9106
 S X=+Y
 D H^%DTC
 S ZTDTH=%H_","_%T
 S ZTRTN="START^AUM9106",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("AUM9106",$J)
 D START^AUM91061
 S XMSUB=$P($P($T(+1),";",2)," ",4,99),XMDUZ=$S($G(DUZ):DUZ,1:.5),XMTEXT="^TMP(""AUM9106"",$J,",XMY(1)="",XMY(DUZ)=""
 D ^XMD
 KILL ^TMP("AUM9106",$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^A9AUM6
 Q
 ;
INTRO ;
 ;;This updates standard tables according to the changes specified in
 ;;the message time stamped 24May99 4:07PM.  Please consult that message,
 ;;and the mail message produced by this update.                       
 ;;  
 ;;Also include are additions to the EDUCATION TOPICS file specified
 ;;by the committee for Patient Education protocols in their May 1999
 ;;meeting in San Antonio. Please see the notes file for further
 ;;documentation.
 ;;###
 ;
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
 ;

AUM91061
AUM91061 ; IHS/ASDST/GTH - STANDARD TABLE UPDATES, 1999MAY24 ; [ 06/17/1999   3:41 PM ]
 ;;99.1;TABLE MAINTENANCE;**6**;NOV 6,1998
 ;
 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^AUM9106A),";",3))
 D DASH,LOCNEW,DASH,LOCMOD,DASH,LOCINACT,DASH,COMMNEW,DASH,EDTADD,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^AUM9106A),";",3),":",1)
IEN(X,%,Y) ;
 S Y=$O(@(X_"""C"",%,0)"))
 I 'Y S Y=$$VAL^AUM9106M(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("AUM9106",$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
 ;
 ; -----------------------------------------------------
 ;
SUNEW ;
 S E=$$E("SUNEW")
 D RSLT(E)
 D RSLT($J("",13)_"AA SU NAME")
 D RSLT($J("",13)_"-- -- ----")
 F T=1:1 S L=$T(SUNEW+T^AUM9106A) 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
 ;
 ; -----------------------------------------------------
 ;
COMMNEW ;
 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^AUM9106A) 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^AUM91061("^AUTTCTY(",S_O)
 Q:'P("O")
 S P("A")=$$IEN^AUM91061("^AUTTAREA(",A)
 Q:'P("A")
 S P("V")=$$IEN^AUM91061("^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
 ;
 ; -----------------------------------------------------
 ;
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^AUM9106A) 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^AUM9106A) Q:$P(L,";",3)="END"  S L("TO")=$T(LOCMOD+T+1^AUM9106A) 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
 ; If Locations were name changes, only, following line commented.
 ; D DASH,RSLT($$LOCMOD^AUMXPORT("AUM9106A")_" patients marked for export because of the Location Code changes.")
 ;
 Q
 ;
 ; -----------------------------------------------------
 ;
LOCINACT ;
 S E=$$E("LOCINACT")
 D RSLT(E)
 D RSLT($J("",20)_"AA SU FA NAME")
 D RSLT($J("",20)_"-- -- -- ----")
 F T=1:1 S L=$T(LOCINACT+T^AUM9106A) Q:$P(L,";",3)="END"  D
 . 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_" "_P
 . S %=A_S_F,%=$O(^AUTTLOC("C",%,0))
 . I '% D RSLT($J("",5)_"ASUFAC "_A_S_F_" not found (OK).") Q
 . S DIE="^AUTTLOC(",DA=%,DR=".27////"_DT
 . D DIE
 . I $D(Y) D RSLT($J("",5)_E(0)_"EDIT INACTIVE DATE FAILED => "_L) I 1
 . E  D RSLT($J("",5)_"INACTIVATED => "_L)
 .Q
 Q
 ;
 ; -----------------------------------------------------
 ;
EDTADD ;
 D RSLT($$E("EDTADD"))
 D RSLT($J("",13)_"NAME"_$J("",28)_"MNEMONIC")
 D RSLT($J("",13)_$$REPEAT^XLFSTR("-",30)_"  --------")
 F T=1:1 S L=$T(EDTADD+T^AUM9106A) Q:$P(L,";",3)="END"  D ADDEDT
 KILL DLAYGO
 Q
 ;
ADDEDT ;
 S L=$P(L,";;",2),N=$P(L,U),O=$P(L,U,2),L=$E(N_$J("",30),1,30)_"  "_O
 I $D(^AUTTEDT("B",N)) D RSLT(E(1)_"TOPIC EXISTS => "_N) Q
 I $D(^AUTTEDT("C",O)) D RSLT(E(1)_"MNEMONIC EXISTS => "_O_" for "_N) Q
 S DLAYGO=9999999.09,DIC="^AUTTEDT(",X=N,DIC("DR")="1///"_O
 D FILE,ADDFAIL:Y<0,ADDOK:Y>0
 Q
 ;

AUM9106A
AUM9106A ; IHS/ASDST/GTH - STANDARD TABLE UPDATES, 1999MAY24 ; [ 06/17/1999   3:41 PM ]
 ;;99.1;TABLE MAINTENANCE;**6**;NOV 6,1998
 ;
UPDATE ;;IHS STANDARD CODE BOOK MODS/PT EDUC TOPICS - MAY 1999 5/24/99
 ;
EDTADD ;;EDUCATION TOPICS, FROM THE PEP COMMITTEE: NAME^MNEMONIC
 ;;ANS-PREOPERATIVE^ANS-PR
 ;;ANS-POSTOPERATIVE^ANS-PO
 ;;ANS-FOLLOW-UP^ANS-FU
 ;;ANS-LITERATURE^ANS-L
 ;;BF-WEANING^BF-W
 ;;BF-NUTRITION (MATERNAL)^BF-N
 ;;CDC-MEDICATION^CDC-M
 ;;CHI-WEANING^CHI-W
 ;;CHT-WEANING^CHT-W
 ;;DC-DISEASE PROCESS^DC-DP
 ;;DC-PREVENTION^DC-P
 ;;DC-TREATMENT^DC-TX
 ;;DC-FOLLOW-UP^DC-FU
 ;;DC-LITERATURE^DC-L
 ;;EOL-DISEASE PROCESS^EOL-DP
 ;;EOL-GRIEVING PROCESS^EOL-GP
 ;;EOL-LIFESTYLE ADAPTATION^EOL-LA
 ;;EOL-LIVING WILL^EOL-LW
 ;;EOL-MEDICATIONS^EOL-M
 ;;EOL-NUTRITION^EOL-N
 ;;EOL-LITERATURE^EOL-L
 ;;EOL-PSYCHOTHERAPY^EOL-PS
 ;;EOL-TREATMENT^EOL-TX
 ;;HL-TESTS^HL-TE
 ;;HL-SPEECH & LANGUAGE SCREENING^HL-SL
 ;;HL-DISEASE PROCESS^HL-DP
 ;;HL-FOLLOW-UP^HL-FU
 ;;HL-LITERATURE^HL-L
 ;;HRA-EQUIPMENT^HRA-EQ
 ;;HRA-FOLLOW-UP^HRA-FU
 ;;HRA-LIFESTYLE ADAPTATION^HRA-LA
 ;;HRA-LITERATURE^HRA-L
 ;;PC-DISEASE PROCESS^PC-DP
 ;;PC-PREVENTION^PC-P
 ;;PC-TREATMENT^PC-TX
 ;;PC-NUTRITION^PC-N
 ;;PC-FOLLOW-UP^PC-FU
 ;;PC-LITERATURE^PC-L
 ;;PD-DISEASE PROCESS^PD-DP
 ;;PD-PREVENTION^PD-P
 ;;PD-TREATMENT^PD-TX
 ;;PD-FOLLOW-UP^PD-FU
 ;;PD-LITERATURE^PD-L
 ;;PM-ANATOMY & PHYSIOLOGY^PM-AP
 ;;PM-DISEASE PROCESS^PM-DP
 ;;PM-FOLLOW-UP^PM-FU
 ;;PM-LIFESTYLE ADAPTATION^PM-LA
 ;;PM-MEDICATION^PM-M
 ;;PM-NUTRITION^PM-N
 ;;PM-LITERATURE^PM-L
 ;;PM-PREVENTION^PM-P
 ;;PM-PSYCHOTHERAPY^PM-PSY
 ;;PM-TESTS^PM-TE
 ;;PM-TREATMENT^PM-TX
 ;;UTI-DISEASE PROCESS^UTI-DP
 ;;UTI-FOLLOW-UP^UTI-FU
 ;;UTI-MEDICATION^UTI-M
 ;;UTI-NUTRITION^UTI-N
 ;;UTI-LITERATURE^UTI-L
 ;;UTI-PREVENTION^UTI-P
 ;;UTI-TESTS^UTI-TE
 ;;END
 ;
PRINT ;
 F %=1:1 S X=$P($T(EDTADD+%),";",3) Q:X="END"  W !,$J(%,2),".  ",$P(X,"^",2),?16,$P(X,"^",1)
 Q
 ;
LOCNEW ;;A.  NEW FACILITY CODES (SECTION VIII-C): AREA^S.U.^FAC.^NAME^PSEUDO
 ;;25^21^56^JEMEZ PUEBLO HEALTH DEPARTMENT^QEX
 ;;25^22^62^CANONCITO BEHAVIORAL HEALTH PROG^QEV
 ;;35^33^83^SAINT MARYS^AFK
 ;;35^38^61^ANNETTE^AHY
 ;;35^38^99^UNDESIG LOCS^AHZ
 ;;39^36^02^KETCHIKAN GENERAL HOSPITAL^AIR
 ;;75^75^78^SAMISH INDIAN NATION^PAL
 ;;75^79^61^JAMESTOWN S'KLALLAM CHEM DEP PROG^PAM
 ;;END
 ;
LOCMOD ;;B.  FACILITY CODE CHANGES (SECTION VIII-C): AREA^S.U.^FAC.^NAME
 ;;FROM^15^09^11^ALL NATIONS CLINIC
 ;;TO  ^15^09^11^NATIVE WOMEN'S HEALTH CARE
 ;;FROM^35^31^01^ANCH MED CTR
 ;;TO  ^35^31^01^ALASKA NATIVE MEDICAL CENTER
 ;;FROM^35^31^45^NELSON LAG'N
 ;;TO  ^35^31^45^NELSON LAGOON
 ;;FROM^35^31^62^ALUTIIQ ENWIA HC
 ;;TO  ^35^31^62^ALUTIIQ ENWIA HEALTH CENTER
 ;;FROM^35^31^63^MCGRATH
 ;;TO  ^35^31^63^MCGRATH HEALTH CENTER
 ;;FROM^35^31^68^PAULOFF HARB
 ;;TO  ^35^31^68^PAULOFF HARBOR
 ;;FROM^35^31^78^COPPER CNTR
 ;;TO  ^35^31^78^COPPER CENTER
 ;;FROM^35^31^79^GLENALLEN
 ;;TO  ^35^31^79^GLENNALLEN
 ;;FROM^35^31^90^COOK
 ;;TO  ^35^31^90^NINILCHIK
 ;;FROM^35^32^01^SAMUEL SIMMONDS MEM HOSP
 ;;TO  ^35^32^01^SAMUEL SIMMONDS MEMORIAL HOSP
 ;;FROM^35^32^50^BARTER ISLE
 ;;TO  ^35^32^50^BARTER ISLAND
 ;;FROM^35^32^86^FLAXMAN ISLE
 ;;TO  ^35^32^86^FLAXMAN ISLAND
 ;;FROM^35^33^50^AKIACHUK
 ;;TO  ^35^33^50^AKIACHAK
 ;;FROM^35^33^57^CROOKED CRK
 ;;TO  ^35^33^57^CROOKED CREEK
 ;;FROM^35^33^69^LOW. KALSKAG
 ;;TO  ^35^33^69^LOWER KALSKAG
 ;;FROM^35^33^72^MT. VILLAGE
 ;;TO  ^35^33^72^MOUNTAIN VILLAGE
 ;;FROM^35^33^78^PILOT STAT'N
 ;;TO  ^35^33^78^PILOT STATION
 ;;FROM^35^33^81^CHUATHBULAK
 ;;TO  ^35^33^81^CHUATHBALUK
 ;;FROM^35^33^82^RUSSIAN MISSION-YUKON
 ;;TO  ^35^33^82^RUSSIAN MISSION
 ;;FROM^35^33^85^SHELDON PT.
 ;;TO  ^35^33^85^SHELDON POINT
 ;;FROM^35^33^93^MORAVIAN SCH
 ;;TO  ^35^33^93^MORAVIAN SCHOOL
 ;;FROM^35^34^01^BRISTOL B HOSP
 ;;TO  ^35^34^01^KANAKANAK HOSPITAL
 ;;FROM^35^34^52^CHIGNIK'LAGOON
 ;;TO  ^35^34^52^CHIGNIK LAGOON
 ;;FROM^35^34^73^IGUIGIG
 ;;TO  ^35^34^73^IGIUGIG
 ;;FROM^35^34^81^PORTAGE CRK
 ;;TO  ^35^34^81^PORTAGE CREEK
 ;;FROM^35^35^01^KOTZEBUE HOS
 ;;TO  ^35^35^01^MANIILAQ HEALTH CENTER
 ;;FROM^35^36^10^JUNEAU
 ;;TO  ^35^36^10^SEARHC HEALTH CENTER, JUNEAU
 ;;FROM^35^36^11^SEARHC HC - KETCHIKAN
 ;;TO  ^35^36^11^SEARHC HEALTH CENTER,KETCHIKAN
 ;;FROM^35^36^20^MT. EDGECUMBE
 ;;TO  ^35^36^20^MT EDGECUMBE HEALTH CENTER
 ;;FROM^35^36^30^YAKUTAT
 ;;TO  ^35^36^30^YAKUTAT COMMUNITY HC
 ;;FROM^35^37^10^CHF AND ISAC
 ;;TO  ^35^37^10^CHIEF ANDREW ISAAC HC
 ;;FROM^35^37^11^FT. YUKON
 ;;TO  ^35^37^11^YUKON FLATS HEALTH CENTER
 ;;FROM^35^37^12^TANANA HEALTH CTR
 ;;TO  ^35^37^12^TANANA HEALTH CENTER
 ;;FROM^35^37^51^ANAKTUVUK
 ;;TO  ^35^37^51^ANAKTUVUK PASS
 ;;FROM^35^37^63^MANLEY H. SPG
 ;;TO  ^35^37^63^MANLEY HOT SPRINGS
 ;;FROM^35^37^64^FNA/TCC ADOLESCENT RTC
 ;;TO  ^35^37^64^DENALI ADOLESCENT CENTER
 ;;FROM^35^37^69^STEVENS VILL
 ;;TO  ^35^37^69^STEVENS VILLAGE
 ;;FROM^35^37^82^CANYON VILL
 ;;TO  ^35^37^82^CANYON VILLAGE
 ;;FROM^35^38^12^METLAKATLA
 ;;TO  ^35^38^12^METLAKATLA HEALTH CENTER
 ;;FROM^35^39^01^NORT SOUND H
 ;;TO  ^35^39^01^NORTON SOUND HOSPITAL
 ;;FROM^35^39^54^LITL DIOMEDE
 ;;TO  ^35^39^54^LITTLE DIOMEDE
 ;;FROM^35^39^61^WHITE MTN
 ;;TO  ^35^39^61^WHITE MOUNTAIN
 ;;FROM^35^39^81^NORTHEAST CP
 ;;TO  ^35^39^81^NORTHEAST CAPE
 ;;END
 ;
LOCINACT ;;C.  INACTIVATED FACILITY CODES (SECTION VIII-C): AREA^S.U.^FAC.^NAME
 ;;30^00^60^ALASKA AREA A/SA PROGRAM
 ;;35^00^25^ALASKA NATIVE HEALTH BOARD
 ;;35^00^26^ALASKA SUPPLY SERVICE CENTER
 ;;35^00^27^CENTERS FOR DISEASE CONTROL
 ;;35^31^24^ALEUTIAN-PRIBILOP ISL ASSN
 ;;35^31^25^CINA CLINIC
 ;;35^31^26^COPPER RIVER NATIVE ASSN
 ;;35^31^27^EEDA REGIONAL CONSORTIUM
 ;;35^31^28^KENAITZE INDIAN CORP
 ;;35^31^29^KODIAK AREA NATIVE ASSOC
 ;;35^31^32^SOUTH KACHEMAK INC
 ;;35^31^33^THE NORTH PACIFIC RIM
 ;;35^31^35^SOUTHCENT FO
 ;;35^32^25^NORTH SLOPE BOROUGH
 ;;35^33^25^KUSKOKWIM NATIVE ASSOCIATION
 ;;35^33^26^YUKON-KUSKOKWIM HEALTH CORP
 ;;35^34^25^BRISTOL B HOS
 ;;35^35^25^MANIILAQ ASSOCIATION
 ;;35^36^25^KETCHIKAN INDIAN CORP
 ;;35^36^26^SEARHC OFFICES
 ;;35^36^27^CITY OF YAKUTAT
 ;;35^37^25^FAIRBANKS NATIVE ASSOCIATION
 ;;35^37^26^TANANA CHIEFS CONFERENCE 
 ;;35^37^27^TANANA IRA COUNCIL
 ;;35^38^25^METLAKATLA INDIAN CORP
 ;;35^39^25^NORTON SOUND HEALTH CORP
 ;;END
 ;
COMMNEW ;;D.  NEW COMMUNITY CODES (SECTION V-C): STATE^CNTY^COMM^NAME^AREA^S.U.
 ;;26^62^244^WHITE CLOUD^11^00
 ;;30^05^061^ROBERTS^40^42
 ;;55^21^040^ARGONNE^18^28
 ;;55^34^050^ELCHO^18^22
 ;;55^44^050^PELICAN LAKE^18^28
 ;;END
 ;

AUM9106M
AUM9106M ; IHS/ASDST/GTH -  BACKGROUND VALUES FOR STANDARD TABLE UPDATES, 1999MAY24 ; [ 06/17/1999   3:41 PM ]
 ;;99.1;TABLE MAINTENANCE;**6**;NOV 6,1998
 ;
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
25 ;;25^ALBUQUERQUE TRIBE/638^Q^J53
35 ;;35^ALASKA TRIBE/638^A^J59
39 ;;39^ALASKA NON-IHS^A^J59
75 ;;75^PORTLAND TRIBE/638^P^J64
 ;;END
 ;
SU ; AREA^SU^NAME
1100 ;;11^00^NON SERVICE UNIT
1509 ;;15^09^RAPID CITY
1822 ;;18^22^CENTRAL WISCONSIN
1828 ;;18^28^NICOLET
2521 ;;25^21^ALBUQUERQUE
2522 ;;25^22^ACOMA-CANONCITO-LAGUNA
3531 ;;35^31^ANCHORAGE
3532 ;;35^32^BARROW
3533 ;;35^33^YUK-KUS DELT
3534 ;;35^34^BRISTOL BAY
3535 ;;35^35^KOTZEBUE
3536 ;;35^36^MT.EDGECUMBE
3537 ;;35^37^INTER ALASKA
3538 ;;35^38^ANNETTE ISLAND
3539 ;;35^39^NORTON SOUND
3936 ;;39^36^KETCHIKAN MEM HOSP
4042 ;;40^42^CROW
7575 ;;75^75^PUGET SOUND
7579 ;;75^79^NEAH BAY TRIBAL
 ;;END
 ;
COUNTY ; STATE^COUNTY^NAME
2662 ;;26^62^NEWAYGO
3005 ;;30^05^CARBON
5521 ;;55^21^FOREST
5534 ;;55^34^LANGLADE
5544 ;;55^44^ONEIDA
 ;;END
 ;