Routine: AMH30P4C

AMH30P4C ; IHS/BJI/GRL - Routine to create bulletin [ 01/19/05  8:06 AM ]

 ;;3.0;IHS BEHAVIORAL HEALTH;**4**;JAN 27, 2003

;;

 S DA=$O(^AMHPROB("C","ADHD, COMBINED TYPE",0))

 I DA S DIE="^AMHPROB(",DR=".02///ATTENTION-DEFICIT/HYPERACTIVITY DIS. - COMBINED TYPE" D ^DIE K DA,DR,DIE

 S DA=$O(^AMHPROB("C","ADHD, PREDOMINANTLY HYPERACTIV",0))

 I DA S DIE="^AMHPROB(",DR=".02///ATTENTION-DEFICIT/HYPERACTIVITY DIS. - PREDOM. HYPERACTIVE-IMPULSIVE TYPE" D ^DIE K DA,DR,DIE

 D ^XBFMK

PINAC ;do inactivations

 W !,"Inactivating MHSS PROBLEM CODES and DSM Codes:"

 F AMHJ=1:1 S AMHX=$T(INAC+AMHJ) Q:$P(AMHX,";;",2)=""  D

 .S AMHC=$P(AMHX,";;",2)

 .S DA=$O(^AMHPROB("B",AMHC,0))

 .I 'DA Q

 .W !?5,AMHC,?12," inactivated"

 .S DIE="^AMHPROB(",DR=".13////1;.14////"_DT

 .D ^DIE

 .I $D(Y) W !,"inactivating ",AMHC," failed."

 .K DA,DR,DIE,DIU,DIV,DIW

 .I $L($P(AMHC,"."))<3 S DA=$O(^AMHPROBC("B",AMHC,0)) D

 ..I 'DA D ^XBFMK Q

 ..W "  **"

 ..I DA S DIE="^AMHPROBC(",DR=".04////1" D ^DIE K DA,DIE,DR,DIU,DIV,DIW

.Q

PNAME ;now do name changes

 W !!,"Name changes on codes:"

 F AMHJ=1:1 S AMHX=$T(NAME+AMHJ) Q:$P(AMHX,";;",2)=""  D

 .S AMHC=$P(AMHX,";;",2)

 .S DA=$O(^AMHPROB("B",AMHC,0))

 .I 'DA Q

 .W !?5,AMHC,?12," changed from ",$P(^AMHPROB(DA,0),U,2)," to ",$P(AMHX,";;",3)

 .S DIE="^AMHPROB(",DR=".02///"_$P(AMHX,";;",3)

 .D ^DIE

 .I $D(Y) W !,"changing name ",AMHC," failed."

 .K DA,DR,DIE,DIU,DIV,DIW

 .I $L($P(AMHC,"."))<3 S DA=$O(^AMHPROBC("B",AMHC,0)) D

 ..I 'DA D ^XBFMK Q

 ..W "  **"

 ..I DA S DIE="^AMHPROBC(",DR=".02///"_$P(AMHX,";;",3) D ^DIE

 ..I $D(Y) W !,"   name change failed"

 ..D ^XBFMK

.Q

PCHG ;change codes

 W !!,"changing codes:"

 F AMHJ=1:1 S AMHX=$T(CHG+AMHJ) Q:$P(AMHX,";;",2)=""  D

 .S AMHC=$P(AMHX,";;",2)

 .S DA=$O(^AMHPROB("B",AMHC,0))

 .I 'DA Q

 .W !?5,"Changing ",AMHC," to ",$P(AMHX,";;",3)

 .S DIE="^AMHPROB(",DR=".01///"_$P(AMHX,";;",3)

 .D ^DIE

 .I $D(Y) W !,"changing code ",AMHC," failed."

 .K DA,DR,DIE,DIU,DIV,DIW

.Q

PADDS ;process adds

 ;add 46.3 to problem code file

 I '$O(^AMHPROBC("B","46.3",0)) S AMHC=46.3 D ADDPC

 S DA=$O(^AMHPROBC("B","46.3",0))

 I DA D

 .S DIE="^AMHPROBC(",DR=".02///RAPE (ALLEGED/SUSPECTED);.03///ABUSE"

 .D ^DIE

 ;if non-dsm add to MHSS PROBLEM CODES first, then add to dsm file

 D ^XBFMK

 W !!,"adding new codes:"

 F AMHJ=1:1 S AMHX=$T(ADD+AMHJ) Q:$P(AMHX,";;",2)=""  D

 .S AMHC=$P(AMHX,";;",2)  ;CODE

 .S AMHD=$P(AMHX,";;",3)  ;DESCRIPTION .02

 .S AMHM=$P(AMHX,";;",4)  ;MAP TO ICD .05

 .S AMHP=$P(AMHX,";;",5)  ;MHSS PROBLEM CODE

 .S AMHCAT=$P(AMHX,";;",6)  ;CATEGORY

 .;add to mhss problem codes if appropriate

 .W !?5,"adding ",AMHC

 .I $L($P(AMHC,"."))<3 D

 ..D ^XBFMK

 ..S DA=$O(^AMHPROBC("B",AMHC,0))

 ..I 'DA D ADDPC

 ..I 'DA Q

 ..;now edit the code

 ..S DIE="^AMHPROBC(",DR=".02///"_AMHD_";.03///"_AMHCAT

 ..D ^DIE

 ..I $D(Y) W "    editing problem code failed"

 .D ^XBFMK

 .S DA=$O(^AMHPROB("B",AMHC,0))

 .I DA W "  Already have code ",AMHC," will edit." G PADDSE

 .S X=AMHC,DIC="^AMHPROB(",DIC(0)="L" K DD,D0,DO S DIADD=1,DLAYGO=9002012.2 D FILE^DICN K DIADD,DLAYGO,DD,DO,D0

 .I Y=-1 W "  adding failed in dsm file" D ^XBFMK Q

 .S DA=+Y

PADDSE .;

 .S DIE="^AMHPROB(",DR=".02///"_AMHD_";.05///"_AMHM_";.03///"_AMHP

 .D ^DIE

 .I $D(Y) W " editing ",AMHC," failed dsm file."

 .K DA,DR,DIE,DIU,DIV,DIW

.Q

