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
Q
EDIT ;
D ^XBFMK
S DA=G,DIE="^AMHPROB(",DR=".02///"_AMHD_";.03///`"_AMHP_";.05///"_AMHI_";.14///@" D ^DIE
D ^XBFMK
Q
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
Q
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 ;;
