5:33 PM  07-NOV-2000
AUM v 99.1, Patch 16, Education Protocols 2000, restore 5 routines and DO ^AUM9116.
A9AUM16
A9AUM16 ; IHS/ASDST/GTH - STANDARD TABLE UPDATES, EDUCATION PROTOCOLS 2000, RPI ; [ 11/07/2000  5:32 PM ]
 ;;99.1;TABLE MAINTENANCE;**16**;NOV 6,1998
 ;
 D START^AUM9116
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 ;     
 ;;A9AUM15
 ;;AUM9116
 ;;AUM91161
 ;;AUM9116A
 ;;AUM9116M

AUM9116
AUM9116 ; IHS/ASDST/GTH - STANDARD TABLE UPDATES, EDUCATION PROTOCOLS 2000 ; [ 11/07/2000   5:20 PM ]
 ;;99.1;TABLE MAINTENANCE;**16**;NOV 6,1998
 ;
 I '$G(DUZ) W !,"DUZ UNDEFINED OR ZERO.",! Q
 D HOME^%ZIS,DT^DICRW,VP,HELP("INTRO")
 S (DIR(0),DIR("B"))="Y"
 S DIR("A")="Do you want to queue the update to TaskMan"
 S DIR("??")="^D HELP^AUM9116(""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 AUM9116
 S X=+Y
 D H^%DTC
 S ZTDTH=%H_","_%T
 S ZTRTN="START^AUM9116",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("AUM9116",$J)
 D START^AUM91161
 S XMSUB=$P($P($T(+1),";",2)," ",4,99),XMDUZ=$S($G(DUZ):DUZ,1:.5),XMTEXT="^TMP(""AUM9116"",$J,",XMY(1)="",XMY(DUZ)=""
 D ^XMD
 KILL ^TMP("AUM9116",$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^A9AUM16
 Q
 ;
INTRO ;
 ;;This updates standard tables according to the additions to the
 ;;EDUCATION TOPICS file specified by the committee for Patient
 ;;Education Protocols (PEP), as published in their 6th Edition,
 ;;dated June 2000.
 ;; 
 ;;A standard message will be produced by this update, listing the
 ;;additions to the EDUCATION TOPICS standard table.
 ;;  
 ;;PEP publications can be found at:
 ;;http://http://www.ihs.gov/medicalprograms/healthcare/clinicalguidelines/ProvPtEd.asp
 ;;  
 ;;Discussion of the protocols can be joined on the Clinical PSG
 ;;discussion board at:
 ;;http://www.forum.ihs.gov/~cpsg
 ;;
 ;;###
 ;
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
 ;
VP ;
 W !?4,"****    AUM Version ",$P($T(+2),";",3)," Patch ",$P($P($T(+2),";",5),"*",3),?65,"****"
 W !?4,"****   ",$P($P($T(+1),";",2),"-",2),?65,"****"
 Q
 ;
GREET ;;EP - To add to mail message.
 ;;  
 ;;Greetings.
 ;;  
 ;;Standard tables on your RPMS system have been updated.
 ;;  
 ;;You are receiving this message because of the particular RPMS
 ;;security keys that you hold.  This is for your information, only.
 ;;You need do nothing in response to this message.
 ;;  
 ;;Requests for modifications or additions to RPMS standard tables,
 ;;whether they are or are not reflected in the IHS Standard Code
 ;;Book (SCB), can be submitted to your Area Information System
 ;;Coordinator (ISC).
 ;;  
 ;;Questions about this patch, which is a product of the RPMS/DBA
 ;;Team, can be directed to the DIR/RPMS Support Center, at
 ;;505-248-4371, or via e-mail to "hqwhd@mail.ihs.gov".  Please
 ;;refer to patch "AUM*99.1*16".
 ;;  
 ;;###;NOTE: This line indicates the end of text in this message.
 ;

AUM91161
AUM91161 ; IHS/ASDST/GTH - STANDARD TABLE UPDATES, EDUCATION PROTOCOLS 2000 ; [ 11/07/2000  5:31 PM ]
 ;;99.1;TABLE MAINTENANCE;**16**;NOV 6,1998
 ;
 Q
 ;
START ;EP
 ;
 NEW A,C,DIC,DIE,DINUM,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^AUM9116A),";",3))
 F %=1:1 D RSLT($P($T(GREET+%^AUM9116),";",3)) Q:$P($T(GREET+%+1^AUM9116),";",3)="###"
 F %=1:1 D RSLT($P($T(INTRO+%^AUM9116),";",3)) Q:$P($T(INTRO+%+1^AUM9116),";",3)="###"
 D DASH,DD,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^AUM9116A),";",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("AUM9116",$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)
 ;
 ; -----------------------------------------------------
 ;