PCCHG ;change codes

 W !!,"changing codes:"

 F AMHJ=1:1 S AMHX=$T(PCHGS+AMHJ) Q:$P(AMHX,";;",2)=""  D

 .S AMHC=$P(AMHX,";;",2)

 .S DA=$O(^AMHPROB("B",AMHC,0))

 .I 'DA Q

 .W !?5,"Changing ",AMHC," to MAP TO PROBLEM CODE",$P(AMHX,";;",3)

 .S DIE="^AMHPROB(",DR=".03///"_$P(AMHX,";;",3)

 .D ^DIE

 .I $D(Y) W !,"changing code ",AMHC," failed."

 .K DA,DR,DIE,DIU,DIV,DIW

.Q

MAPC ;

 W !,"Remapping MHSS PROBLEM CODES and DSM Codes to ICD9 dx codes:"

 F AMHJ=1:1 S AMHX=$T(MAP+AMHJ) Q:$P(AMHX,";;",2)=""  D

 .S AMHC=$P(AMHX,";;",2)

 .S DA=$O(^AMHPROB("B",AMHC,0))

 .I 'DA Q

 .W !?5,AMHC,?12," mapped to ICD9"

 .S DIE="^AMHPROB(",DR=".05///"_$P(AMHX,";;",3)

 .D ^DIE

 .I $D(Y) W !,"mapping ",AMHC," failed."

 .K DA,DR,DIE,DIU,DIV,DIW

.Q

NEWADDS ;

 ;loop through AMHTPCA and add

 S AMHX=0 F  S AMHX=$O(^AMHTPCAD(AMHX)) Q:AMHX'=+AMHX  D

 .S AMHC=$P(^AMHTPCAD(AMHX,0),U) I AMHC="" W !,"error in file ADDS ",AMHX Q

 .S AMHD=$P(^AMHTPCAD(AMHX,0),U,2) I AMHD="" W !,"error in description ADDS ",AMHX Q

 .S AMHI=$P(^AMHTPCAD(AMHX,0),U,5) I AMHI="" S AMHI=AMHC

 .S AMHP=$P(^AMHTPCAD(AMHX,0),U,3) I AMHP="" W !,"error in problem code adds ",AMHX Q

 .S AMHP=$O(^AMHPROBC("B",AMHP,0)) I AMHP="" W !,"error in problem code adds ",AMHX Q

 .;FIND CODE AND SKIP IF ALREADY THERE

 .S X=0,G=0 F  S X=$O(^AMHPROB("B",AMHC,X)) Q:X'=+X!(G)  I $P(^AMHPROB(X,0),U,2)=AMHD S G=X

 .I G D EDIT Q  ;already there

 .;add code, force add

 .K DD,D0,DO,DIADD,DLAYGO D ^XBFMK

 .S X=AMHC,DIC="^AMHPROB(",DIC(0)="L",DIADD=1,DLAYGO=9002012.2,DIC("DR")=".02///"_AMHD_";.03///`"_AMHP_";.05///"_AMHI D FILE^DICN

 .I Y=-1 W !,"error in file^dicn in adding new code ",AMHC

 .W !,"added ",AMHC," ",AMHD

 .D ^XBFMK K DD,D0,DO,DIADD,DLAYGO

.Q

EDIT ;

 D ^XBFMK

 S DA=G,DIE="^AMHPROB(",DR=".02///"_AMHD_";.03///`"_AMHP_";.05///"_AMHI_";.14///@" D ^DIE

 D ^XBFMK

ADDPC ;

 S X=AMHC,DIC="^AMHPROBC(",DIC(0)="L" K DD,D0,DO S DIADD=1,DLAYGO=9002012.4 D FILE^DICN K DIADD,DLAYGO,DD,DO,D0

 I Y=-1 W "  adding failed." Q

 S DA=+Y

PCHGS ;;

 ;;89.1;;89.1

 ;;290.40;;12

 ;;290.41;;12

 ;;290.42;;12

 ;;290.43;;12

 ;;291.1;;12.1

 ;;291.2;;12.1

 ;;291.3;;17.1

 ;;291.5;;18.1

 ;;292.81;;12.1

 ;;292.82;;12.1

 ;;292.83;;12.1

 ;;293.81;;17

 ;;293.82;;17

 ;;293.83;;17

 ;;293.84;;17

 ;;300.11;;37.1

 ;;300.81;;37.1

 ;;305.90;;30

 ;;305.91;;30

 ;;305.92;;30

 ;;305.93;;30

 ;;292.9;;11

 ;;307.1;;23

 ;;307.80;;37.1

 ;;307.89;;37.1

 ;;317.;;35

 ;;318.0;;35

 ;;318.1;;35

 ;;318.2;;35

 ;;780.93;;38

 ;;995.53;;42.3

 ;;995.54;;42.1

;;

INAC ;;

;;6

;;9

 ;;33

 ;;34

 ;;45

 ;;45.2

 ;;46.1

 ;;46.3

 ;;47.2

 ;;48.2

 ;;49.2

 ;;290.0

 ;;290.10

 ;;290.11

 ;;290.12

 ;;290.13

 ;;290.20

 ;;290.21

 ;;290.3

 ;;291.0

 ;;291.8

 ;;291.89

 ;;292.0

 ;;292.11

 ;;292.12

 ;;292.81

 ;;292.82

 ;;292.83

 ;;292.84

 ;;292.89

 ;;292.9

 ;;294.8

 ;;296.40

 ;;299.80

 ;;300.19

 ;;300.7

 ;;302.6

 ;;302.72

 ;;302.9

 ;;304.60

 ;;305.90

 ;;305.91

 ;;305.92

 ;;305.93

 ;;307.42

 ;;307.44

 ;;307.46

 ;;307.47

 ;;314.01

 ;;608.89

 ;;625.8

 ;;780.59

 ;;799.9

 ;;294.1

 ;;312.8

 ;;347.

;;

CHG ;;

 ;;780.9;;780.93

;;

