4:18 PM  7-MAR-95
AUM v 95.1, patch 4, SCB updates from 03Mar95 Banyan, 7 routines.
A9AUM4
A9AUM4 ; DSD/GTH - STANDARD TABLE UPDATES, 03MAR95 BANYAN, RPI ; [ 03/07/95  4:17 PM ]
 ;;95.1;TABLE MAINTENANCE;**4**;NOV 1, 1994
 ;
 D START^AUM9503
 ;
 Q:'$L($G(^%ZOSF("DEL")))
 NEW X
 F %=1:1 S X=$P($T(DEL+%),";",3) Q:X=""  X ^%ZOSF("DEL")
 Q
DEL ;     
 ;;A9AUM1
 ;;A9AUM2
 ;;A9AUM3
 ;;AUM9503
 ;;AUM95031
 ;;AUM9503A
 ;;AUM9503M
 
 

AUM9503
AUM9503 ; DSD/GTH - STANDARD TABLE UPDATES, 03MAR95 BANYAN ; [ 03/06/95  3:17 PM ]
 ;;95.1;TABLE MAINTENANCE;**4**;NOV 1, 1994
 ;
 I '$G(DUZ) W !,"DUZ UNDEFINED OR ZERO.",! Q
 D HOME^%ZIS,DT^DICRW,INTRO
 S (DIR(0),DIR("B"))="Y"
 S DIR("A")="Do you want to queue the utility to TaskMan"
 S DIR("??")="^D Q2^AUM9503"
 D ^DIR G Q2:$D(DIRUT),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",!!,"Okay...",! D Q2 Q
 S X=+Y D H^%DTC S ZTDTH=%H_","_%T
 S ZTRTN="START^AUM9503",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
 K ^TMP($J,"RSLT")
 D START^AUM95032
 S (XMSUB,XMDUZ)=$P($P($T(+1),";",2)," ",4,99),XMTEXT="^TMP($J,""RSLT"",",XMY(1)="",XMY(DUZ)="" D ^XMD
 K ^TMP($J,"RSLT")
 I $D(ZTQUEUED) S ZTREQ="@"
 E  W !!,"The results are in your MailMan 'IN' basket.",!
 Q
 ;
INTRO ;
 W ! F %=2:1:5 W ?5,$P($T(INTRO+%),";;",2),!
 ;;This patch updates standard tables according to the changes
 ;;specified in the Banyan message time stamped 03Mar95@13:48:03 MST,
 ;;Please consult that message, and the mail message produced by this
 ;;utility.
 Q
Q2 ;EP - From DIR
 W ! F %=2:1:7 W ?5,$P($T(Q2+%),";;",2),!
 ;;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 patch.
 Q

AUM95031
AUM95031 ; DSD/GTH - STANDARD TABLE UPDATES (1), 03MAR95 BANYAN ; [ 03/06/95  3:18 PM ]
 ;;95.1;TABLE MAINTENANCE;**4**;NOV 1, 1994
 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 : "
 ;
 Q
 ;
