AMHGESF ; IHS/CMI/MAW - AMHG Suicide Add/Edits 9:22:26 AM ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
;
;
;
DEBUG(RETVAL,AMHSTR) ;-- debug entry point
D DEBUG^%Serenji("EP^AMHGD(RETVAL,.AMHSTR)")
Q
;
SF(AMHIEN,DM,REC,PAT,CN,LCN,DOA,PRV,COA,RS,ES,EDU,EDUL,SB,PA,DSP,DSPO,LOA,LOAO,SU) ;EP - sf
N FL,AMHIENS,AMHFDA,AMHERRR
S AMHIENS=$S(DM="A":"+1,",1:REC_",")
S FL=9002011.65
S AMHFDA(FL,AMHIENS,.02)=LCN
S AMHFDA(FL,AMHIENS,.03)=PRV
S AMHFDA(FL,AMHIENS,.04)=PAT
S AMHFDA(FL,AMHIENS,.05)=ES
S AMHFDA(FL,AMHIENS,.06)=DOA
S AMHFDA(FL,AMHIENS,.07)=COA
S AMHFDA(FL,AMHIENS,.08)=RS
S AMHFDA(FL,AMHIENS,.11)=EDU
S AMHFDA(FL,AMHIENS,.12)=EDUL
S AMHFDA(FL,AMHIENS,.13)=SB
S AMHFDA(FL,AMHIENS,.14)=PA
S AMHFDA(FL,AMHIENS,.15)=LOA
S AMHFDA(FL,AMHIENS,1401)=LOAO
S AMHFDA(FL,AMHIENS,1402)=DSPO
S AMHFDA(FL,AMHIENS,.21)=DT
S AMHFDA(FL,AMHIENS,.22)=DUZ
S AMHFDA(FL,AMHIENS,.25)=DSP
S AMHFDA(FL,AMHIENS,.26)=SU
I DM="A" D
. S AMHFDA(FL,AMHIENS,.01)=CN
. S AMHFDA(FL,AMHIENS,.18)=DT
. S AMHFDA(FL,AMHIENS,.19)=DUZ
. D UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(0)")
. I '$D(AMHERRR) S AMHIEN=$G(AMHIENS(1)) Q
. S AMHER="0~Add Suicide Form"
I DM="E" D
. D FILE^DIE("K","AMHFDA","AMHERRR(1)")
. I '$D(AMHERRR) S AMHIEN=REC Q
;D VAUD(AMHIEN)
Q
;
VAUD(RC) ;-- update the audit log
N AMHFDA,AMHIENS,AMHERRR
S AMHIENS=""
S AMHFDA(9002011.6551,"+2,"_RC_",",.01)=$$NOW^XLFDT
S AMHFDA(9002011.6551,"+2,"_RC_",",.02)=DUZ
D UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")
Q
;
METH(AMHIEN,DM,REC,MO,M,O) ;EP -- add/edit methods
N FL
D CLNMTH(REC)
S FL=9002011.6511
N AMHDA,R
S R="~"
S AMHDA=0 F S AMHDA=$O(M(AMHDA)) Q:'AMHDA D
. N STR,MIEN,AMHMIEN
. S STR=$G(M(AMHDA))
. S MIEN=$P(STR,R)
. I MIEN=7 D OD(REC,MIEN,.O) Q
. N AMHFDA,AMHIENS,AMHERRR
. S AMHIENS="+2,"_REC_","
. S AMHFDA(FL,AMHIENS,.01)=MIEN
. I MIEN=8 S AMHFDA(FL,AMHIENS,.02)=MO
. D UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")
. I '$D(AMHERRR) S AMHMIEN=$G(AMHIENS(2)) Q
. S AMHER="0~Add Suicide Methods"
Q
;
OD(RC,MI,O) ;EP -- if overdose file those as well
N MFL
S MFL=9002011.651111
N AMHDA,R,RIEN,SIEN
S R="~"
S RIEN=$O(^AMHPSUIC(RC,11,"B",MI,0))
S SIEN=$S(RIEN:RIEN_","_RC_",",1:"+2,"_RC_",")
I '$D(O(1)) D Q
. N AMHOFDA,AMHOIENS,AMHOERR
. S AMHOFDA(9002011.6511,SIEN,.01)=MI ;TODO
. D UPDATE^DIE("","AMHOFDA","AMHOIENS","AMHOERR(1)")
. I $D(AMHOERR) S AMHER="0~Add Method Overdose"
. S AMHIEN=$G(AMHIENS(2))
S AMHDA=0 F S AMHDA=$O(O(AMHDA)) Q:'AMHDA D
. N AMHOFDA,AMHOIENS,AMHOERR
. N OSTR,OIEN,OTH
. S OSTR=$G(O(AMHDA))
. S OIEN=$P(OSTR,R)
. S OTH=$P(OSTR,R,3)
. S AMHOIENS="+3,"_SIEN
. S AMHOFDA(9002011.6511,SIEN,.01)=MI
. S AMHOFDA(MFL,AMHOIENS,.01)=OIEN
. I $E($$GET1^DIQ(9002014.7,OIEN,.01),1,5)="OTHER" S AMHOFDA(MFL,AMHOIENS,.02)=OTH
. D UPDATE^DIE("","AMHOFDA","AMHOIENS","AMHOERR(1)")
. I $D(AMHOERR) S AMHER="0~Add Method Overdose"
. S AMHIEN=$G(AMHIENS(3))
Q
;
CLNMTH(RC) ;-- lets clean the method multiple out first
S DA(1)=RC
S DIK="^AMHPSUIC("_DA(1)_",11,"
N MDA
S MDA=0 F S MDA=$O(^AMHPSUIC(RC,11,MDA)) Q:'MDA D
. S DA=MDA
. D ^DIK
Q
;
SUB(AMHIEN,REC,S) ;EP -- add substance involved
D CLNSD(REC)
N FL
S FL=9002011.651501
N AMHDA,R
S R="~"
S AMHDA=0 F S AMHDA=$O(S(AMHDA)) Q:'AMHDA D
. N AMHFDA,AMHIENS,AMHERRR
. N SSTR,SIEN,SOTH
. S SSTR=$G(S(AMHDA))
. S SIEN=$P(SSTR,R)
. S SOTH=$P(SSTR,R,3)
. S AMHIENS="+2,"_REC_","
. S AMHFDA(FL,AMHIENS,.01)=SIEN
. I $E($$GET1^DIQ(9002014.71,SIEN,.01),1,5)="OTHER" S AMHFDA(FL,AMHIENS,.02)=SOTH
. D UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")
. I $D(AMHERRR) S AMHER="0~Add Substance Drugs"
Q
;
CLNSD(RC) ;-- lets clean the substance drug multiple out first
S DA(1)=RC
S DIK="^AMHPSUIC("_DA(1)_",15,"
N MDA
S MDA=0 F S MDA=$O(^AMHPSUIC(RC,15,MDA)) Q:'MDA D
. S DA=MDA
. D ^DIK
Q
;
CF(AMHIEN,DM,REC,CO,C) ;EP -- add/edit contributing factors
N FL
D CLNCF(REC)
S FL=9002011.6513
N AMHDA,R
S R="~"
S AMHDA=0 F S AMHDA=$O(C(AMHDA)) Q:'AMHDA D
. N STR,CIEN,AMHMIEN
. S STR=$G(C(AMHDA))
. S CIEN=$P(STR,R)
. N AMHFDA,AMHIENS,AMHERRR
. S AMHIENS="+2,"_REC_","
. S AMHFDA(FL,AMHIENS,.01)=CIEN
. I $$GET1^DIQ(9002014.9,CIEN,.01)="OTHER" S AMHFDA(FL,AMHIENS,.02)=CO
. D UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")
. I '$D(AMHERRR) S AMHMIEN=$G(AMHIENS(2)) Q
. S AMHER="0~Add Contributing Factors"
Q
;
CLNCF(RC) ;-- lets clean the contributing factors multiple out first
S DA(1)=RC
S DIK="^AMHPSUIC("_DA(1)_",13,"
N MDA
S MDA=0 F S MDA=$O(^AMHPSUIC(RC,13,MDA)) Q:'MDA D
. S DA=MDA
. D ^DIK
Q
;
NARR(RC,N) ;EP -- file axis 3 data
;Q:$G(N)=""
N AMHWP
D ARRAYT^AMHGU(.AMHWP,N) ;parse the text into an array
N AMHFDA,AMHIENS,AMHERRR
S AMHIENS=RC_","
D WP^AMHGU(.AMHERRR,9002011.65,AMHIENS,4100,.AMHWP)
Q
;
AMHGESF ; IHS/CMI/MAW - AMHG Suicide Add/Edits 9:22:26 AM ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
+2 ;
+3 ;
+4 ;
DEBUG(RETVAL,AMHSTR) ;-- debug entry point
+1 DO DEBUG^%Serenji("EP^AMHGD(RETVAL,.AMHSTR)")
+2 QUIT
+3 ;
SF(AMHIEN,DM,REC,PAT,CN,LCN,DOA,PRV,COA,RS,ES,EDU,EDUL,SB,PA,DSP,DSPO,LOA,LOAO,SU) ;EP - sf
+1 NEW FL,AMHIENS,AMHFDA,AMHERRR
+2 SET AMHIENS=$SELECT(DM="A":"+1,",1:REC_",")
+3 SET FL=9002011.65
+4 SET AMHFDA(FL,AMHIENS,.02)=LCN
+5 SET AMHFDA(FL,AMHIENS,.03)=PRV
+6 SET AMHFDA(FL,AMHIENS,.04)=PAT
+7 SET AMHFDA(FL,AMHIENS,.05)=ES
+8 SET AMHFDA(FL,AMHIENS,.06)=DOA
+9 SET AMHFDA(FL,AMHIENS,.07)=COA
+10 SET AMHFDA(FL,AMHIENS,.08)=RS
+11 SET AMHFDA(FL,AMHIENS,.11)=EDU
+12 SET AMHFDA(FL,AMHIENS,.12)=EDUL
+13 SET AMHFDA(FL,AMHIENS,.13)=SB
+14 SET AMHFDA(FL,AMHIENS,.14)=PA
+15 SET AMHFDA(FL,AMHIENS,.15)=LOA
+16 SET AMHFDA(FL,AMHIENS,1401)=LOAO
+17 SET AMHFDA(FL,AMHIENS,1402)=DSPO
+18 SET AMHFDA(FL,AMHIENS,.21)=DT
+19 SET AMHFDA(FL,AMHIENS,.22)=DUZ
+20 SET AMHFDA(FL,AMHIENS,.25)=DSP
+21 SET AMHFDA(FL,AMHIENS,.26)=SU
+22 IF DM="A"
Begin DoDot:1
+23 SET AMHFDA(FL,AMHIENS,.01)=CN
+24 SET AMHFDA(FL,AMHIENS,.18)=DT
+25 SET AMHFDA(FL,AMHIENS,.19)=DUZ
+26 DO UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(0)")
+27 IF '$DATA(AMHERRR)
SET AMHIEN=$GET(AMHIENS(1))
QUIT
+28 SET AMHER="0~Add Suicide Form"
End DoDot:1
+29 IF DM="E"
Begin DoDot:1
+30 DO FILE^DIE("K","AMHFDA","AMHERRR(1)")
+31 IF '$DATA(AMHERRR)
SET AMHIEN=REC
QUIT
End DoDot:1
+32 ;D VAUD(AMHIEN)
+33 QUIT
+34 ;
VAUD(RC) ;-- update the audit log
+1 NEW AMHFDA,AMHIENS,AMHERRR
+2 SET AMHIENS=""
+3 SET AMHFDA(9002011.6551,"+2,"_RC_",",.01)=$$NOW^XLFDT
+4 SET AMHFDA(9002011.6551,"+2,"_RC_",",.02)=DUZ
+5 DO UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")
+6 QUIT
+7 ;
METH(AMHIEN,DM,REC,MO,M,O) ;EP -- add/edit methods
+1 NEW FL
+2 DO CLNMTH(REC)
+3 SET FL=9002011.6511
+4 NEW AMHDA,R
+5 SET R="~"
+6 SET AMHDA=0
FOR
SET AMHDA=$ORDER(M(AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+7 NEW STR,MIEN,AMHMIEN
+8 SET STR=$GET(M(AMHDA))
+9 SET MIEN=$PIECE(STR,R)
+10 IF MIEN=7
DO OD(REC,MIEN,.O)
QUIT
+11 NEW AMHFDA,AMHIENS,AMHERRR
+12 SET AMHIENS="+2,"_REC_","
+13 SET AMHFDA(FL,AMHIENS,.01)=MIEN
+14 IF MIEN=8
SET AMHFDA(FL,AMHIENS,.02)=MO
+15 DO UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")
+16 IF '$DATA(AMHERRR)
SET AMHMIEN=$GET(AMHIENS(2))
QUIT
+17 SET AMHER="0~Add Suicide Methods"
End DoDot:1
+18 QUIT
+19 ;
OD(RC,MI,O) ;EP -- if overdose file those as well
+1 NEW MFL
+2 SET MFL=9002011.651111
+3 NEW AMHDA,R,RIEN,SIEN
+4 SET R="~"
+5 SET RIEN=$ORDER(^AMHPSUIC(RC,11,"B",MI,0))
+6 SET SIEN=$SELECT(RIEN:RIEN_","_RC_",",1:"+2,"_RC_",")
+7 IF '$DATA(O(1))
Begin DoDot:1
+8 NEW AMHOFDA,AMHOIENS,AMHOERR
+9 ;TODO
SET AMHOFDA(9002011.6511,SIEN,.01)=MI
+10 DO UPDATE^DIE("","AMHOFDA","AMHOIENS","AMHOERR(1)")
+11 IF $DATA(AMHOERR)
SET AMHER="0~Add Method Overdose"
+12 SET AMHIEN=$GET(AMHIENS(2))
End DoDot:1
QUIT
+13 SET AMHDA=0
FOR
SET AMHDA=$ORDER(O(AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+14 NEW AMHOFDA,AMHOIENS,AMHOERR
+15 NEW OSTR,OIEN,OTH
+16 SET OSTR=$GET(O(AMHDA))
+17 SET OIEN=$PIECE(OSTR,R)
+18 SET OTH=$PIECE(OSTR,R,3)
+19 SET AMHOIENS="+3,"_SIEN
+20 SET AMHOFDA(9002011.6511,SIEN,.01)=MI
+21 SET AMHOFDA(MFL,AMHOIENS,.01)=OIEN
+22 IF $EXTRACT($$GET1^DIQ(9002014.7,OIEN,.01),1,5)="OTHER"
SET AMHOFDA(MFL,AMHOIENS,.02)=OTH
+23 DO UPDATE^DIE("","AMHOFDA","AMHOIENS","AMHOERR(1)")
+24 IF $DATA(AMHOERR)
SET AMHER="0~Add Method Overdose"
+25 SET AMHIEN=$GET(AMHIENS(3))
End DoDot:1
+26 QUIT
+27 ;
CLNMTH(RC) ;-- lets clean the method multiple out first
+1 SET DA(1)=RC
+2 SET DIK="^AMHPSUIC("_DA(1)_",11,"
+3 NEW MDA
+4 SET MDA=0
FOR
SET MDA=$ORDER(^AMHPSUIC(RC,11,MDA))
IF 'MDA
QUIT
Begin DoDot:1
+5 SET DA=MDA
+6 DO ^DIK
End DoDot:1
+7 QUIT
+8 ;
SUB(AMHIEN,REC,S) ;EP -- add substance involved
+1 DO CLNSD(REC)
+2 NEW FL
+3 SET FL=9002011.651501
+4 NEW AMHDA,R
+5 SET R="~"
+6 SET AMHDA=0
FOR
SET AMHDA=$ORDER(S(AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+7 NEW AMHFDA,AMHIENS,AMHERRR
+8 NEW SSTR,SIEN,SOTH
+9 SET SSTR=$GET(S(AMHDA))
+10 SET SIEN=$PIECE(SSTR,R)
+11 SET SOTH=$PIECE(SSTR,R,3)
+12 SET AMHIENS="+2,"_REC_","
+13 SET AMHFDA(FL,AMHIENS,.01)=SIEN
+14 IF $EXTRACT($$GET1^DIQ(9002014.71,SIEN,.01),1,5)="OTHER"
SET AMHFDA(FL,AMHIENS,.02)=SOTH
+15 DO UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")
+16 IF $DATA(AMHERRR)
SET AMHER="0~Add Substance Drugs"
End DoDot:1
+17 QUIT
+18 ;
CLNSD(RC) ;-- lets clean the substance drug multiple out first
+1 SET DA(1)=RC
+2 SET DIK="^AMHPSUIC("_DA(1)_",15,"
+3 NEW MDA
+4 SET MDA=0
FOR
SET MDA=$ORDER(^AMHPSUIC(RC,15,MDA))
IF 'MDA
QUIT
Begin DoDot:1
+5 SET DA=MDA
+6 DO ^DIK
End DoDot:1
+7 QUIT
+8 ;
CF(AMHIEN,DM,REC,CO,C) ;EP -- add/edit contributing factors
+1 NEW FL
+2 DO CLNCF(REC)
+3 SET FL=9002011.6513
+4 NEW AMHDA,R
+5 SET R="~"
+6 SET AMHDA=0
FOR
SET AMHDA=$ORDER(C(AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+7 NEW STR,CIEN,AMHMIEN
+8 SET STR=$GET(C(AMHDA))
+9 SET CIEN=$PIECE(STR,R)
+10 NEW AMHFDA,AMHIENS,AMHERRR
+11 SET AMHIENS="+2,"_REC_","
+12 SET AMHFDA(FL,AMHIENS,.01)=CIEN
+13 IF $$GET1^DIQ(9002014.9,CIEN,.01)="OTHER"
SET AMHFDA(FL,AMHIENS,.02)=CO
+14 DO UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")
+15 IF '$DATA(AMHERRR)
SET AMHMIEN=$GET(AMHIENS(2))
QUIT
+16 SET AMHER="0~Add Contributing Factors"
End DoDot:1
+17 QUIT
+18 ;
CLNCF(RC) ;-- lets clean the contributing factors multiple out first
+1 SET DA(1)=RC
+2 SET DIK="^AMHPSUIC("_DA(1)_",13,"
+3 NEW MDA
+4 SET MDA=0
FOR
SET MDA=$ORDER(^AMHPSUIC(RC,13,MDA))
IF 'MDA
QUIT
Begin DoDot:1
+5 SET DA=MDA
+6 DO ^DIK
End DoDot:1
+7 QUIT
+8 ;
NARR(RC,N) ;EP -- file axis 3 data
+1 ;Q:$G(N)=""
+2 NEW AMHWP
+3 ;parse the text into an array
DO ARRAYT^AMHGU(.AMHWP,N)
+4 NEW AMHFDA,AMHIENS,AMHERRR
+5 SET AMHIENS=RC_","
+6 DO WP^AMHGU(.AMHERRR,9002011.65,AMHIENS,4100,.AMHWP)
+7 QUIT
+8 ;