NAME ;;

 ;;2;;CROSS-CULTURAL CONFLICT

 ;;12.1;;SUBSTANCE-INDUCED DELIRIUM, DEMENTIA, AMNESTIC AND OTHER COGNITIVE DISORDERS

 ;;17;;PSYCHOTIC DISORDER NOS

 ;;21;;COMMUNICATION DISORDER NOS

 ;;25;;DISRUPTIVE BEHAVIOR DISORDER NOS

 ;;36;;PSYCHOLOGICAL FACTOR AFFECTING MEDICAL CONDITION

 ;;45.1;;ABUSIVE BEHAVIOR (ALLEGED),PHY/EMOT: ADULT VICTIM: FOCUS ON PERP (PARTNER)

 ;;45.3;;ABUSIVE BEHAVIOR (ALLEGED),SEXUAL: ADULT VICTIM: FOCUS ON PERP (PARTNER)

 ;;47;;CHILD NEGLECT (SUSPECTED) - NUTRITIONAL

 ;;47.1;;CHILD NEGLECT (SUSPECTED), OTHER THAN NUTRITIONAL

 ;;48;;ADULT NEGLECT (SUSPECTED), UNSPECIFIED

 ;;48.1;;ADULT NEGLECT (SUSPECTED), NUTRITIONAL

 ;;49;;PARTNER NEGLECT (SUSPECTED), UNSPECIFIED

 ;;49.1;;PARTNER NEGLECT (SUSPECTED), NUTRITIONAL

 ;;49.9;;EXPLOITATION (ADULT)

 ;;54.1;;DEATH (PATIENT EXPIRED)

 ;;54.2;;DYING, END OF LIFE CARE

 ;;64;;ADOPTION (REFERRAL)

 ;;84;;OCCUPATIONAL MALADJUSTMENT

 ;;89.1;;ALTERNATIVE EDUCATION SERVICES

 ;;92;;VOCATIONAL REHABILITATION SERVICES

 ;;312.39;;TRICHOTILLOMANIA

 ;;312.89;;CONDUCT DISORDER, UNSPECIFIED ONSET

 ;;291.1;;ALCOHOL INDUCED AMNESTIC DISORDER

 ;;300.81;;SOMATIZATION DISORDER

 ;;314.00;;ATTENTION-DEFICIT/HYPERACTIVITY DIS. - PREDOM. INATTENTIVE TYPE

 ;;314.9;;ATTENTION-DEFICIT/HYPERACTIVITY DIS. NOS

;;

MAP ;;

 ;;8.1;;@

 ;;8.2;;@

 ;;8.21;;@

 ;;9;;294.8

 ;;12;;294.9

 ;;12.1;;294.9

 ;;14;;311.

 ;;15;;296.80

 ;;16;;297.1

 ;;21.1;;995.2

 ;;25;;312.9

 ;;32;;299.80

 ;;42;;995.50

 ;;42.1;;995.54

 ;;42.2;;995.51

 ;;42.3;;995.53

 ;;43;;995.80

 ;;43.1;;995.81

 ;;43.2;;995.82

 ;;43.3;;995.83

 ;;44;;995.80

 ;;44.1;;995.81

 ;;44.2;;995.82

 ;;44.3;;995.83

 ;;45.1;;V61.12

 ;;45.3;;V61.12

 ;;46;;995.83

 ;;47;;995.52

 ;;47.1;;995.51

 ;;48;;995.80

 ;;48.1;;995.84

 ;;49;;995.80

 ;;49.1;;995.84

 ;;49.9;;995.80

 ;;54.1;;@

 ;;64;;V68.89

 ;;72;;V60.4

 ;;82;;V62.2

 ;;84;;V62.2

 ;;294.10;;294.1

 ;;95;;@

 ;;96;;@

 ;;97;;@

 ;;98;;@

 ;;99;;@

 ;;294.8;;290.0

 ;;305.10;;305.10

 ;;312.89;;312.89

 ;;314.9;;314.9

 ;;995.5;;995.50

 ;;780.93;;780.93

;;