DD ;;MNEMONIC^RFX^^0;2^K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>7!($L(X)<1)!'(X?1.4UN1"-"1.4UN) X
 D RSLT("Updating the data dictionary for EDUCATION TOPICS,")
 D RSLT("input transform for MNEMONIC, to accommodate a MNEMONIC")
 D RSLT("of 7 characters length.  This is an increase from 6.")
 S ^DD(9999999.09,1,0)=$P($T(DD),";",3,4)
 S ^DD(9999999.09,1,"DT")=DT
 D RSLT("...update complete.")
 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^AUM9116A) 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
 ;

AUM9116A
AUM9116A ; IHS/ASDST/GTH - STANDARD TABLE UPDATES, EDUCATION PROTOCOLS 2000 ; [ 11/07/2000  5:21 PM ]
 ;;99.1;TABLE MAINTENANCE;**16**;NOV 6,1998
 ;
UPDATE ;;PATIENT EDUCATION PROTOCOLS 2000 - JUNE 2000
 ;
EDTADD ; EDUCATION TOPICS : NAME^MNEMONIC
 ;;AD-BENEFITS^AF-B
 ;;AD-FOLLOW-UP^AF-FU
 ;;AD-REFERRAL PROCESS^AF-REF
 ;;ADM-ORIENTATION^ADM-OR
 ;;ADM-PLAN OF CARE^ADM-POC
 ;;ADM-PT RIGHTS/RESPONSIBILITIES^ADM-RI
 ;;ADM-SAFETY/ACCIDENT PREVENTION^ADM-S
 ;;BF-GROWTH AND DEVELOPMENT^BF-GD
 ;;BF-MEDICATIONS (MATERNAL)^BF-M
 ;;BF-TEETHING^BF-T
 ;;CB-ANATOMY AND PHYSIOLOGY^CB-AP
 ;;CB-COMPLICATIONS^CB-C
 ;;CB-EXERCISE^CB-EX
 ;;CB-FOLLOW-UP^CB-FU
 ;;CB-PATIENT LITERATURE^CB-L
 ;;CB-LABOR SIGNS^CB-LB
 ;;CB-MEDICATIONS^CB-M
 ;;CB-ORIENTATION^CB-OR
 ;;CB-PAIN MANAGEMENT^CB-PM
 ;;CB-PROCEDURES^CB-PRO
 ;;CB-ROLE OF LABOR COACH^CB-RO
 ;;CP-DISEASE PROCESS^CP-DP
 ;;CP-FOLLOW-UP^CP-FU
 ;;CP-PATIENT LITERATURE^CP-L
 ;;CP-MEDICATIONS^CP-M
 ;;CP-NUTRITION^CP-N
 ;;CP-TESTS^CP-TE
 ;;DM-WOUND CARE^DM-WC
 ;;ELD-DISEASE PROCESS^ELD-DP
 ;;ELD-EXERCISE^ELD-EX
 ;;ELD-FOLLOW-UP^ELD-FU
 ;;ELD-PATIENT LITERATURE^ELD-L
 ;;ELD-LIFESTYLE ADAPTATIONS^ELD-LA
 ;;ELD-MEDICATIONS^ELD-M
 ;;ELD-NUTRITION^ELD-N
 ;;ELD-SAFETY/INJURY PREVENTION^ELD-S
 ;;EYE-COMPLICATIONS^EYE-C
 ;;EYE-DISEASE PROCESS^EYE-DP
 ;;EYE-FOLLOW-UP^EYE-FU
 ;;EYE-PATIENT LITERATURE^EYE-L
 ;;EYE-TREATMENT^EYE-TX
 ;;GB-ANATOMY AND PHYSIOLOGY^GB-AP
 ;;GB-COMPLICATIONS^GB-C
 ;;GB-DISEASE PROCESS^GB-DP
 ;;GB-FOLLOW-UP^GB-FU
 ;;GB-PATIENT LITERATURE^GB-L
 ;;GB-MEDICATIONS^GB-M
 ;;GB-NUTRITION^GB-N
 ;;GB-PREVENTION^GB-P
 ;;GB-PAIN MANAGEMENT^GB-PM
 ;;GB-PROCEDURES^GB-PRO
 ;;GB-TESTS^GB-TE
 ;;GE-COMPLICATIONS^GE-C
 ;;GE-DISEASE PROCESS^GE-DP
 ;;GE-FOLLOW-UP^GE-FU
 ;;GE-PATIENT LITERATURE^GE-L
 ;;GE-MEDICATIONS^GE-M
 ;;GE-NUTRITION^GE-N
 ;;GE-TESTS^GE-TE
 ;;GE-TREATMENT^GE-TX
 ;;HIV-DISEASE PROCESS^HIV-DP
 ;;HIV-FOLLOW-UP^HIV-FU
 ;;HIV-PATIENT LITERATURE^HIV-L
 ;;HIV-PREVENTION^HIV-P
 ;;HIV-TESTS^HIV-TE
 ;;HIV-TREATMENT^HIV-TX
 ;;IMP-DISEASE PROCESS^IMP-DP
 ;;IMP-FOLLOW-UP^IMP-FU
 ;;IMP-PATIENT LITERATURE^IMP-L
 ;;IMP-MEDICATIONS^IMP-M
 ;;IMP-PREVENTION^IMP-P
 ;;IMP-TREATMENT^IMP-TX
 ;;INJ-WOUND CARE^INJ-WC
 ;;KD-ANATOMY AND PHYSIOLOGY^KD-AP
 ;;KD-COMPLICATIONS^KD-C
 ;;KD-FOLLOW-UP^KD-FU
 ;;KD-PATIENT LITERATURE^KD-L
 ;;KD-MEDICATIONS^KD-M
 ;;KD-NUTRITION^KD-N
 ;;KD-PREVENTION^KD-P
 ;;KD-TREATMENT^KD-TX
 ;;OS-COMPLICATIONS^OS-C
 ;;OS-DISEASE PROCESS^OS-DP
 ;;OS-EXERCISE^OS-EX
 ;;OS-FOLLOW-UP^OS-FU
 ;;OS-PATIENT LITERATURE^OS-L
 ;;OS-MEDICATIONS^OS-M
 ;;OS-NUTRITION^OS-N
 ;;OS-PREVENTION^OS-P
 ;;OS-TESTS^OS-TE
 ;;OS-TREATMENT^OS-TX
 ;;PT-FOLLOW-UP^PT-FU
 ;;PT-INFORMATION^PT-I
 ;;PT-PATIENT LITERATURE^PT-L
 ;;PT-TREATMENT^PT-TX
 ;;PP-WOUND CARE^PP-WC
 ;;PN-COMPLICATIONS^PN-C
 ;;PL-INSENTIVE SPIROMETRY^PL-IS
 ;;SB-FOLLOW-UP^SB-FU
 ;;SB-PATIENT LITERATURE^SB-L
 ;;SB-PSYCHOTHERAPY^SB-PSY
 ;;SB-TREATMENT^SB-TX
 ;;SB-WELLNESS^SB-WL
 ;;SPE-WOUND CARE^SPE-WC
 ;;SWI-COMPLICATIONS^SWI-C
 ;;SWI-DISEASE PROCESS^SWI-DP
 ;;SWI-FOLLOW-UP^SWI-FU
 ;;SWI-PATIENT LITERATURE^SWI-L
 ;;SWI-MEDICATION^SWI-M
 ;;SWI-PREVENTION^SWI-P
 ;;SWI-WOUND CARE^SWI-WC
 ;;SZ-COMPLICATIONS^SZ-C
 ;;SZ-DISEASE PROCESS^SZ-DP
 ;;SZ-FOLLOW-UP^SZ-FU
 ;;SZ-PATIENT LITERATURE^SZ-L
 ;;SZ-LIFESTYLE ADAPTATION^SZ-LA
 ;;SZ-MEDICATIONS^SZ-M
 ;;SZ-SAFETY AND INJRY PREVENTION^SZ-S
 ;;WH-MEDS IN CHILDBEARING AGE^WH-M
 ;;WH-VAGINAL YEAST INFECTION^WH-VY
 ;;END
 ;
PRINT ;
 F %=1:1 S X=$P($T(EDTADD+%),";",3) Q:X="END"  W !,$P(X,"^",2),?10,$P(X,"^",1)
 Q
 ;

AUM9116M
AUM9116M ; IHS/ASDST/GTH -  BACKGROUND VALUES FOR STANDARD TABLE UPDATES, EDUCATION PROTOCOLS 2000 ; [ 11/07/2000   5:20 PM ]
 ;;99.1;TABLE MAINTENANCE;**16**;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
 ;;END
 ;
SU ; AREA^SU^NAME
 ;;END
 ;
COUNTY ; STATE^COUNTY^NAME
 ;;END
 ;