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