ADD ;;

 ;;1.1;;HEALTH PROMOTION/DISEASE PREVENTION;;V65.49;;1.1;;MEDICAL/SOCIAL PROBLEMS

 ;;6.1;;PHYSICAL ILLNESS, CHRONIC;;V15.89;;6.1;;MEDICAL/SOCIAL PROBLEMS

 ;;6.2;;PHYSICAL ILLNESS, TERMINAL;;V15.89;;6.2;;MEDICAL/SOCIAL PROBLEMS

 ;;9.1;;PRE-SENILE CONDITION;;290.10;;9.1;;PSYCHOSOCIAL PROBLEMS

 ;;9.2;;SENILE CONDITION;;290.0;;9.2;;PSYCHOSOCIAL PROBLEMS

 ;;8.4;;MALINGERING;;V65.2;;8.4;;MEDICAL/SOCIAL PROBLEMS

 ;;12.1;;SUBSTANCE-INDUCED DELIRIUM, DEMENTIA, AMNESTIC AND OTHER COGNITIVE DISORDERS;;294.8;;12.1;;PSYCHOSOCIAL PROBLEMS

 ;;14.2;;ALCOHOL OR DRUG INDUCED MOOD DISORDER,NOS;;296.90;;14.2;;PSYCHOSOCIAL PROBLEMS

 ;;17.1;;ALCOHOL OR DRUG INDUCED PSYCHOTIC DISORDER, NOS;;298.9;;17.1;;PSYCHOSOCIAL PROBLEMS

 ;;18.1;;ALCOHOL OR DRUG INDUCED ANXIETY DISORDER;;300.00;;18.1;;PSYCHOSOCIAL PROBLEMS

 ;;20.1;;ALCOHOL OR DRUG INDUCED PSYCHOSEXUAL DISORDER;;302.9;;20.1;;PSYCHOSOCIAL PROBLEMS

 ;;22.1;;ALCOHOL OR DRUG INDUCED SLEEP DISORDER;;307.47;;22.1;;PSYCHOSOCIAL PROBLEMS

 ;;29.2;;SCREENING FOR DRUG ABUSE;;V79.8;;29.2;;SCREENING

 ;;37.1;;SOMATOFORM DISORDERS;;300.82;;37.1;;PSYCHOSOCIAL PROBLEMS

 ;;42.11;;SHAKEN BABY SYNDROME;;995.55;;42.11;;ABUSE

 ;;42.4;;OTHER CHILD ABUSE & NEGLECT (MULTIPLE FORMS OF ABUSE/NEGLECT);;995.59;;42.4;;ABUSE

 ;;43.4;;OTHER PARTNER ABUSE & NEGLECT (MULTIPLE FORMS OF ABUSE/NEGLECT);;995.85;;43.4;;ABUSE

 ;;44.4;;OTHER ADULT ABUSE AND NEGLECT (MULTIPLE FORMS OF ABUSE/NEGLECT);;995.85;;44.4;;ABUSE

 ;;45.11;;ABUSIVE BEH (ALLEGED), PHYS/EMOT: ADULT VICTIM: FOCUS ON PERP (NON-PARTNER);;V62.83;;45.11;;ABUSE

 ;;45.12;;ABUSIVE BEH (ALLEGED), PHYS/EMOT:CHILD VICTIM: FOCUS ON PERP (PARENT);;V61.22;;45.12;;ABUSE

 ;;45.13;;ABUSIVE BEH (ALLEGED), PHYS/EMOT: CHILD VICTIM: FOCUS ON PERP (NON-PARENT);;V62.83;;45.13;;ABUSE

 ;;45.31;;ABUSIVE BEH (ALLEGED), SEXUAL: ADULT VICTIM: FOCUS ON PERP (NON-PARTNER);;V62.83;;45.31;;ABUSE

 ;;45.32;;ABUSIVE BEH (ALLEGED), SEXUAL: CHILD VICTIM: FOCUS ON PERP (PARENT);;V61.22;;45.32;;ABUSE

 ;;45.33;;ABUSIVE BEH (ALLEGED), SEXUAL: CHILD VICTIM: FOCUS ON PERP (NON-PARENT);;V62.83;;45.33;;ABUSE

 ;;64.1;;ADOPTION (COUNSELING);;V61.29;;64.1;;PREGNANCY/CHILDBIRTH PROBLEMS

 ;;72.1;;FOSTER CARE (COUNSELING);;V61.29;;72.1;;OUT OF HOME CARE

 ;;82.1;;UNEMPLOYMENT;;V62.0;;82.1;;SOCIOECONOMIC PROBLEMS

 ;;89.1;;ALTERNATIVE EDUCATION SERVICES;;;;89.1;;EDUCATIONAL/LIFE PROBLEMS

 ;;94.1;;RELIGIOUS OR SPIRITUAL PROBLEM;;V62.89;;94.1;;EDUCATIONAL/LIFE PROBLEMS

 ;;94.2;;BORDERLINE INTELLECTUAL FUNCTIONING;;V62.89;;94.2;;EDUCATIONAL/LIFE PROBLEMS

 ;;315.32;;MIXED RECEPTIVE-EXPRESSIVE LANGUAGE DISORDER;;315.32;;32

 ;;995.51;;CHILD ABUSE (EMOTIONAL)/NEGLECT (SUSPECTED) - OTHER THAN NUTRITIONAL;;995.51;;42.2

 ;;995.55;;SHAKEN BABY SYNDROME;;995.55;;42.11

 ;;995.82;;ADULT ABUSE (SUSPECTED), EMOTIONAL;;995.82;;44.2

 ;;995.83;;ADULT ABUSE (SUSPECTED), SEXUAL;;995.83;;44.3

 ;;995.85;;OTHER ADULT ABUSE AND NEGLECT (MULTIPLE FORMS OF ABUSE/NEGLECT);;995.85;;44.4

 ;;347.00;;NARCOLEPSY WITHOUT CATAPLEXY;;347.00;;22

 ;;347.01;;NARCOLEPSY WITH CATAPLEXY;;347.01;;22

 ;;347.10;;NARCOLEPSY COND W/O CATAPLEXY;;347.10;;22

 ;;347.11;;NARCOLEPSY COND WITH CATAPLEXY;;347.11;;22

;;

AMH30P4C  ; IHS/BJI/GRL - Routine to create bulletin [ 01/19/05  8:06 AM ]

 +1       ;;3.0;IHS BEHAVIORAL HEALTH;**4**;JAN 27, 2003

 +2       ;;

 +3        SET DA=$ORDER(^AMHPROB("C","ADHD, COMBINED TYPE",0))

 +4        IF DA

               SET DIE="^AMHPROB("

               SET DR=".02///ATTENTION-DEFICIT/HYPERACTIVITY DIS. - COMBINED TYPE"

               DO ^DIE

               KILL DA,DR,DIE

 +5        SET DA=$ORDER(^AMHPROB("C","ADHD, PREDOMINANTLY HYPERACTIV",0))

 +6        IF DA

               SET DIE="^AMHPROB("

               SET DR=".02///ATTENTION-DEFICIT/HYPERACTIVITY DIS. - PREDOM. HYPERACTIVE-IMPULSIVE TYPE"

               DO ^DIE

               KILL DA,DR,DIE

 +7        DO ^XBFMK

PINAC     ;do inactivations

 +1        WRITE !,"Inactivating MHSS PROBLEM CODES and DSM Codes:"

 +2        FOR AMHJ=1:1

               SET AMHX=$TEXT(INAC+AMHJ)

               IF $PIECE(AMHX,";;",2)=""

                   QUIT

               Begin DoDot:1

 +3                SET AMHC=$PIECE(AMHX,";;",2)

 +4                SET DA=$ORDER(^AMHPROB("B",AMHC,0))

 +5                IF 'DA

                       QUIT

 +6                WRITE !?5,AMHC,?12," inactivated"

 +7                SET DIE="^AMHPROB("

                   SET DR=".13////1;.14////"_DT

 +8                DO ^DIE

 +9                IF $DATA(Y)

                       WRITE !,"inactivating ",AMHC," failed."

 +10               KILL DA,DR,DIE,DIU,DIV,DIW

 +11               IF $LENGTH($PIECE(AMHC,"."))<3

                       SET DA=$ORDER(^AMHPROBC("B",AMHC,0))

                       Begin DoDot:2

 +12                       IF 'DA

                               DO ^XBFMK

                               QUIT

 +13                       WRITE "  **"

 +14                       IF DA

                               SET DIE="^AMHPROBC("

                               SET DR=".04////1"

                               DO ^DIE

                               KILL DA,DIE,DR,DIU,DIV,DIW

                       End DoDot:2

 +15               QUIT

               End DoDot:1

