- 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 ;