1:35 PM  12-DEC-95
AUM v 96.1, Patch 2, Updates to SCB from 6Dec95 Banyan, and 2 field requests.  Restore 8 routines and DO ^AUM6102.
A9AUM2
A9AUM2 ; IHS/ADC/GTH - STANDARD TABLE UPDATES, 06DEC95 BANYAN, RPI ; [ 12/11/95  4:20 PM ]
 ;;96.1;TABLE MAINTENANCE;**2**;OCT 26,1995
 ;
 D START^AUM6102
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 ;     
 ;;AUM6102
 ;;AUM61021
 ;;AUM61022
 ;;AUM6102A
 ;;AUM6102B
 ;;AUM6102M

AUM6102
AUM6102 ; IHS/ADC/GTH - STANDARD TABLE UPDATES, 06DEC95 BANYAN ; [ 12/11/95  4:16 PM ]
 ;;96.1;TABLE MAINTENANCE;**2**;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^AUM6102(""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 AUM6102
 S X=+Y
 D H^%DTC
 S ZTDTH=%H_","_%T
 S ZTRTN="START^AUM6102",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("AUM SCB",$J)
 D START^AUM61021,START^AUM61022
 S XMSUB=$P($P($T(+1),";",2)," ",4,99),XMDUZ=$S($G(DUZ):DUZ,1:.5),XMTEXT="^TMP(""AUM SCB"",$J,",XMY(1)="",XMY(DUZ)=""
 D ^XMD
 K ^TMP("AUM SCB",$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 Banyan message time stamped 06Dec95@10:57:44 MST. 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
 ;

AUM61021
AUM61021 ; IHS/ADC/GTH - STANDARD TABLE UPDATES, 06DEC95 BANYAN ; [ 12/11/95  3:39 PM ]
 ;;96.1;TABLE MAINTENANCE;**2**;OCT 26,1995
 ;
 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 LOCNEW,DASH,LOCMOD,DASH,LOCINACT,DASH,COMMMOD,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,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(@%^AUM9511M) 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($J("",5)_E(0)_$P(@(X_"0)"),U)_" DOES NOT EXIST => "_%)
 Q +Y
DIK NEW A,C,E,L,N,O,P,R,S,T D ^DIK K DIK 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($J("",5)_"Changed : "_L) Q
RSLT(%) S ^(0)=$G(^TMP("AUM SCB",$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 ;
 D RSLT("New Area Codes")
 F T=1:1 S L=$T(AREANEW+T^AUM6102A) 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($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
 Q
 ;
 ; -----------------------------------------------------
SUNEW ;
 D RSLT("New Service Unit Codes")
 F T=1:1 S L=$T(SUNEW+T^AUM6102A) 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($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
 Q
 ;
 ; -----------------------------------------------------
LOCNEW ;
 D RSLT("New Location Codes")
 F T=1:1 S L=$T(LOCNEW+T^AUM6102A) 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($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
 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
 Q
 ;
LOCMOD ;
 D RSLT("Location Code Changes")
 F T=1:2 S L=$T(LOCMOD+T^AUM6102A) Q:$P(L,";",3)="END"  S L("TO")=$T(LOCMOD+T+1^AUM6102A) 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($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("AUM6102A")_" patients marked for export because of the Location Code changes.")
 ;
 Q
 ;
LOCINACT ;
 D RSLT("Inactivated Location Codes")
 F T=1:1 S L=$T(LOCINACT+T^AUM6102A) 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
 ;
 ; -----------------------------------------------------
CNTYNEW ;
 D RSLT("New County Codes")
 F T=1:1 S L=$T(CNTYNEW+T^AUM6102A) 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($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
 ;
CNTYMOD ;
 D RSLT("County Code Changes")
 F T=1:2 S L=$T(CNTYMOD+T^AUM6102A) Q:$P(L,";",3)="END"  S L("TO")=$T(CNTYMOD+T+1^AUM6102A) 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($J("",5)_E(0)_"EDIT COUNTY FAILED => "_L) Q
 . D MODOK
 .Q
 Q
 ;
 ; -----------------------------------------------------
COMMNEW ;
 D RSLT("New Community Codes")
 F T=1:1 S L=$T(COMMNEW+T^AUM9511A) 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($J("",5)_E(1)_"STCTYCOM CODE EXISTS => "_S_O_C) Q
 S P("O")=$$IEN^AUM95111("^AUTTCTY(",S_O)
 Q:'P("O")
 S P("A")=$$IEN^AUM95111("^AUTTAREA(",A)
 Q:'P("A")
 S P("V")=$$IEN^AUM95111("^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
 Q
 ;
COMMMOD ;
 D RSLT("Community Code Changes")
 F T=1:2 S L=$T(COMMMOD+T^AUM6102A) Q:$P(L,";",3)="END"  S L("TO")=$T(COMMMOD+T+1^AUM6102A) 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^AUM61021("^AUTTCTY(",S_O)
 . Q:'P("O")
 . S P("A")=$$IEN^AUM61021("^AUTTAREA(",A)
 . Q:'P("A")
 . S P("V")=$$IEN^AUM61021("^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($J("",5)_E(0)_"CHANGE FAILED => "_L) Q
 . D MODOK
 .Q
 D DASH,RSLT($$COMMMOD^AUMXPORT("AUM6102A")_" patients marked for export because of the Community Code changes.")
 Q
 ;
 ; -----------------------------------------------------
 ;

AUM61022
AUM61022 ; IHS/ADC/GTH - STANDARD TABLE UPDATES (2), FIELD REQUESTS ; [ 12/11/95  3:59 PM ]
 ;;96.1;TABLE MAINTENANCE;**2**;OCT 26,1995
 ;
 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 HFADD,DASH,EDTADD,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_")")) K DA,DIE,DR Q
DIK NEW A,C,E,L,N,O,P,R,S,T D ^DIK K DIK 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($J("",5)_"Changed : "_L) Q
RSLT(%) S ^(0)=$G(^TMP("AUM SCB",$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)
 ;
 ;
 ; =================================
 ;
HFADD ;
 D RSLT("New Health Factor Entries")
 F T=1:1 S L=$T(HFADD+T^AUM6102B) Q:$P(L,";",3)="END"  D ADDHF
 Q
 ;
ADDHF ;
 S L=$P(L,";;",2),N=$P(L,U),O=$P(L,U,2),C=$P(L,U,3),R=$P(L,U,4),S=$P(L,U,5),L=N_" "_O_"  "_C_"  "_R_"  "_S
 I $D(^AUTTHF("B",N)) D RSLT($J("",5)_E(1)_"HEALTH FACTOR EXISTS => "_N) Q
 S DLAYGO=9999999.64,DIC="^AUTTHF(",X=N,DIC("DR")=".02///"_O_";.03///"_C_";.08///"_R_";.1///"_S
 D FILE,ADDFAIL:Y<0,ADDOK:Y>0
 Q
 ;
 ; =================================
 ;
EDTADD ;
 D RSLT("New Education Topics")
 F T=1:1 S L=$T(EDTADD+T^AUM6102B) Q:$P(L,";",3)="END"  D ADDEDT
 Q
 ;
ADDEDT ;
 S L=$P(L,";;",2),N=$P(L,U),O=$P(L,U,2),L=N_" "_O
 I $D(^AUTTEDT("B",N)) D RSLT($J("",5)_E(1)_"EDUCATION TOPIC EXISTS => "_N) Q
 S DLAYGO=9999999.09,DIC="^AUTTEDT(",X=N,DIC("DR")="1///"_O
 D FILE,ADDFAIL:Y<0,ADDOK:Y>0
 Q
 ;

AUM6102A
AUM6102A ; IHS/ADC/GTH - STANDARD TABLE UPDATES DATA A, 06DEC95 BANYAN ; [ 12/07/95  12:24 PM ]
 ;;96.1;TABLE MAINTENANCE;**2**;OCT 26,1995
 ;
 ;  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.
 ;
 ;
 ;
LOCNEW ; A.  NEW LOCATION CODES (SECTION VIII-C): AREA^S.U.^FAC.^NAME^PSEUDO
 ;;18^26^33^BEMIDJI TRIBAL HEALTH STATION^DAW
 ;;18^26^34^CASS LAKE TRIBAL FAMILY SVCS^DAX
 ;;18^26^35^BUGONAYGESHIG SCHOOL HS^DAY
 ;;55^62^13^DURANT HC^OAF
 ;;77^82^63^NARA RTC^PAS
 ;;77^82^64^NARA OTC^PAT
 ;;END
 ;
LOCMOD ; B.  LOCATION CODE CHANGES (SECTION VIII-C): AREA^S.U.^FAC.^NAME^PSEUDO
 ;;FROM^11^26^30^BALL CLUB HEALTH STA^DAJ
 ;;  TO^18^26^30^BALL CLUB TRIBAL HS^DAZ
 ;;FROM^11^26^31^INGER HEALTH STATION^DAK
 ;;  TO^18^26^31^INGER TRIBAL HEALTH STATION^DBJ
 ;;FROM^11^26^32^ONIGUM HEALTH STATION^DAL
 ;;  TO^18^26^32^ONIGUM TRIBAL HEALTH STATION^DBK
 ;;FROM^18^23^31^WHITEFISH BAY HEALTH STATION^DJK
 ;;  TO^18^23^31^BAY MILLS HEALTH CENTER^DJK
 ;;FROM^18^23^50^GRAND TRAVERSE BAY HS^DJN
 ;;  TO^18^23^50^GR TRAVERSE FAMILY HLTH CLIN^DJN
 ;;FROM^18^25^50^GRAND PORTAGE HEALTH STA^DLB
 ;;  TO^18^25^50^GRAND PORTAGE HEALTH CENTER^DLB
 ;;FROM^18^27^10^CHEQUAMEGON BAY HS^DNF
 ;;  TO^18^27^10^BAD RIVER HEALTH SERVICES^DNF
 ;;FROM^18^27^31^HERTEL HEALTH STATION^DNI
 ;;  TO^18^27^31^ST CROIX HEALTH CENTER^DNI
 ;;FROM^18^28^52^POTAWATOMI HLTH & WELLNESS CTR^DOF
 ;;  TO^18^28^52^POTAWATOMI HEALTH CENTER^DOF
 ;;FROM^18^34^30^KEWEENAW BAY HEALTH STATION^DSF
 ;;  TO^18^34^30^KEWEENAW BAY HEALTH CENTER^DSF
 ;;FROM^70^77^10^YELLOWHAWK^PGB
 ;;  TO^75^77^10^YELLOWHAWK^PAW
 ;;FROM^77^82^62^NARA (INPATIENT/OUTPATIENT)^PET
 ;;  TO^77^82^62^NARA HC^PET
 ;;END
 ;
LOCINACT ; C.  INACTIVE LOCATION CODES (SECTION VIII-C): AREA^S.U.^FAC.^NAME
 ;;18^22^31^WISCONSIN WINNEBAGO HL
 ;;18^22^56^WISC RAPIDS HEALTH LOC
 ;;18^23^54^SAULT TRIBAL CTR HS
 ;;18^23^58^JOSEPH LUMSDEN CTR HL
 ;;18^23^61^JOBS PROGRAM HL
 ;;77^82^30^PORTLAND URBAN CLINIC
 ;;END
 ;
COMMMOD ; F.  COMMUNITY CODE CHANGES (SECTION V-C): STATE^CNTY^COMM^NAME^AREA^S.U.
 ;;FROM^04^07^116^CO-OP COLONY^60^66
 ;;  TO^04^07^116^CO-OP COLONY^60^67
 ;;FROM^04^07^119^GILA CROSS'G^60^66
 ;;  TO^04^07^119^GILA CROSSING^60^67
 ;;FROM^04^07^124^KOMATKE^60^66
 ;;  TO^04^07^124^KOMATKE^60^67
 ;;FROM^04^07^125^LAVEEN^60^66
 ;;  TO^04^07^125^LAVEEN^60^67
 ;;FROM^04^07^127^LONE BUTTE^60^66
 ;;  TO^04^07^127^LONE BUTTE^60^67
 ;;FROM^04^07^128^MARICOPA COL^60^66
 ;;  TO^04^07^128^MARICOPA COLONY^60^67
 ;;FROM^04^07^799^KOMATKE HTS^60^66
 ;;  TO^04^07^799^KOMATKE HEIGHTS^60^67
 ;;END
 ;

AUM6102B
AUM6102B ; IHS/ADC/GTH - STANDARD TABLE UPDATES DATA B, FIELD REQUESTS ; [ 12/12/95  1:24 PM ]
 ;;96.1;TABLE MAINTENANCE;**2**;OCT 26,1995
 ;
 ;  If you do not want the entry made in your area, remove the line.
 ;
 ;  If you don't want the modification performed in your area, remove
 ;    the FROM and TO line for the modification you don't want done.
 ;
HFADD ; HEALTH FACTORS: FACTOR^CODE^CATEGORY^DISPLAY ON HEALTH SUMMARY^ENTRY TYPE
 ;;SMOKE FREE HOME^^TOBACCO^YES^FACTOR
 ;;END
 ;
EDTADD ; EDUCATION TOPICS : NAME^MNEMONIC
 ;;CHI-SLEEPING POSITION^CHI-SP
 ;;END
 ;

AUM6102M
AUM6102M ; IHS/ADC/GTH - BACKGROUND VALUES FOR STANDARD TABLE UPDATES, 06DEC95 BANYAN ; [ 12/07/95  2:23 PM ]
 ;;96.1;TABLE MAINTENANCE;**2**;OCT 26,1995
 ;
AREA ; CODE^NAME^PREFIX/REGION^CAN PREFIX
11 ;;11^BEMIDJI^D^J46
18 ;;18^BEMIDJI NON-IHS^D^J46
55 ;;55^OKLAHOMA TRIBE/638^O^J50
60 ;;60^PHOENIX^X^J40
70 ;;70^PORTLAND^P^J64
75 ;;75^PORTLAND TRIBE/638^P^J64
77 ;;77^PORTLAND URBAN^P^J64
 ;
SU ; AREA^SU^NAME
1126 ;;11^26^GREATER LEECH LAKE
1822 ;;18^22^CENTRAL WISCONSIN
1823 ;;18^23^EASTERN MICHIGAN
1825 ;;18^25^GRAND PORTAGE
1826 ;;18^26^LEECH LAKE
1827 ;;18^27^NORTHWESTERN WISCONSIN
1828 ;;18^28^NICOLET
1834 ;;18^34^WEST MICHIGAN
5562 ;;55^62^ADA
6066 ;;60^66^PHOENIX
6067 ;;60^67^SACATON
7077 ;;70^77^UMATILLA
7577 ;;75^77^UMATILLA
7782 ;;77^82^WESTERN OREGON URBAN
 ;
COUNTY ; STATE^COUNTY^NAME
0407 ;;04^07^MARICOPA
 ;

AUMXPORT
AUMXPORT ; IHS/ADC/GTH - MARK PT'S FOR REG EXPORT ; [ 12/12/95  1:27 PM ]
 ;;96.1;TABLE MAINTENANCE;**2**;OCT 26,1995
 ;
 Q
 ;
 ; ----------------------------------------------------------------
 ;
SETUP ;
 D NOW^%DTC
 S N=%
 S W="W:'$D(ZTQUEUED) ""."""
 I '$D(ZTQUEUED) W !,"Checking Patients for Export..." D WAIT^DICD
 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).
 ;
 ;  Patients are not marked if the only change is to Name of Community.
 ;
 NEW D,DFN,FROM,L,N,T,TO,W
 ;
 ; D = Site DUZ(2).
 ; L = Name of the community being processed.
 ; FROM = "FROM" string.
 ; TO = "TO" string.
 ; 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"  D
 . X W
 . S FROM=$P(L,U,2,99),TO=$P($T(COMMMOD+T+1^@AUMRTN),U,2,99)
 . I $P(FROM,U,1,3)=$P(TO,U,1,3),$P(FROM,U,5,6)=$P(TO,U,5,6) Q
 . S L=$P(TO,U,4),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)=""
 . ; If the Name changed, use the old name, too, since the CURRENT COMMUNITY field in PATIENT is free text, and doubtful to be updated.
 . I $P(FROM,U,4)'=$P(TO,U,4) S L=$P(FROM,U,4),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)=""
 .Q
 G COUNT
 ; ----------------------------------------------------------------
 ;
LOCMOD(AUMRTN) ;EP - SET ^AGPATCH for Location Code Changes.
 ;
 NEW D,DFN,FROM,L,N,T,TO,W
 ;
 D SETUP
 ;
 K ^TMP("AUMXPORT",$J)
 ;
 F T=1:2 S L=$T(LOCMOD+T^@AUMRTN) Q:$P(L,";",3)="END"  D
 . X W
 . S FROM=$P(L,U,2,99),TO=$P($T(LOCMOD+T+1^@AUMRTN),U,2,99)
 . I $P(FROM,U,1,3)=$P(TO,U,1,3) Q
 . S L=$P(TO,U,1,3),L=$TR(L,"^",""),D=$O(^AUTTLOC("C",L,0))
 . I D S ^TMP("AUMXPORT",$J,D)=""
 .Q
 ;
 S %="^AUPNPAT(""D"",0,0,0)"
 F  S %=$Q(@%) Q:'$L(%)  X:'((+$P(%,",",3))#1000) W I $D(^TMP("AUMXPORT",$J,+$P(%,",",4))) S ^AGPATCH(N,+$P(%,",",4),+$P(%,",",3))=""
 ;
 K ^TMP("AUMXPORT",$J)
 ;
 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 ; Return the number of patients marked for export because of change.
 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
 ;
ALL() ; W $$ALL^AUMXPORT()
 NEW D,DFN,L,N,T,W
 D SETUP
 S DFN=0,L=$P(^AUPNPAT(0),U,3)
 W !
 S DX=$X,DY=$Y
 F  S DFN=$O(^AUPNPAT(DFN)) Q:'DFN  I $D(^DPT(DFN)) S D=$O(^AUPNPAT(DFN,41,0)) I D S ^AGPATCH(N,D,DFN)="" I '(DFN#100) X IOXY W "On IEN ",DFN," of ",L," in ^AUPNPAT(..."
 ;
 W !!,"If you change your mind, you need to KILL ^AGPATCH(",N,").",!!
 I $$DIR^XBDIR("E")
 W !
 S DX=$X,DY=$Y,W="X IOXY W ""Counting..."",T"
 G COUNT
 ;