PNAME     ;now do name changes

 +1        WRITE !!,"Name changes on codes:"

 +2        FOR AMHJ=1:1

               SET AMHX=$TEXT(NAME+AMHJ)

               IF $PIECE(AMHX,";;",2)=""

                   QUIT

               Begin DoDot:1

 +3                SET AMHC=$PIECE(AMHX,";;",2)

 +4                SET DA=$ORDER(^AMHPROB("B",AMHC,0))

 +5                IF 'DA

                       QUIT

 +6                WRITE !?5,AMHC,?12," changed from ",$PIECE(^AMHPROB(DA,0),U,2)," to ",$PIECE(AMHX,";;",3)

 +7                SET DIE="^AMHPROB("

                   SET DR=".02///"_$PIECE(AMHX,";;",3)

 +8                DO ^DIE

 +9                IF $DATA(Y)

                       WRITE !,"changing name ",AMHC," failed."

 +10               KILL DA,DR,DIE,DIU,DIV,DIW

 +11               IF $LENGTH($PIECE(AMHC,"."))<3

                       SET DA=$ORDER(^AMHPROBC("B",AMHC,0))

                       Begin DoDot:2

 +12                       IF 'DA

                               DO ^XBFMK

                               QUIT

 +13                       WRITE "  **"

 +14                       IF DA

                               SET DIE="^AMHPROBC("

                               SET DR=".02///"_$PIECE(AMHX,";;",3)

                               DO ^DIE

 +15                       IF $DATA(Y)

                               WRITE !,"   name change failed"

 +16                       DO ^XBFMK

                       End DoDot:2

 +17               QUIT

               End DoDot:1

PCHG      ;change codes

 +1        WRITE !!,"changing codes:"

 +2        FOR AMHJ=1:1

               SET AMHX=$TEXT(CHG+AMHJ)

               IF $PIECE(AMHX,";;",2)=""

                   QUIT

               Begin DoDot:1

 +3                SET AMHC=$PIECE(AMHX,";;",2)

 +4                SET DA=$ORDER(^AMHPROB("B",AMHC,0))

 +5                IF 'DA

                       QUIT

 +6                WRITE !?5,"Changing ",AMHC," to ",$PIECE(AMHX,";;",3)

 +7                SET DIE="^AMHPROB("

                   SET DR=".01///"_$PIECE(AMHX,";;",3)

 +8                DO ^DIE

 +9                IF $DATA(Y)

                       WRITE !,"changing code ",AMHC," failed."

 +10               KILL DA,DR,DIE,DIU,DIV,DIW

 +11               QUIT

               End DoDot:1

PADDS     ;process adds

 +1       ;add 46.3 to problem code file

 +2        IF '$ORDER(^AMHPROBC("B","46.3",0))

               SET AMHC=46.3

               DO ADDPC

 +3        SET DA=$ORDER(^AMHPROBC("B","46.3",0))

 +4        IF DA

               Begin DoDot:1

 +5                SET DIE="^AMHPROBC("

                   SET DR=".02///RAPE (ALLEGED/SUSPECTED);.03///ABUSE"

 +6                DO ^DIE

               End DoDot:1

 +7       ;if non-dsm add to MHSS PROBLEM CODES first, then add to dsm file

 +8        DO ^XBFMK

 +9        WRITE !!,"adding new codes:"

 +10       FOR AMHJ=1:1

               SET AMHX=$TEXT(ADD+AMHJ)

               IF $PIECE(AMHX,";;",2)=""

                   QUIT

               Begin DoDot:1

 +11      ;CODE

                   SET AMHC=$PIECE(AMHX,";;",2)

 +12      ;DESCRIPTION .02

                   SET AMHD=$PIECE(AMHX,";;",3)

 +13      ;MAP TO ICD .05

                   SET AMHM=$PIECE(AMHX,";;",4)

 +14      ;MHSS PROBLEM CODE

                   SET AMHP=$PIECE(AMHX,";;",5)

 +15      ;CATEGORY

                   SET AMHCAT=$PIECE(AMHX,";;",6)

 +16      ;add to mhss problem codes if appropriate

 +17               WRITE !?5,"adding ",AMHC

 +18               IF $LENGTH($PIECE(AMHC,"."))<3

                       Begin DoDot:2

 +19                       DO ^XBFMK

 +20                       SET DA=$ORDER(^AMHPROBC("B",AMHC,0))

 +21                       IF 'DA

                               DO ADDPC

 +22                       IF 'DA

                               QUIT

 +23      ;now edit the code

 +24                       SET DIE="^AMHPROBC("

                           SET DR=".02///"_AMHD_";.03///"_AMHCAT

 +25                       DO ^DIE

 +26                       IF $DATA(Y)

                               WRITE "    editing problem code failed"

                       End DoDot:2

 +27               DO ^XBFMK

 +28               SET DA=$ORDER(^AMHPROB("B",AMHC,0))

 +29               IF DA

                       WRITE "  Already have code ",AMHC," will edit."

                       GOTO PADDSE

 +30               SET X=AMHC

                   SET DIC="^AMHPROB("

                   SET DIC(0)="L"

                   KILL DD,D0,DO

                   SET DIADD=1

                   SET DLAYGO=9002012.2

                   DO FILE^DICN

                   KILL DIADD,DLAYGO,DD,DO,D0

 +31               IF Y=-1

                       WRITE "  adding failed in dsm file"

                       DO ^XBFMK

                       QUIT

 +32               SET DA=+Y

PADDSE    ;

 +1                SET DIE="^AMHPROB("

                   SET DR=".02///"_AMHD_";.05///"_AMHM_";.03///"_AMHP

 +2                DO ^DIE

 +3                IF $DATA(Y)

                       WRITE " editing ",AMHC," failed dsm file."

 +4                KILL DA,DR,DIE,DIU,DIV,DIW

 +5                QUIT

               End DoDot:1

PCCHG     ;change codes

 +1        WRITE !!,"changing codes:"

 +2        FOR AMHJ=1:1

               SET AMHX=$TEXT(PCHGS+AMHJ)

               IF $PIECE(AMHX,";;",2)=""

                   QUIT

               Begin DoDot:1

 +3                SET AMHC=$PIECE(AMHX,";;",2)

 +4                SET DA=$ORDER(^AMHPROB("B",AMHC,0))

 +5                IF 'DA

                       QUIT

 +6                WRITE !?5,"Changing ",AMHC," to MAP TO PROBLEM CODE",$PIECE(AMHX,";;",3)

 +7                SET DIE="^AMHPROB("

                   SET DR=".03///"_$PIECE(AMHX,";;",3)

 +8                DO ^DIE

 +9                IF $DATA(Y)

                       WRITE !,"changing code ",AMHC," failed."

 +10               KILL DA,DR,DIE,DIU,DIV,DIW

 +11               QUIT

               End DoDot:1

