Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AMHGESF

AMHGESF.m

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