AMHGDCM ; IHS/CMI/MAW - AMHG Case Management Form 12/30/2008 3:16:39 PM ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
;
;
;
DEBUG(RETVAL,AMHSTR) ;-- debug entry point
D DEBUG^%Serenji("EP^AMHGD(RETVAL,.AMHSTR)")
Q
;
CM(RETVAL,AMHSTR) ;-- get case status data for Case Management form (frmCaseManagement)
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^T00030CaseOpen^T00030CaseAdmit^T00030CaseClosed^T00030Disposition^T00030Program^T00030Provider^T00030Problem^T00030NextReview^T00250Comment"_$C(30)
N AMHCO,AMHCA,AMHCC,AMHDSPI,AMHDSP,AMHDSPS,AMHPRGI,AMHPRG,AMHPRGS,AMHPRVI,AMHPRV,AMHPRVS,AMHPRBI,AMHPRB,AMHPRBS,AMHNR,AMHCMT
S AMHCO=$$GET1^DIQ(9002011.58,AMHIEN,.01,"I")
S AMHCA=$$GET1^DIQ(9002011.58,AMHIEN,.04,"I")
S AMHCC=$$GET1^DIQ(9002011.58,AMHIEN,.05,"I")
S AMHDSPI=$$GET1^DIQ(9002011.58,AMHIEN,.06,"I")
S AMHDSP=$$GET1^DIQ(9002011.58,AMHIEN,.06)
I AMHDSPI S AMHDSPS=AMHDSPI_R_AMHDSP
S AMHPRGI=$$GET1^DIQ(9002011.58,AMHIEN,.03,"I")
S AMHPRG=$$GET1^DIQ(9002011.58,AMHIEN,.03)
I AMHPRGI]"" S AMHPRGS=AMHPRGI_R_AMHPRG
S AMHPRVI=$$GET1^DIQ(9002011.58,AMHIEN,.08,"I")
S AMHPRV=$$GET1^DIQ(9002011.58,AMHIEN,.08)
I AMHPRVI S AMHPRVS=AMHPRVI_R_AMHPRV
S AMHPRBI=$$GET1^DIQ(9002011.58,AMHIEN,.09,"I")
S AMHPRB=$$GET1^DIQ(9002011.58,AMHIEN,.09)
I AMHPRBI S AMHPRBE=$$GET1^DIQ(9002012.2,AMHPRBI,.02)
I AMHPRBI S AMHPRBS=AMHPRBI_R_AMHPRBE
S AMHNR=$$GET1^DIQ(9002011.58,AMHIEN,.12,"I")
S AMHCMT=$$GET1^DIQ(9002011.58,AMHIEN,1101)
S AMHI=AMHI+1
S @RETVAL@(AMHI)=AMHIEN_U_AMHCO_U_AMHCA_U_AMHCC_U_$G(AMHDSPS)_U_$G(AMHPRG)_U_$G(AMHPRVS)_U_$G(AMHPRBS)_U_AMHNR_U_AMHCMT_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
PI(RETVAL,AMHSTR) ;-- get patient information for Case Management form (frmCaseManagement)
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,P,R,AMHP
S P="|",R="~"
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
K ^AMHTMP($J)
S AMHP=$P(AMHSTR,P)
S @RETVAL@(AMHI)="T00010BMXIEN^T00050DesMHProvider^T00050DesSSProvider^T00050DesCDProvider^T00050DesOtherRPMSProvider^T00050DesPCProvider^T00050DesNonRPMSProvider1^T00050DesNonRPMSProvider2^T00010PatientFlag^T00080PatientFlagNarrative"_$C(30)
I '$D(^AMHPATR(AMHP)) D Q
. S @RETVAL@(AMHI+1)=$C(31)
N AMHDMPI,AMHDMP,AMHDMPS,AMHDSPI,AMHDSP,AMHDSPS,AMHDCPI,AMHDCP,AMHDCPS,AMHDRPI,AMHDRP,AMHDRPS,AMHDPPI,AMHDPP,AMHDPPS,AMHDOP1,AMHDOP2,AMHFLG,AMHFLGN
S AMHDMPI=$$GET1^DIQ(9002011.55,AMHP,.02,"I")
S AMHDMP=$$GET1^DIQ(9002011.55,AMHP,.02)
I AMHDMPI S AMHDMPS=AMHDMPI_R_AMHDMP
S AMHDSPI=$$GET1^DIQ(9002011.55,AMHP,.03,"I")
S AMHDSP=$$GET1^DIQ(9002011.55,AMHP,.03)
I AMHDSPI S AMHDSPS=AMHDSPI_R_AMHDSP
S AMHDCPI=$$GET1^DIQ(9002011.55,AMHP,.04,"I")
S AMHDCP=$$GET1^DIQ(9002011.55,AMHP,.04)
I AMHDCPI S AMHDCPS=AMHDCPI_R_AMHDCP
S AMHDRPI=$$GET1^DIQ(9002011.55,AMHP,.12,"I")
S AMHDRP=$$GET1^DIQ(9002011.55,AMHP,.12)
I AMHDRPI S AMHDRPS=AMHDRPI_R_AMHDRP
S AMHRRPI=$$GET1^DIQ(9000001,AMHP,.14,"I")
S AMHRRP=$$GET1^DIQ(9000001,AMHP,.14)
I AMHRRPI S AMHRRPS=AMHRRP
S AMHDOP1=$$GET1^DIQ(9002011.55,AMHP,.13)
S AMHDOP2=$$GET1^DIQ(9002011.55,AMHP,.14)
S AMHFLG=$$GET1^DIQ(9002011.55,AMHP,.09)
S AMHFLGN=$$GET1^DIQ(9002011.55,AMHP,.11)
S AMHI=AMHI+1
S @RETVAL@(AMHI)=AMHP_U_$G(AMHDMPS)_U_$G(AMHDSPS)_U_$G(AMHDCPS)_U_$G(AMHDRPS)_U_$G(AMHRRPS)_U_AMHDOP1_U_AMHDOP2_U_AMHFLG_U_AMHFLGN_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
PH(RETVAL,AMHSTR) ;-- get personal history for Case Management form (frmCaseManagement)
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,P,R,AMHP
S P="|",R="~"
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
K ^AMHTMP($J)
S AMHP=$P(AMHSTR,P)
S @RETVAL@(AMHI)="T00010BMXIEN^T00050Factor"_$C(30)
N AMHDA
S AMHDA=0 F S AMHDA=$O(^AMHPPHX("AA",AMHP,AMHDA)) Q:'AMHDA D
. N AMHIEN
. S AMHIEN=0 F S AMHIEN=$O(^AMHPPHX("AA",AMHP,AMHDA,AMHIEN)) Q:'AMHIEN D
.. N AMHF,AMHFI
.. S AMHF=$$GET1^DIQ(9002011.52,AMHIEN,.01)
.. S AMHFI=$$GET1^DIQ(9002011.52,AMHIEN,.01,"I")
.. S AMHI=AMHI+1
.. S @RETVAL@(AMHI)=AMHFI_U_AMHF_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
AMHGDCM ; IHS/CMI/MAW - AMHG Case Management Form 12/30/2008 3:16:39 PM ;
+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 ;
CM(RETVAL,AMHSTR) ;-- get case status data for Case Management form (frmCaseManagement)
+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^T00030CaseOpen^T00030CaseAdmit^T00030CaseClosed^T00030Disposition^T00030Program^T00030Provider^T00030Problem^T00030NextReview^T00250Comment"_$CHAR(30)
+9 NEW AMHCO,AMHCA,AMHCC,AMHDSPI,AMHDSP,AMHDSPS,AMHPRGI,AMHPRG,AMHPRGS,AMHPRVI,AMHPRV,AMHPRVS,AMHPRBI,AMHPRB,AMHPRBS,AMHNR,AMHCMT
+10 SET AMHCO=$$GET1^DIQ(9002011.58,AMHIEN,.01,"I")
+11 SET AMHCA=$$GET1^DIQ(9002011.58,AMHIEN,.04,"I")
+12 SET AMHCC=$$GET1^DIQ(9002011.58,AMHIEN,.05,"I")
+13 SET AMHDSPI=$$GET1^DIQ(9002011.58,AMHIEN,.06,"I")
+14 SET AMHDSP=$$GET1^DIQ(9002011.58,AMHIEN,.06)
+15 IF AMHDSPI
SET AMHDSPS=AMHDSPI_R_AMHDSP
+16 SET AMHPRGI=$$GET1^DIQ(9002011.58,AMHIEN,.03,"I")
+17 SET AMHPRG=$$GET1^DIQ(9002011.58,AMHIEN,.03)
+18 IF AMHPRGI]""
SET AMHPRGS=AMHPRGI_R_AMHPRG
+19 SET AMHPRVI=$$GET1^DIQ(9002011.58,AMHIEN,.08,"I")
+20 SET AMHPRV=$$GET1^DIQ(9002011.58,AMHIEN,.08)
+21 IF AMHPRVI
SET AMHPRVS=AMHPRVI_R_AMHPRV
+22 SET AMHPRBI=$$GET1^DIQ(9002011.58,AMHIEN,.09,"I")
+23 SET AMHPRB=$$GET1^DIQ(9002011.58,AMHIEN,.09)
+24 IF AMHPRBI
SET AMHPRBE=$$GET1^DIQ(9002012.2,AMHPRBI,.02)
+25 IF AMHPRBI
SET AMHPRBS=AMHPRBI_R_AMHPRBE
+26 SET AMHNR=$$GET1^DIQ(9002011.58,AMHIEN,.12,"I")
+27 SET AMHCMT=$$GET1^DIQ(9002011.58,AMHIEN,1101)
+28 SET AMHI=AMHI+1
+29 SET @RETVAL@(AMHI)=AMHIEN_U_AMHCO_U_AMHCA_U_AMHCC_U_$GET(AMHDSPS)_U_$GET(AMHPRG)_U_$GET(AMHPRVS)_U_$GET(AMHPRBS)_U_AMHNR_U_AMHCMT_$CHAR(30)
+30 SET @RETVAL@(AMHI+1)=$CHAR(31)
+31 QUIT
+32 ;
PI(RETVAL,AMHSTR) ;-- get patient information for Case Management form (frmCaseManagement)
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,P,R,AMHP
+3 SET P="|"
SET R="~"
+4 SET RETVAL="^AMHTMP("_$JOB_")"
+5 SET AMHI=0
+6 KILL ^AMHTMP($JOB)
+7 SET AMHP=$PIECE(AMHSTR,P)
+8 SET @RETVAL@(AMHI)="T00010BMXIEN^T00050DesMHProvider^T00050DesSSProvider^T00050DesCDProvider^T00050DesOtherRPMSProvider^T00050DesPCProvider^T00050DesNonRPMSProvider1^T00050DesNonRPMSProvider2^T00010PatientFlag^T00080PatientFlagNarrative"_$CHAR(
30)
+9 IF '$DATA(^AMHPATR(AMHP))
Begin DoDot:1
+10 SET @RETVAL@(AMHI+1)=$CHAR(31)
End DoDot:1
QUIT
+11 NEW AMHDMPI,AMHDMP,AMHDMPS,AMHDSPI,AMHDSP,AMHDSPS,AMHDCPI,AMHDCP,AMHDCPS,AMHDRPI,AMHDRP,AMHDRPS,AMHDPPI,AMHDPP,AMHDPPS,AMHDOP1,AMHDOP2,AMHFLG,AMHFLGN
+12 SET AMHDMPI=$$GET1^DIQ(9002011.55,AMHP,.02,"I")
+13 SET AMHDMP=$$GET1^DIQ(9002011.55,AMHP,.02)
+14 IF AMHDMPI
SET AMHDMPS=AMHDMPI_R_AMHDMP
+15 SET AMHDSPI=$$GET1^DIQ(9002011.55,AMHP,.03,"I")
+16 SET AMHDSP=$$GET1^DIQ(9002011.55,AMHP,.03)
+17 IF AMHDSPI
SET AMHDSPS=AMHDSPI_R_AMHDSP
+18 SET AMHDCPI=$$GET1^DIQ(9002011.55,AMHP,.04,"I")
+19 SET AMHDCP=$$GET1^DIQ(9002011.55,AMHP,.04)
+20 IF AMHDCPI
SET AMHDCPS=AMHDCPI_R_AMHDCP
+21 SET AMHDRPI=$$GET1^DIQ(9002011.55,AMHP,.12,"I")
+22 SET AMHDRP=$$GET1^DIQ(9002011.55,AMHP,.12)
+23 IF AMHDRPI
SET AMHDRPS=AMHDRPI_R_AMHDRP
+24 SET AMHRRPI=$$GET1^DIQ(9000001,AMHP,.14,"I")
+25 SET AMHRRP=$$GET1^DIQ(9000001,AMHP,.14)
+26 IF AMHRRPI
SET AMHRRPS=AMHRRP
+27 SET AMHDOP1=$$GET1^DIQ(9002011.55,AMHP,.13)
+28 SET AMHDOP2=$$GET1^DIQ(9002011.55,AMHP,.14)
+29 SET AMHFLG=$$GET1^DIQ(9002011.55,AMHP,.09)
+30 SET AMHFLGN=$$GET1^DIQ(9002011.55,AMHP,.11)
+31 SET AMHI=AMHI+1
+32 SET @RETVAL@(AMHI)=AMHP_U_$GET(AMHDMPS)_U_$GET(AMHDSPS)_U_$GET(AMHDCPS)_U_$GET(AMHDRPS)_U_$GET(AMHRRPS)_U_AMHDOP1_U_AMHDOP2_U_AMHFLG_U_AMHFLGN_$CHAR(30)
+33 SET @RETVAL@(AMHI+1)=$CHAR(31)
+34 QUIT
+35 ;
PH(RETVAL,AMHSTR) ;-- get personal history for Case Management form (frmCaseManagement)
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,P,R,AMHP
+3 SET P="|"
SET R="~"
+4 SET RETVAL="^AMHTMP("_$JOB_")"
+5 SET AMHI=0
+6 KILL ^AMHTMP($JOB)
+7 SET AMHP=$PIECE(AMHSTR,P)
+8 SET @RETVAL@(AMHI)="T00010BMXIEN^T00050Factor"_$CHAR(30)
+9 NEW AMHDA
+10 SET AMHDA=0
FOR
SET AMHDA=$ORDER(^AMHPPHX("AA",AMHP,AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+11 NEW AMHIEN
+12 SET AMHIEN=0
FOR
SET AMHIEN=$ORDER(^AMHPPHX("AA",AMHP,AMHDA,AMHIEN))
IF 'AMHIEN
QUIT
Begin DoDot:2
+13 NEW AMHF,AMHFI
+14 SET AMHF=$$GET1^DIQ(9002011.52,AMHIEN,.01)
+15 SET AMHFI=$$GET1^DIQ(9002011.52,AMHIEN,.01,"I")
+16 SET AMHI=AMHI+1
+17 SET @RETVAL@(AMHI)=AMHFI_U_AMHF_$CHAR(30)
End DoDot:2
End DoDot:1
+18 SET @RETVAL@(AMHI+1)=$CHAR(31)
+19 QUIT
+20 ;