MAPC      ;

 +1        WRITE !,"Remapping MHSS PROBLEM CODES and DSM Codes to ICD9 dx codes:"

 +2        FOR AMHJ=1:1

               SET AMHX=$TEXT(MAP+AMHJ)

               IF $PIECE(AMHX,";;",2)=""

                   QUIT

               Begin DoDot:1

 +3                SET AMHC=$PIECE(AMHX,";;",2)

 +4                SET DA=$ORDER(^AMHPROB("B",AMHC,0))

 +5                IF 'DA

                       QUIT

 +6                WRITE !?5,AMHC,?12," mapped to ICD9"

 +7                SET DIE="^AMHPROB("

                   SET DR=".05///"_$PIECE(AMHX,";;",3)

 +8                DO ^DIE

 +9                IF $DATA(Y)

                       WRITE !,"mapping ",AMHC," failed."

 +10               KILL DA,DR,DIE,DIU,DIV,DIW

 +11               QUIT

               End DoDot:1

NEWADDS   ;

 +1       ;loop through AMHTPCA and add

 +2        SET AMHX=0

FOR

               SET AMHX=$ORDER(^AMHTPCAD(AMHX))

               IF AMHX'=+AMHX

                   QUIT

               Begin DoDot:1

 +3                SET AMHC=$PIECE(^AMHTPCAD(AMHX,0),U)

                   IF AMHC=""

                       WRITE !,"error in file ADDS ",AMHX

                       QUIT

 +4                SET AMHD=$PIECE(^AMHTPCAD(AMHX,0),U,2)

                   IF AMHD=""

                       WRITE !,"error in description ADDS ",AMHX

                       QUIT

 +5                SET AMHI=$PIECE(^AMHTPCAD(AMHX,0),U,5)

                   IF AMHI=""

                       SET AMHI=AMHC

 +6                SET AMHP=$PIECE(^AMHTPCAD(AMHX,0),U,3)

                   IF AMHP=""

                       WRITE !,"error in problem code adds ",AMHX

                       QUIT

 +7                SET AMHP=$ORDER(^AMHPROBC("B",AMHP,0))

                   IF AMHP=""

                       WRITE !,"error in problem code adds ",AMHX

                       QUIT

 +8       ;FIND CODE AND SKIP IF ALREADY THERE

 +9                SET X=0

                   SET G=0

FOR

                       SET X=$ORDER(^AMHPROB("B",AMHC,X))

                       IF X'=+X!(G)

                           QUIT

                       IF $PIECE(^AMHPROB(X,0),U,2)=AMHD

                           SET G=X

 +10      ;already there

                   IF G

                       DO EDIT

                       QUIT

 +11      ;add code, force add

 +12               KILL DD,D0,DO,DIADD,DLAYGO

                   DO ^XBFMK

 +13               SET X=AMHC

                   SET DIC="^AMHPROB("

                   SET DIC(0)="L"

                   SET DIADD=1

                   SET DLAYGO=9002012.2

                   SET DIC("DR")=".02///"_AMHD_";.03///`"_AMHP_";.05///"_AMHI

                   DO FILE^DICN

 +14               IF Y=-1

                       WRITE !,"error in file^dicn in adding new code ",AMHC

 +15               WRITE !,"added ",AMHC," ",AMHD

 +16               DO ^XBFMK

                   KILL DD,D0,DO,DIADD,DLAYGO

 +17               QUIT

               End DoDot:1

 +18       QUIT

EDIT      ;

 +1        DO ^XBFMK

 +2        SET DA=G

           SET DIE="^AMHPROB("

           SET DR=".02///"_AMHD_";.03///`"_AMHP_";.05///"_AMHI_";.14///@"

           DO ^DIE

 +3        DO ^XBFMK

 +4        QUIT

ADDPC     ;

 +1        SET X=AMHC

           SET DIC="^AMHPROBC("

           SET DIC(0)="L"

           KILL DD,D0,DO

           SET DIADD=1

           SET DLAYGO=9002012.4

           DO FILE^DICN

           KILL DIADD,DLAYGO,DD,DO,D0

 +2        IF Y=-1

               WRITE "  adding failed."

               QUIT

 +3        SET DA=+Y

 +4        QUIT

PCHGS     ;;

 +1       ;;89.1;;89.1

 +2       ;;290.40;;12

 +3       ;;290.41;;12

 +4       ;;290.42;;12

 +5       ;;290.43;;12

 +6       ;;291.1;;12.1

 +7       ;;291.2;;12.1

 +8       ;;291.3;;17.1

 +9       ;;291.5;;18.1

 +10      ;;292.81;;12.1

 +11      ;;292.82;;12.1

 +12      ;;292.83;;12.1

 +13      ;;293.81;;17

 +14      ;;293.82;;17

 +15      ;;293.83;;17

 +16      ;;293.84;;17

 +17      ;;300.11;;37.1

 +18      ;;300.81;;37.1

 +19      ;;305.90;;30

 +20      ;;305.91;;30

 +21      ;;305.92;;30

 +22      ;;305.93;;30

 +23      ;;292.9;;11

 +24      ;;307.1;;23

 +25      ;;307.80;;37.1

 +26      ;;307.89;;37.1

 +27      ;;317.;;35

 +28      ;;318.0;;35

 +29      ;;318.1;;35

 +30      ;;318.2;;35

 +31      ;;780.93;;38

 +32      ;;995.53;;42.3

 +33      ;;995.54;;42.1

 +34      ;;