ADDOK D RSLT(E_", Added : "_L) Q
ADDFAIL D RSLT(E(0)_E_" : ADD FAILED => "_L) Q
DIE NEW A,C,E,L,N,O,P,R,S,T
 LOCK +(@(DIE_DA_")")):10 E  D RSLT(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) ;EP
 S Y=$O(@(X_"""C"",%,0)"))
 I 'Y S Y=$T(@%^AUM9503M) I Y NEW Z S Z=E D  S:Y<0 Y="" S E=Z
 . NEW A,C,L,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(E(0)_E_" : "_$P(@(X_"0)"),U)_" DOES NOT EXIST => "_%)
 Q +Y
FILE NEW A,C,E,L,N,O,P,R,S,T K DD,DO S DIC(0)="L" D FILE^DICN K DIC Q
MODOK D RSLT(E_", Changed : "_L) Q
RSLT(%) S ^(0)=$G(^TMP($J,"RSLT",0))+1,^(^(0))=% W:'$D(ZTQUEUED) !,% Q
 ;
AREANEW ;
 S E="New Area Codes"
 F T=1:1 S L=$T(AREANEW+T^AUM9503A) Q:$P(L,";",3)="END"  D ADDAREA
 Q
 ;
ADDAREA ;
 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(E(1)_E_" : NAME EXISTS => "_N) Q
 I $D(^AUTTAREA("C",A)) D RSLT(E(1)_E_" : CODE EXISTS => "_A) Q
 S DLAYGO=9999999.21,DIC="^AUTTAREA(",X=N,DIC("DR")=".02///"_A_";.03///"_R_";.04///"_C D FILE
 D ADDFAIL:Y<0,ADDOK:Y>0
 Q
 ;
SUNEW ;
 S E="New Service Unit Codes"
 F T=1:1 S L=$T(SUNEW+T^AUM9503A) Q:$P(L,";",3)="END"  D ADDSU
 Q
 ;
ADDSU ;
 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(E(1)_E_" : 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
 D ADDFAIL:Y<0,ADDOK:Y>0
 Q
 ;
LOCNEW ;
 S E="New Location Codes"
 F T=1:1 S L=$T(LOCNEW+T^AUM9503A) 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_"  "_P
 S %=A_S_F,%=$O(^AUTTLOC("C",%,0))
 I % D RSLT(E(1)_E_" : 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(E(1)_E_" : DELETE INACTIVE DATE FAILED => "_L) D:'$D(Y) RSLT(E_" : 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(E(0)_E_" : EDIT INSTITUTION FAILED => "_L) D:'$D(Y) RSLT(E_" : 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(E(0)_E_" : EDIT PSEUDO PREFIX FAILED => "_L) D:'$D(Y) RSLT(E_" : 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(E(0)_"DINUM FOR LOC/INSTITUTION TOO BIG. NOTIFY ISC.") Q
 Q:DINUM>99999
 S DLAYGO=4,DIC="^DIC(4,",X=N D FILE
 I Y<0 D RSLT(E(0)_E_" : ^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
 D ADDFAIL:Y<0,ADDOK:Y>0
 Q
 ;
LOCMOD ;
 S E="Location Code Changes"
 F T=1:2 S L=$T(LOCMOD+T^AUM9503A) Q:$P(L,";",3)="END"  S L("TO")=$T(LOCMOD+T+1^AUM9503A) 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_"  "_$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(E(0)_E_" : 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(E(0)_E_" : EDIT INSTITUTION FAILED => "_L) Q
 .D MODOK
 .Q
 Q
 ;
CNTYNEW ;
 S E="New County Codes"
 F T=1:1 S L=$T(CNTYNEW+T^AUM9503A) Q:$P(L,";",3)="END"  D ADDCNTY
 Q
 ;
ADDCNTY ;
 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(E(1)_E_" : 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
 D ADDFAIL:Y<0,ADDOK:Y>0
 Q
 ;
CNTYMOD ;
 S E="County Code Changes"
 F T=1:2 S L=$T(CNTYMOD+T^AUM9503A) Q:$P(L,";",3)="END"  S L("TO")=$T(CNTYMOD+T+1^AUM9503A) D
 .S L=$P(L,U,2,99),S=$P(L,U),C=$P(L,U,2)
 .S P=$O(^AUTTCTY("C",S_C,0))
 .S L=$P(L("TO"),U,2,99),S=$P(L,U),C=$P(L,U,2),N=$P(L,U,3)
 .I 'P S P=$O(^AUTTCTY("C",S_C,0)) I 'P S L=";;"_L D ADDCNTY Q
 .S L=S_"  "_C_"  "_N
 .S P("S")=$$IEN("^DIC(5,",S) Q:'P("S")
 .S DIE="^AUTTCTY(",DA=P,DR=".01///"_N_";.02////"_P("S")_";.03///"_C D DIE
 .I $D(Y) D RSLT(E(0)_E_" : EDIT COUNTY FAILED => "_L) Q
 .D MODOK
 .Q
 Q

AUM95032
AUM95032 ; DSD/GTH - STANDARD TABLE UPDATES (2), 03MAR95 BANYAN ; [ 03/07/95  3:00 PM ]
 ;;95.1;TABLE MAINTENANCE;**4**;NOV 1, 1994
 ;
 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 COMMMOD
 D RSLT($$COMMMOD^AUMXPORT("AUM9503A")_" patients marked for export because of the Community Code changes.")
 Q
 ; ===   utility sub-routines   ====
 ;
ADDOK D RSLT(E_", Added : "_L) Q
ADDFAIL D RSLT(E(0)_E_" : ADD FAILED => "_L) Q
DIE NEW A,C,E,L,N,O,P,R,S,T
 LOCK +(@(DIE_DA_")")):10 E  D RSLT(E(0)_"Entry '"_DIE_DA_"' IS LOCKED.  NOTIFY PROGRAMMER.") S Y=1 Q
 D ^DIE LOCK -(@(DIE_DA_")")) K DA,DIE,DR Q
FILE NEW A,C,E,L,N,O,P,R,S,T K DD,DO S DIC(0)="L" D FILE^DICN K DIC Q
MODOK D RSLT(E_", Changed : "_L) Q
RSLT(%) S ^(0)=$G(^TMP($J,"RSLT",0))+1,^(^(0))=% W:'$D(ZTQUEUED) !,% Q
 ;
 ; =================================
 ;
COMMNEW ;
 S E="New Community Codes"
 F T=1:1 S L=$T(COMMNEW+T^AUM9503A) 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_" "_A_" "_V
 I $D(^AUTTCOM("C",S_O_C)) D RSLT(E(1)_E_" : STCTYCOM CODE EXISTS => "_S_O_C) Q
 S P("O")=$$IEN^AUM95031("^AUTTCTY(",S_O) Q:'P("O")
 S P("A")=$$IEN^AUM95031("^AUTTAREA(",A) Q:'P("A")
 S P("V")=$$IEN^AUM95031("^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
 D ADDFAIL:Y<0,ADDOK:Y>0
 Q
 ;
COMMMOD ;
 S E="Community Code Changes"
 F T=1:2 S L=$T(COMMMOD+T^AUM9503A) Q:$P(L,";",3)="END"  S L("TO")=$T(COMMMOD+T+1^AUM9503A) D
 .S L=$P(L,U,2,99),S=$P(L,U),O=$P(L,U,2),C=$P(L,U,3)
 .S P=$O(^AUTTCOM("C",S_O_C,0))
 .S L=$P(L("TO"),U,2,99),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)
 .I 'P S P=$O(^AUTTCOM("C",S_O_C,0)) I 'P S L=";;"_L D ADDCOMM Q
 .S L=S_" "_O_" "_C_" "_N_" "_A_" "_V
 .S P("O")=$$IEN^AUM95031("^AUTTCTY(",S_O) Q:'P("O")
 .S P("A")=$$IEN^AUM95031("^AUTTAREA(",A) Q:'P("A")
 .S P("V")=$$IEN^AUM95031("^AUTTSU(",A_V) Q:'P("V")
 .S DIE="^AUTTCOM(",DA=P,DR=".01///"_N_";.02////"_P("O")_";.05////"_P("V")_";.06////"_P("A")_";.07///"_C D DIE
 .I $D(Y) D RSLT(E(0)_E_" : CHANGE FAILED => "_L) Q
 .D MODOK
 .Q
 Q
 ;
COMMDEL ;
 S E="Community Inactivation"
 F T=1:1 S L=$T(COMMDEL+T^AUM9503A) Q:$P(L,";",3)="END"  D
 .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_" "_A_" "_V
 .S P=$O(^AUTTCOM("C",S_O_C,0))
 .I 'P D RSLT(E_" : COMMUNITY NOT FOUND (That's OK) => "_L) Q
 .S DIE="^AUTTCOM(",DA=P,DR=".14///<INACTIVE>" D DIE
 .I $D(Y) D RSLT(E(0)_E_" : EDIT FAILED => "_L) Q
 .D RSLT(E_" : SHORT NAME MARKED '<INACTIVE>' => "_L) Q
 .Q
 Q
 ;

AUM9503A
AUM9503A ; DSD/GTH - STANDARD TABLE UPDATES DATA A, 03MAR95 BANYAN ; [ 03/06/95  4:17 PM ]
 ;;95.1;TABLE MAINTENANCE;**4**;NOV 1, 1994
 ;
 ;  If you do not want new entries made in your area, remove the line.
 ;
 ;  If you don't want the modifications performed in your area, remove
 ;    BOTH the FROM line and the TO line.
 ;
COMMMOD ;;A.  COMMUNITY CODE CHANGES (SECTION V-C): STATE^CNTY^COMM^NAME^AREA^S.U.
 ;;FROM^30^08^100^BIG SANDY^40^48
 ;;  TO^30^08^100^BIG SANDY^45^48
 ;;FROM^30^08^101^DENTON^40^48
 ;;  TO^30^08^101^DENTON^45^48
 ;;FROM^30^08^102^FORT BENTON^40^48
 ;;  TO^30^08^102^FORT BENTON^45^48
 ;;FROM^30^15^180^BIG FORK^40^43
 ;;  TO^30^15^180^BIG FORK^45^43
 ;;FROM^30^15^181^COLUMBIA FAL^40^43
 ;;  TO^30^15^181^COLUMBIA FAL^45^43
 ;;FROM^30^15^182^HUNGRY HORSE^40^43
 ;;  TO^30^15^182^HUNGRY HORSE^45^43
 ;;FROM^30^15^183^KALISPELL^40^43
 ;;  TO^30^15^183^KALISPELL^45^43
 ;;FROM^30^15^184^WEST GLACIER^40^43
 ;;  TO^30^15^184^WEST GLACIER^45^43
 ;;FROM^30^15^185^WHITEFISH^40^43
 ;;  TO^30^15^185^WHITEFISH^45^43
 ;;FROM^30^21^230^BOX ELDER^40^48
 ;;  TO^30^21^230^BOX ELDER^45^48
 ;;FROM^30^21^231^DUCK CREEK^40^48
 ;;  TO^30^21^231^DUCK CREEK^45^48
 ;;FROM^30^21^232^GILDFORD^40^48
 ;;  TO^30^21^232^GILDFORD^45^48
 ;;FROM^30^21^233^HAVRE^40^48
 ;;  TO^30^21^233^HAVRE^45^48
 ;;FROM^30^21^234^HAYSTACK^40^48
 ;;  TO^30^21^234^HAYSTACK^45^48
 ;;FROM^30^21^235^HINGHAM^40^48
 ;;  TO^30^21^235^HINGHAM^45^48
 ;;FROM^30^21^236^INVERNESS^40^48
 ;;  TO^30^21^236^INVERNESS^45^48
 ;;FROM^30^21^237^JOPLIN^40^48
 ;;  TO^30^21^237^JOPLIN^45^48
 ;;FROM^30^21^238^KREMLIN^40^48
 ;;  TO^30^21^238^KREMLIN^45^48
 ;;FROM^30^21^239^NEWTON^40^48
 ;;  TO^30^21^239^NEWTON^45^48
 ;;FROM^30^21^240^PARKER CAN R^40^48
 ;;  TO^30^21^240^PARKER CAN R^45^48
 ;;FROM^30^21^241^PARKER SCHOOL^40^48
 ;;  TO^30^21^241^PARKER SCHOOL^45^48
 ;;FROM^30^21^242^ROCKY BOY^40^48
 ;;  TO^30^21^242^ROCKY BOY^45^48
 ;;FROM^30^21^243^RUDYARD^40^48
 ;;  TO^30^21^243^RUDYARD^45^48
 ;;FROM^30^21^244^SANGREY^40^48
 ;;  TO^30^21^244^SANGREY^45^48
 ;;FROM^30^21^245^EAGLEMAN^40^48
 ;;  TO^30^21^245^EAGLEMAN^45^48
 ;;FROM^30^21^246^AZURE^40^48
 ;;  TO^30^21^246^AZURE^45^48
 ;;FROM^30^21^247^COURCHENE SP^40^48
 ;;  TO^30^21^247^COURCHENE SP^45^48
 ;;FROM^30^24^270^ARLEE^40^43
 ;;  TO^30^24^270^ARLEE^45^43
 ;;FROM^30^24^271^BIG ARM^40^43
 ;;  TO^30^24^271^BIG ARM^45^43
 ;;FROM^30^24^272^CHARLO^40^43
 ;;  TO^30^24^272^CHARLO^45^43
 ;;FROM^30^24^273^DAYTON^40^43
 ;;  TO^30^24^273^DAYTON^45^43
 ;;FROM^30^24^274^ELMO^40^43
 ;;  TO^30^24^274^ELMO^45^43
 ;;FROM^30^24^275^PABLO^40^43
 ;;  TO^30^24^275^PABLO^45^43
 ;;FROM^30^24^276^POLSON^40^43
 ;;  TO^30^24^276^POLSON^45^43
 ;;FROM^30^24^277^POLSON-RURAL^40^43
 ;;  TO^30^24^277^POLSON-RURAL^45^43
 ;;FROM^30^24^278^RONAN^40^43
 ;;  TO^30^24^278^RONAN^45^43
 ;;FROM^30^24^279^RONAN-RURAL^40^43
 ;;  TO^30^24^279^RONAN-RURAL^45^43
 ;;FROM^30^24^280^ST IGNATIUS^40^43
 ;;  TO^30^24^280^ST IGNATIUS^45^43
 ;;FROM^30^24^281^SWAN LAKE^40^43
 ;;  TO^30^24^281^SWAN LAKE^45^43
 ;;FROM^30^24^282^CLARISE PAUL^40^43
 ;;  TO^30^24^282^CLARISE PAUL^45^43
 ;;FROM^30^24^283^WOODCOCK^40^43
 ;;  TO^30^24^283^WOODCOCK^45^43
 ;;FROM^30^24^284^MISSION DAM^40^43
 ;;  TO^30^24^284^MISSION DAM^45^43
 ;;FROM^30^24^285^SCHLEY HOMES^40^43
 ;;  TO^30^24^285^SCHLEY HOMES^45^43
 ;;FROM^30^24^286^HOULE VILLE^40^43
 ;;  TO^30^24^286^HOULE VILLE^45^43
 ;;FROM^30^24^287^TURTLE LAKE^40^43
 ;;  TO^30^24^287^TURTLE LAKE^45^43
 ;;FROM^30^24^288^RAVALLI^40^43
 ;;  TO^30^24^288^RAVALLI^45^43
 ;;FROM^30^26^320^CHESTER^40^48
 ;;  TO^30^26^320^CHESTER^45^48
 ;;FROM^30^32^380^BONNER^40^43
 ;;  TO^30^32^380^BONNER^45^43
 ;;FROM^30^32^381^CLINTON^40^43
 ;;  TO^30^32^381^CLINTON^45^43
 ;;FROM^30^32^382^FRANCHTON^40^43
 ;;  TO^30^32^382^FRANCHTON^45^43
 ;;FROM^30^32^383^LOLO^40^43
 ;;  TO^30^32^383^LOLO^45^43
 ;;FROM^30^32^384^MILLTOWN^40^43
 ;;  TO^30^32^384^MILLTOWN^45^43
 ;;FROM^30^32^385^MISSOULA^40^43
 ;;  TO^30^32^385^MISSOULA^45^43
 ;;FROM^30^32^386^SEELEY LAKE^40^43
 ;;  TO^30^32^386^SEELEY LAKE^45^43
 ;;FROM^30^32^387^EVARO^40^43
 ;;  TO^30^32^387^EVARO^45^43
 ;;FROM^30^45^520^CAMAS^40^43
 ;;  TO^30^45^520^CAMAS^45^43
 ;;FROM^30^45^521^DIXON^40^43
 ;;  TO^30^45^521^DIXON^45^43
 ;;FROM^30^45^522^HOT SPRING^40^43
 ;;  TO^30^45^522^HOT SPRING^45^43
 ;;FROM^30^45^523^NIARADA^40^43
 ;;  TO^30^45^523^NIARADA^45^43
 ;;FROM^30^45^524^PARADISE^40^43
 ;;  TO^30^45^524^PARADISE^45^43
 ;;FROM^30^45^525^PERMA^40^43
 ;;  TO^30^45^525^PERMA^45^43
 ;;FROM^30^45^526^PLAINS^40^43
 ;;  TO^30^45^526^PLAINS^45^43
 ;;FROM^30^45^527^THOMPSON FAL^40^43
 ;;  TO^30^45^527^THOMPSON FAL^45^43
 ;;FROM^96^99^885^CORNWALL^58^59
 ;;  TO^96^99^885^CORNWALL^58^00
 ;;END
 ;;

AUM9503M
AUM9503M ; DSD/GTH - BACKGROUND VALUES FOR STANDARD TABLE UPDATES, 03MAR95 BANYAN ; [ 03/06/95  3:30 PM ]
 ;;95.1;TABLE MAINTENANCE;**4**;NOV 1, 1994
 ;
AREA ; CODE^NAME^PREFIX/REGION^CAN PREFIX
40 ;;40^BILLINGS^B^J47
45 ;;45^BILLINGS TRIBE/638^B^J47
58 ;;58^NASHVILLE NON-IHS^U^J51
 ;;
SU ; AREA^SU^NAME
4043 ;;40^43^FLATHEAD
4048 ;;40^48^ROCKY BOY'S
4543 ;;45^43^FLATHEAD
4548 ;;45^48^ROCKY BOY'S
5800 ;;58^00^NON SERVICE UNIT
5859 ;;58^59^ST.RE.MOHAWK
 ;;
COUNTY ; STATE^COUNTY^NAME
3008 ;;30^08^CHOUTEAU
3015 ;;30^15^FLATHEAD
3021 ;;30^21^HILL
3024 ;;30^24^LAKE
3026 ;;30^26^LIBERTY
3032 ;;30^32^MISSOULA
3045 ;;30^45^SANDERS
9699 ;;96^99^CANADA UNK
 ;;

AUMXPORT
AUMXPORT ; IHS/ADC/GTH - MARK PT'S FOR REG EXPORT ; [ 03/07/95  3:29 PM ]
 ;;95.1;TABLE MAINTENANCE;**4**;NOV 1, 1994
 ;
 Q
 ;
SETUP ;
 D NOW^%DTC
 S N=%
 S W="W:'$D(ZTQUEUED) ""."""
 Q
 ;
 ;
COMMMOD(AUMRTN) ;EP - SET ^AGPATCH for Community Code Changes.
 ;
 ;  SET ^AGPATCH(NOW,DUZ(2),DFN)="" for a changed community.
 ;  The above was confirmed and agreed upon with the owner of
 ;  ^AGPATCH (Registration).
 ;
 NEW D,DFN,L,N,T,W
 ;
 ; D = Site DUZ(2).
 ; L = "TO" string, then the name of the community being changed.
 ; N = NOW
 ; T = Counter
 ; W = Write dot if not q'd.
 ;
 D SETUP
 ;
 F T=1:2 S L=$T(COMMMOD+T^@AUMRTN) Q:$P(L,";",3)="END"  X W S L=$P($T(COMMMOD+T+1^@AUMRTN),U,5),DFN=0 F  S DFN=$O(^AUPNPAT("AC",L,DFN)) Q:'DFN  X W S D=$O(^AUPNPAT(DFN,41,0)) X W I D S ^AGPATCH(N,D,DFN)=""
 G COUNT
 ;
LOCMOD(AUMRTN) D SETUP G COUNT
CLINMOD(AUMRTN) D SETUP G COUNT
CNTYMOD(AUMRTN) D SETUP G COUNT
RESMOD(AUMRTN) D SETUP G COUNT
TRIBMOD(AUMRTN) D SETUP G COUNT
 ;
COUNT ;
 S (D,T)=0
 F  S D=$O(^AGPATCH(N,D)) Q:'D  X W S DFN=0 F  S DFN=$O(^AGPATCH(N,D,DFN)) Q:'DFN  X W S T=T+1
 Q T
 ;