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

AMHGDSF.m

Go to the documentation of this file. 
  1. AMHGDSF ; IHS/CMI/MAW - AMHG Suicide Form Data Entry 1/7/2009 2:59:37 PM ;
  1.  ;;4.0;IHS BEHAVIORAL HEALTH;**1**;JUN 18, 2010;Build 8
  1.  ;
  1.  ;
  1.  ;this routine will handle data on the Suicide Form Data Entry Form (frmSuicideFormDataEntry)
  1.  ;
  1. DEBUG(RETVAL,AMHSTR) ;-- debug entry point
  1.  D DEBUG^%Serenji("EP^AMHGD(RETVAL,.AMHSTR)")
  1.  Q
  1.  ;
  1. SF(RETVAL,AMHSTR) ;-- get suicide form info
  1.  S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
  1.  N AMHI,P,R,AMHIEN
  1.  S P="|",R="~"
  1.  S RETVAL="^AMHTMP("_$J_")"
  1.  S AMHI=0
  1.  K ^AMHTMP($J)
  1.  S AMHIEN=$P(AMHSTR,P)
  1.  S @RETVAL@(AMHI)="T00010BMXIEN^T00030LocalCaseNumber^T00050Provider^T00030DateofAct^T00050CommunityWhereOccurred^T00010RelationshipStatus^T00010EmploymentStatus^T00010Education^T00010HighestGrade^T00010SuicidalBehavior^T00010PreviousAttempts"
  1.  S @RETVAL@(AMHI)=@RETVAL@(AMHI)_"^T00010Lethality^T00010LocationofAct^T00080LocationOther^T00050Disposition^T00080DispositionText"_$C(30)
  1.  N AMHLC,AMHPRVI,AMHPRV,AMHPRVS,AMHDOA,AMHCWI,AMHCW,AMHCSW,AMHRS,AMHES,AMHEDU,AMHHGC,AMHSB,AMHPA,AMHLET,AMHLOA,AMHLOAO,AMHDSPI,AMHDSP,AMHDSPS,AMHDSPT,AMHCWS
  1.  S AMHLC=$$GET1^DIQ(9002011.65,AMHIEN,.02)
  1.  S AMHPRVI=$$GET1^DIQ(9002011.65,AMHIEN,.03,"I")
  1.  S AMHPRV=$$GET1^DIQ(9002011.65,AMHIEN,.03)
  1.  S AMHPRVS=$S(AMHPRVI:AMHPRVI_R_AMHPRV,1:"")
  1.  S AMHDOA=$$GET1^DIQ(9002011.65,AMHIEN,.06,"I")
  1.  S AMHCWI=$$GET1^DIQ(9002011.65,AMHIEN,.07,"I")
  1.  S AMHCW=$$GET1^DIQ(9002011.65,AMHIEN,.07)
  1.  S AMHCWS=$S(AMHCWI:AMHCWI_R_AMHCW,1:"")
  1.  S AMHRS=$$GET1^DIQ(9002011.65,AMHIEN,.08)
  1.  S AMHES=$$GET1^DIQ(9002011.65,AMHIEN,.05)
  1.  S AMHEDU=$$GET1^DIQ(9002011.65,AMHIEN,.11)
  1.  S AMHHGC=$$GET1^DIQ(9002011.65,AMHIEN,.12)
  1.  S AMHSB=$$GET1^DIQ(9002011.65,AMHIEN,.13)
  1.  S AMHPA=$$GET1^DIQ(9002011.65,AMHIEN,.14)
  1.  S AMHLET=$$GET1^DIQ(9002011.65,AMHIEN,.24)
  1.  S AMHLOA=$$GET1^DIQ(9002011.65,AMHIEN,.15)
  1.  S AMHLOAO=$$GET1^DIQ(9002011.65,AMHIEN,1401)
  1.  S AMHDSPI=$$GET1^DIQ(9002011.65,AMHIEN,.25,"I")
  1.  S AMHDSP=$$GET1^DIQ(9002011.65,AMHIEN,.25)
  1.  S AMHDSPS=$S(AMHDSPI:AMHDSPI_R_AMHDSP,1:"")
  1.  S AMHDSPT=$$GET1^DIQ(9002011.65,AMHIEN,1402)
  1.  S AMHI=AMHI+1
  1.  S @RETVAL@(AMHI)=AMHIEN_U_AMHLC_U_AMHPRVS_U_AMHDOA_U_AMHCWS_U_AMHRS_U_AMHES_U_AMHEDU_U_AMHHGC_U_AMHSB_U_AMHPA_U_AMHLET_U_AMHLOA_U_AMHLOAO_U_AMHDSPS_U_AMHDSPT_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. METH(RETVAL,AMHSTR) ;-- return the method
  1.  S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
  1.  N AMHI,P,R,AMHIEN
  1.  S P="|",R="~"
  1.  S RETVAL="^AMHTMP("_$J_")"
  1.  S AMHI=0
  1.  K ^AMHTMP($J)
  1.  S AMHIEN=$P(AMHSTR,P)
  1.  S @RETVAL@(AMHI)="T00010BMXIEN^T00010Method^T00050MethodIfOther^T00050DrugIfOverdose^T00050DrugIfOther"_$C(30)
  1.  N AMHDA,AMHOEN
  1.  S AMHDA=0 F  S AMHDA=$O(^AMHPSUIC(AMHIEN,11,AMHDA)) Q:'AMHDA  D
  1.  . N AMHDATA,AMHMET,AMHOTH
  1.  . S AMHDATA=$G(^AMHPSUIC(AMHIEN,11,AMHDA,0))
  1.  . S AMHMET=$P(AMHDATA,U)
  1.  . S AMHOTH=$P(AMHDATA,U,2)
  1.  .I AMHMET=7 D
  1.  .. I '$D(^AMHPSUIC(AMHIEN,11,AMHDA,11)) D  Q
  1.  ... S AMHI=AMHI+1
  1.  ... S @RETVAL@(AMHI)=AMHIEN_U_AMHMET_U_AMHOTH_U_$G(AMHOD)_U_$G(AMHODO)_$C(30)
  1.  .. S AMHOEN=0 F  S AMHOEN=$O(^AMHPSUIC(AMHIEN,11,AMHDA,11,AMHOEN)) Q:'AMHOEN  D
  1.  ... N AMHOD,AMHODI,AMHODS,AMHODO
  1.  ... S AMHODI=$P($G(^AMHPSUIC(AMHIEN,11,AMHDA,11,AMHOEN,0)),U)
  1.  ... S AMHOD=$$GET1^DIQ(9002014.7,AMHODI,.01)
  1.  ... S AMHODS=$S(AMHODI:AMHODI_R_AMHOD,1:"")
  1.  ... S AMHODO=$P($G(^AMHPSUIC(AMHIEN,11,AMHDA,11,AMHOEN,0)),U,2)
  1.  ... S AMHI=AMHI+1
  1.  ... S @RETVAL@(AMHI)=AMHIEN_U_AMHMET_U_AMHOTH_U_AMHODS_U_AMHODO_$C(30)
  1.  . I AMHMET'=7 D
  1.  .. K AMHOD,AMHODO
  1.  .. S AMHI=AMHI+1
  1.  .. S @RETVAL@(AMHI)=AMHIEN_U_AMHMET_U_AMHOTH_U_$G(AMHOD)_U_$G(AMHODO)_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. SUB(RETVAL,AMHSTR) ;-- return the substance use
  1.  S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
  1.  N AMHI,P,R,AMHIEN
  1.  S P="|",R="~"
  1.  S RETVAL="^AMHTMP("_$J_")"
  1.  S AMHI=0
  1.  K ^AMHTMP($J)
  1.  S AMHIEN=$P(AMHSTR,P)
  1.  S @RETVAL@(AMHI)="T00010BMXIEN^T00010Substance^T00050Drug^T00050DrugIfOther"_$C(30)
  1.  N AMHDA,AMHOEN,AMHSUB
  1.  S AMHSUB=$$GET1^DIQ(9002011.65,AMHIEN,.26,"I")
  1.  I AMHSUB=2 D
  1.  . I '$D(^AMHPSUIC(AMHIEN,15)) D  Q
  1.  .. S AMHI=AMHI+1
  1.  .. S @RETVAL@(AMHI)=AMHIEN_U_AMHSUB_U_U_$C(30)
  1.  . S AMHDA=0 F  S AMHDA=$O(^AMHPSUIC(AMHIEN,15,AMHDA)) Q:'AMHDA  D
  1.  .. N AMHDATA,AMHDRG,AMHDRGI,AMHDRGS,AMHOTH
  1.  .. S AMHDATA=$G(^AMHPSUIC(AMHIEN,15,AMHDA,0))
  1.  .. S AMHDRGI=$P(AMHDATA,U)
  1.  .. S AMHOTH=$P(AMHDATA,U,2)
  1.  .. S AMHDRG=$$GET1^DIQ(9002014.71,AMHDRGI,.01)
  1.  .. S AMHDRGS=$S(AMHDRGI:AMHDRGI_R_AMHDRG,1:"")
  1.  .. S AMHI=AMHI+1
  1.  .. S @RETVAL@(AMHI)=AMHIEN_U_AMHSUB_U_AMHDRGS_U_AMHOTH_$C(30)
  1.  I AMHSUB'=2 D
  1.  . S AMHI=AMHI+1
  1.  . S @RETVAL@(AMHI)=AMHIEN_U_AMHSUB_U_U_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. CF(RETVAL,AMHSTR) ;-- get contributing factors
  1.  S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
  1.  N AMHI,P,R,AMHIEN
  1.  S P="|",R="~"
  1.  S RETVAL="^AMHTMP("_$J_")"
  1.  S AMHI=0
  1.  K ^AMHTMP($J)
  1.  S AMHIEN=$P(AMHSTR,P)
  1.  S @RETVAL@(AMHI)="T00010BMXIEN^T00010ContributingFactor^T00050ContributingFactorIfOther"_$C(30)
  1.  N AMHDA,AMHOEN,AMHSUB
  1.  S AMHDA=0 F  S AMHDA=$O(^AMHPSUIC(AMHIEN,13,AMHDA)) Q:'AMHDA  D
  1.  . N AMHDATA,AMHCF,AMHOTH
  1.  . S AMHDATA=$G(^AMHPSUIC(AMHIEN,13,AMHDA,0))
  1.  . S AMHCF=$P(AMHDATA,U)
  1.  . S AMHOTH=$P(AMHDATA,U,2)
  1.  . S AMHI=AMHI+1
  1.  . S @RETVAL@(AMHI)=AMHIEN_U_AMHCF_U_AMHOTH_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. ORI(RETVAL,AMHSTR) ;-- get other relevant information
  1.  S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
  1.  N AMHI,P,R,AMHIEN
  1.  S P="|",R="~"
  1.  S RETVAL="^AMHTMP("_$J_")"
  1.  S AMHI=0
  1.  K ^AMHTMP($J)
  1.  S AMHIEN=$P(AMHSTR,P)
  1.  S @RETVAL@(AMHI)="T00010BMXIEN^T00250OtherRelevantInformation"_$C(30)
  1.  N AMHDA,AMHOEN,AMHSUB
  1.  S AMHDA=0 F  S AMHDA=$O(^AMHPSUIC(AMHIEN,41,AMHDA)) Q:'AMHDA  D
  1.  . N AMHDATA
  1.  . S AMHDATA=$G(^AMHPSUIC(AMHIEN,41,AMHDA,0))
  1.  . ;I AMHDATA'[$C(10) S AMHDATA=AMHDATA_$C(10)  ;cmi/maw 06/16/2010 try removing this and see what happens 11/18/2010
  1.  . S AMHI=AMHI+1
  1.  . S @RETVAL@(AMHI)=AMHIEN_U_AMHDATA_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;