INAC      ;;

 +1       ;;6

 +2       ;;9

 +3       ;;33

 +4       ;;34

 +5       ;;45

 +6       ;;45.2

 +7       ;;46.1

 +8       ;;46.3

 +9       ;;47.2

 +10      ;;48.2

 +11      ;;49.2

 +12      ;;290.0

 +13      ;;290.10

 +14      ;;290.11

 +15      ;;290.12

 +16      ;;290.13

 +17      ;;290.20

 +18      ;;290.21

 +19      ;;290.3

 +20      ;;291.0

 +21      ;;291.8

 +22      ;;291.89

 +23      ;;292.0

 +24      ;;292.11

 +25      ;;292.12

 +26      ;;292.81

 +27      ;;292.82

 +28      ;;292.83

 +29      ;;292.84

 +30      ;;292.89

 +31      ;;292.9

 +32      ;;294.8

 +33      ;;296.40

 +34      ;;299.80

 +35      ;;300.19

 +36      ;;300.7

 +37      ;;302.6

 +38      ;;302.72

 +39      ;;302.9

 +40      ;;304.60

 +41      ;;305.90

 +42      ;;305.91

 +43      ;;305.92

 +44      ;;305.93

 +45      ;;307.42

 +46      ;;307.44

 +47      ;;307.46

 +48      ;;307.47

 +49      ;;314.01

 +50      ;;608.89

 +51      ;;625.8

 +52      ;;780.59

 +53      ;;799.9

 +54      ;;294.1

 +55      ;;312.8

 +56      ;;347.

 +57      ;;

CHG       ;;

 +1       ;;780.9;;780.93

 +2       ;;

NAME      ;;

 +1       ;;2;;CROSS-CULTURAL CONFLICT

 +2       ;;12.1;;SUBSTANCE-INDUCED DELIRIUM, DEMENTIA, AMNESTIC AND OTHER COGNITIVE DISORDERS

 +3       ;;17;;PSYCHOTIC DISORDER NOS

 +4       ;;21;;COMMUNICATION DISORDER NOS

 +5       ;;25;;DISRUPTIVE BEHAVIOR DISORDER NOS

 +6       ;;36;;PSYCHOLOGICAL FACTOR AFFECTING MEDICAL CONDITION

 +7       ;;45.1;;ABUSIVE BEHAVIOR (ALLEGED),PHY/EMOT: ADULT VICTIM: FOCUS ON PERP (PARTNER)

 +8       ;;45.3;;ABUSIVE BEHAVIOR (ALLEGED),SEXUAL: ADULT VICTIM: FOCUS ON PERP (PARTNER)

 +9       ;;47;;CHILD NEGLECT (SUSPECTED) - NUTRITIONAL

 +10      ;;47.1;;CHILD NEGLECT (SUSPECTED), OTHER THAN NUTRITIONAL

 +11      ;;48;;ADULT NEGLECT (SUSPECTED), UNSPECIFIED

 +12      ;;48.1;;ADULT NEGLECT (SUSPECTED), NUTRITIONAL

 +13      ;;49;;PARTNER NEGLECT (SUSPECTED), UNSPECIFIED

 +14      ;;49.1;;PARTNER NEGLECT (SUSPECTED), NUTRITIONAL

 +15      ;;49.9;;EXPLOITATION (ADULT)

 +16      ;;54.1;;DEATH (PATIENT EXPIRED)

 +17      ;;54.2;;DYING, END OF LIFE CARE

 +18      ;;64;;ADOPTION (REFERRAL)

 +19      ;;84;;OCCUPATIONAL MALADJUSTMENT

 +20      ;;89.1;;ALTERNATIVE EDUCATION SERVICES

 +21      ;;92;;VOCATIONAL REHABILITATION SERVICES

 +22      ;;312.39;;TRICHOTILLOMANIA

 +23      ;;312.89;;CONDUCT DISORDER, UNSPECIFIED ONSET

 +24      ;;291.1;;ALCOHOL INDUCED AMNESTIC DISORDER

 +25      ;;300.81;;SOMATIZATION DISORDER

 +26      ;;314.00;;ATTENTION-DEFICIT/HYPERACTIVITY DIS. - PREDOM. INATTENTIVE TYPE

 +27      ;;314.9;;ATTENTION-DEFICIT/HYPERACTIVITY DIS. NOS

 +28      ;;

MAP       ;;

 +1       ;;8.1;;@

 +2       ;;8.2;;@

 +3       ;;8.21;;@

 +4       ;;9;;294.8

 +5       ;;12;;294.9

 +6       ;;12.1;;294.9

 +7       ;;14;;311.

 +8       ;;15;;296.80

 +9       ;;16;;297.1

 +10      ;;21.1;;995.2

 +11      ;;25;;312.9

 +12      ;;32;;299.80

 +13      ;;42;;995.50

 +14      ;;42.1;;995.54

 +15      ;;42.2;;995.51

 +16      ;;42.3;;995.53

 +17      ;;43;;995.80

 +18      ;;43.1;;995.81

 +19      ;;43.2;;995.82

 +20      ;;43.3;;995.83

 +21      ;;44;;995.80

 +22      ;;44.1;;995.81

 +23      ;;44.2;;995.82

 +24      ;;44.3;;995.83

 +25      ;;45.1;;V61.12

 +26      ;;45.3;;V61.12

 +27      ;;46;;995.83

 +28      ;;47;;995.52

 +29      ;;47.1;;995.51

 +30      ;;48;;995.80

 +31      ;;48.1;;995.84

 +32      ;;49;;995.80

 +33      ;;49.1;;995.84

 +34      ;;49.9;;995.80

 +35      ;;54.1;;@

 +36      ;;64;;V68.89

 +37      ;;72;;V60.4

 +38      ;;82;;V62.2

 +39      ;;84;;V62.2

 +40      ;;294.10;;294.1

 +41      ;;95;;@

 +42      ;;96;;@

 +43      ;;97;;@

 +44      ;;98;;@

 +45      ;;99;;@

 +46      ;;294.8;;290.0

 +47      ;;305.10;;305.10

 +48      ;;312.89;;312.89

 +49      ;;314.9;;314.9

 +50      ;;995.5;;995.50

 +51      ;;780.93;;780.93

 +52      ;;

ADD       ;;

 +1       ;;1.1;;HEALTH PROMOTION/DISEASE PREVENTION;;V65.49;;1.1;;MEDICAL/SOCIAL PROBLEMS

 +2       ;;6.1;;PHYSICAL ILLNESS, CHRONIC;;V15.89;;6.1;;MEDICAL/SOCIAL PROBLEMS

 +3       ;;6.2;;PHYSICAL ILLNESS, TERMINAL;;V15.89;;6.2;;MEDICAL/SOCIAL PROBLEMS

 +4       ;;9.1;;PRE-SENILE CONDITION;;290.10;;9.1;;PSYCHOSOCIAL PROBLEMS

 +5       ;;9.2;;SENILE CONDITION;;290.0;;9.2;;PSYCHOSOCIAL PROBLEMS

 +6       ;;8.4;;MALINGERING;;V65.2;;8.4;;MEDICAL/SOCIAL PROBLEMS

 +7       ;;12.1;;SUBSTANCE-INDUCED DELIRIUM, DEMENTIA, AMNESTIC AND OTHER COGNITIVE DISORDERS;;294.8;;12.1;;PSYCHOSOCIAL PROBLEMS

 +8       ;;14.2;;ALCOHOL OR DRUG INDUCED MOOD DISORDER,NOS;;296.90;;14.2;;PSYCHOSOCIAL PROBLEMS

 +9       ;;17.1;;ALCOHOL OR DRUG INDUCED PSYCHOTIC DISORDER, NOS;;298.9;;17.1;;PSYCHOSOCIAL PROBLEMS

 +10      ;;18.1;;ALCOHOL OR DRUG INDUCED ANXIETY DISORDER;;300.00;;18.1;;PSYCHOSOCIAL PROBLEMS

 +11      ;;20.1;;ALCOHOL OR DRUG INDUCED PSYCHOSEXUAL DISORDER;;302.9;;20.1;;PSYCHOSOCIAL PROBLEMS

 +12      ;;22.1;;ALCOHOL OR DRUG INDUCED SLEEP DISORDER;;307.47;;22.1;;PSYCHOSOCIAL PROBLEMS

 +13      ;;29.2;;SCREENING FOR DRUG ABUSE;;V79.8;;29.2;;SCREENING

 +14      ;;37.1;;SOMATOFORM DISORDERS;;300.82;;37.1;;PSYCHOSOCIAL PROBLEMS

 +15      ;;42.11;;SHAKEN BABY SYNDROME;;995.55;;42.11;;ABUSE

 +16      ;;42.4;;OTHER CHILD ABUSE & NEGLECT (MULTIPLE FORMS OF ABUSE/NEGLECT);;995.59;;42.4;;ABUSE

 +17      ;;43.4;;OTHER PARTNER ABUSE & NEGLECT (MULTIPLE FORMS OF ABUSE/NEGLECT);;995.85;;43.4;;ABUSE

 +18      ;;44.4;;OTHER ADULT ABUSE AND NEGLECT (MULTIPLE FORMS OF ABUSE/NEGLECT);;995.85;;44.4;;ABUSE

 +19      ;;45.11;;ABUSIVE BEH (ALLEGED), PHYS/EMOT: ADULT VICTIM: FOCUS ON PERP (NON-PARTNER);;V62.83;;45.11;;ABUSE

 +20      ;;45.12;;ABUSIVE BEH (ALLEGED), PHYS/EMOT:CHILD VICTIM: FOCUS ON PERP (PARENT);;V61.22;;45.12;;ABUSE

 +21      ;;45.13;;ABUSIVE BEH (ALLEGED), PHYS/EMOT: CHILD VICTIM: FOCUS ON PERP (NON-PARENT);;V62.83;;45.13;;ABUSE

 +22      ;;45.31;;ABUSIVE BEH (ALLEGED), SEXUAL: ADULT VICTIM: FOCUS ON PERP (NON-PARTNER);;V62.83;;45.31;;ABUSE

 +23      ;;45.32;;ABUSIVE BEH (ALLEGED), SEXUAL: CHILD VICTIM: FOCUS ON PERP (PARENT);;V61.22;;45.32;;ABUSE

 +24      ;;45.33;;ABUSIVE BEH (ALLEGED), SEXUAL: CHILD VICTIM: FOCUS ON PERP (NON-PARENT);;V62.83;;45.33;;ABUSE

 +25      ;;64.1;;ADOPTION (COUNSELING);;V61.29;;64.1;;PREGNANCY/CHILDBIRTH PROBLEMS

 +26      ;;72.1;;FOSTER CARE (COUNSELING);;V61.29;;72.1;;OUT OF HOME CARE

 +27      ;;82.1;;UNEMPLOYMENT;;V62.0;;82.1;;SOCIOECONOMIC PROBLEMS

 +28      ;;89.1;;ALTERNATIVE EDUCATION SERVICES;;;;89.1;;EDUCATIONAL/LIFE PROBLEMS

 +29      ;;94.1;;RELIGIOUS OR SPIRITUAL PROBLEM;;V62.89;;94.1;;EDUCATIONAL/LIFE PROBLEMS

 +30      ;;94.2;;BORDERLINE INTELLECTUAL FUNCTIONING;;V62.89;;94.2;;EDUCATIONAL/LIFE PROBLEMS

 +31      ;;315.32;;MIXED RECEPTIVE-EXPRESSIVE LANGUAGE DISORDER;;315.32;;32

 +32      ;;995.51;;CHILD ABUSE (EMOTIONAL)/NEGLECT (SUSPECTED) - OTHER THAN NUTRITIONAL;;995.51;;42.2

 +33      ;;995.55;;SHAKEN BABY SYNDROME;;995.55;;42.11

 +34      ;;995.82;;ADULT ABUSE (SUSPECTED), EMOTIONAL;;995.82;;44.2

 +35      ;;995.83;;ADULT ABUSE (SUSPECTED), SEXUAL;;995.83;;44.3

 +36      ;;995.85;;OTHER ADULT ABUSE AND NEGLECT (MULTIPLE FORMS OF ABUSE/NEGLECT);;995.85;;44.4

 +37      ;;347.00;;NARCOLEPSY WITHOUT CATAPLEXY;;347.00;;22

 +38      ;;347.01;;NARCOLEPSY WITH CATAPLEXY;;347.01;;22

 +39      ;;347.10;;NARCOLEPSY COND W/O CATAPLEXY;;347.10;;22

 +40      ;;347.11;;NARCOLEPSY COND WITH CATAPLEXY;;347.11;;22

 +41      ;;

AMH30P4C.m