AMHGDTP ; IHS/CMI/MAW - AMHG Treatment Plan Data Entry 1/6/2009 9:05:55 AM ;
;;4.0;IHS BEHAVIORAL HEALTH;**1,4**;JUN 18, 2010;Build 28
;
;
;this routine will handle data on the Treatment Plan Data Entry Form (frmTreatmentPlanDataEntry)
;
DEBUG(RETVAL,AMHSTR) ;-- debug entry point
D DEBUG^%Serenji("EP^AMHGD(RETVAL,.AMHSTR)")
Q
;
TP(RETVAL,AMHSTR) ;-- get treatment plan 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^T00030DateEstablished^T00030Program^T00030TargetDate^T00030ReviewDate^T00030DateClosed^T00030DesignatedProvider^T00240ProblemList^T00030CaseAdmit^T00030ConcurredDate^T00030ConcurSupervisor^T00001dsm4"_$C(30)
N AMHDE,AMHPRGI,AMHPRG,AMHPRGS,AMHTD,AMHRD,AMHDC,AMHPRVI,AMHPRV,AMHPRVS,AMHPRBL,AMHCA,AMHCD,AMHCS,AMHCSI,AMHCSS,AMHDSM4
S AMHDE=$$GET1^DIQ(9002011.56,AMHIEN,.01,"I")
S AMHTD=$$GET1^DIQ(9002011.56,AMHIEN,.03,"I")
S AMHRD=$$GET1^DIQ(9002011.56,AMHIEN,.09,"I")
S AMHDC=$$GET1^DIQ(9002011.56,AMHIEN,.12,"I")
S AMHPRGI=$$GET1^DIQ(9002011.56,AMHIEN,.17,"I")
S AMHPRG=$$GET1^DIQ(9002011.56,AMHIEN,.17)
I AMHPRGI]"" S AMHPRGS=AMHPRGI_R_AMHPRG
S AMHPRVI=$$GET1^DIQ(9002011.56,AMHIEN,.04,"I")
S AMHPRV=$$GET1^DIQ(9002011.56,AMHIEN,.04)
I AMHPRVI S AMHPRVS=AMHPRVI_R_AMHPRV
S AMHPRBL=$$GET1^DIQ(9002011.56,AMHIEN,1101)
S AMHCA=$$GET1^DIQ(9002011.56,AMHIEN,.16,"I")
S AMHCD=$$GET1^DIQ(9002011.56,AMHIEN,.06,"I")
S AMHCSI=$$GET1^DIQ(9002011.56,AMHIEN,.05,"I")
S AMHCS=$$GET1^DIQ(9002011.56,AMHIEN,.05)
S AMHCSS=$S(AMHCSI:AMHCSI_R_AMHCS,1:"")
S AMHDSM4=$$GET1^DIQ(9002011.56,AMHIEN,.22,"I")
S AMHI=AMHI+1
S @RETVAL@(AMHI)=AMHIEN_U_AMHDE_U_$G(AMHPRG)_U_AMHTD_U_AMHRD_U_AMHDC_U_$G(AMHPRVS)_U_AMHPRBL_U_AMHCA_U_AMHCD_U_AMHCSS_U_AMHDSM4_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
AXISI(RETVAL,AMHSTR) ;-- get axis I data
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)="T00250AxisI"_$C(30)
N AMHDA
S AMHDA=0 F S AMHDA=$O(^AMHPTXP(AMHIEN,6,AMHDA)) Q:'AMHDA D
. N AMHDATA
. S AMHDATA=$G(^AMHPTXP(AMHIEN,6,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)=AMHDATA_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
AXISII(RETVAL,AMHSTR) ;-- get axis II data
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)="T00250AxisII"_$C(30)
N AMHDA
S AMHDA=0 F S AMHDA=$O(^AMHPTXP(AMHIEN,8,AMHDA)) Q:'AMHDA D
. N AMHDATA
. S AMHDATA=$G(^AMHPTXP(AMHIEN,8,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)=AMHDATA_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
AXISIII(RETVAL,AMHSTR) ;-- get axis III data
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)="T00250AxisIII"_$C(30)
N AMHDA
S AMHDA=0 F S AMHDA=$O(^AMHPTXP(AMHIEN,7,AMHDA)) Q:'AMHDA D
. N AMHDATA
. S AMHDATA=$G(^AMHPTXP(AMHIEN,7,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)=AMHDATA_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
AXISIV(RETVAL,AMHSTR) ;-- get axis IV data
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^T00030Code^T00080Narrative"_$C(30)
N AMHDA
S AMHDA=0 F S AMHDA=$O(^AMHPTXP(AMHIEN,9,AMHDA)) Q:'AMHDA D
. N AMHXI,AMHXC,AMHXE
. S AMHXI=$P($G(^AMHPTXP(AMHIEN,9,AMHDA,0)),U)
. S AMHXC=$$GET1^DIQ(9002012.9,AMHXI,.01)
. S AMHXE=$$GET1^DIQ(9002012.9,AMHXI,.02)
. S AMHI=AMHI+1
. S @RETVAL@(AMHI)=AMHXI_U_AMHXC_U_AMHXE_$C(30)
Q
;
AXISV(RETVAL,AMHSTR) ;-- get axis V data
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)="T00030AxisV^T00020GAF"_$C(30)
N AMHDATA,AMHA5,AMHGAF
S AMHDATA=$G(^AMHPTXP(AMHIEN,16))
S AMHA5=$P(AMHDATA,U)
S AMHGAF=$P(AMHDATA,U,2)
S AMHI=AMHI+1
S @RETVAL@(AMHI)=AMHA5_U_AMHGAF_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
DX(RETVAL,AMHSTR) ;-- get DX data
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)="T00250Dx"_$C(30)
N AMHDA
S AMHDA=0 F S AMHDA=$O(^AMHPTXP(AMHIEN,21,AMHDA)) Q:'AMHDA D
. N AMHDATA
. S AMHDATA=$G(^AMHPTXP(AMHIEN,21,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)=AMHDATA_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
NARR(RETVAL,AMHSTR) ;-- get narrative data
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)="T00250TreatmentPlanNarrative"_$C(30)
N AMHDA
S AMHDA=0 F S AMHDA=$O(^AMHPTXP(AMHIEN,18,AMHDA)) Q:'AMHDA D
. N AMHDATA
. S AMHDATA=$G(^AMHPTXP(AMHIEN,18,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)=AMHDATA_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
REV(RETVAL,AMHSTR) ;-- get treatment plan review list view
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^T00010BMXIEN2^T00030ReviewDate^T00030ReviewProvider^T00030ReviewSupervisor^T00030NextReviewDate^T00050ReviewProviderComplete^T00050ReviewSupervisorComplete"_$C(30)
N AMHDA
S AMHDA=0 F S AMHDA=$O(^AMHPTXP(AMHIEN,41,AMHDA)) Q:'AMHDA D
. N AMHDATA,AMHRD,AMHRP,AMHRS,AMHNR,AMHRPI,AMHRPS,AMHRSI,AMHRSS
. S AMHDATA=$G(^AMHPTXP(AMHIEN,41,AMHDA,0))
. S AMHRD=$P(AMHDATA,U)
. S AMHRPI=$P(AMHDATA,U,3)
. S AMHRSI=$P(AMHDATA,U,4)
. S AMHRP=$S($P(AMHDATA,U,3):$$GET1^DIQ(200,$P(AMHDATA,U,3),.01),1:"")
. S AMHRS=$S($P(AMHDATA,U,4):$$GET1^DIQ(200,$P(AMHDATA,U,4),.01),1:"")
. I AMHRPI]"" S AMHRPS=AMHRPI_R_AMHRP
. I AMHRSI]"" S AMHRSS=AMHRSI_R_AMHRS
. S AMHNR=$P(AMHDATA,U,2)
. S AMHI=AMHI+1
. S @RETVAL@(AMHI)=AMHIEN_U_AMHDA_U_$$LVDT^AMHGU(AMHRD)_U_AMHRP_U_AMHRS_U_$$LVDT^AMHGU(AMHNR)_U_$G(AMHRPS)_U_$G(AMHRSS)_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
PPAR(RETVAL,AMHSTR) ;-- get plan participants
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^T00030Participant^T00030Relationship"_$C(30)
N AMHDA
S AMHDA=0 F S AMHDA=$O(^AMHPTXP(AMHIEN,17,AMHDA)) Q:'AMHDA D
. N AMHDATA,AMHPAR,AMHREL
. S AMHDATA=$G(^AMHPTXP(AMHIEN,17,AMHDA,0))
. S AMHPAR=$P(AMHDATA,U)
. S AMHREL=$P(AMHDATA,U,2)
. S AMHI=AMHI+1
. S @RETVAL@(AMHI)=AMHIEN_U_AMHPAR_U_AMHREL_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
PAR(RETVAL,AMHSTR) ;-- get participants for treatment plan review
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^T00010BMXIEN2^T00010BMXIEN3^T00030Participant^T00030Relationship"_$C(30)
N AMHDA
S AMHDA=0 F S AMHDA=$O(^AMHPTXP(AMHIEN,41,AMHDA)) Q:'AMHDA D
. N AMHOEN
. S AMHOEN=0 F S AMHOEN=$O(^AMHPTXP(AMHIEN,41,AMHDA,12,AMHOEN)) Q:'AMHOEN D
.. N AMHDATA,AMHPAR,AMHREL
.. S AMHDATA=$G(^AMHPTXP(AMHIEN,41,AMHDA,12,AMHOEN,0))
.. S AMHPAR=$P(AMHDATA,U)
.. S AMHREL=$P(AMHDATA,U,2)
.. S AMHI=AMHI+1
..S @RETVAL@(AMHI)=AMHIEN_U_AMHDA_U_AMHOEN_U_AMHPAR_U_AMHREL_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
SUM(RETVAL,AMHSTR) ;-- get participants for treatment plan review
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^T00010BMXIEN2^T00010BMXIEN3^T00250ProgressSummary"_$C(30)
N AMHDA
S AMHDA=0 F S AMHDA=$O(^AMHPTXP(AMHIEN,41,AMHDA)) Q:'AMHDA D
. N AMHOEN
. S AMHOEN=0 F S AMHOEN=$O(^AMHPTXP(AMHIEN,41,AMHDA,1,AMHOEN)) Q:'AMHOEN D
.. N AMHSUM
.. S AMHSUM=$G(^AMHPTXP(AMHIEN,41,AMHDA,1,AMHOEN,0))
.. ;I AMHSUM'[$C(10) S AMHSUM=AMHSUM_$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_AMHDA_U_AMHOEN_U_AMHSUM_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
DELRD(RETVAL,AMHSTR) ;-- delete treatment plan review data
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,P,R,AMHIEN,AMHOEN
S P="|",R="~"
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
K ^AMHTMP($J)
S AMHIEN=$P(AMHSTR,P)
S AMHOEN=$P(AMHSTR,P,2)
S DA(1)=AMHIEN
S DA=AMHOEN
S @RETVAL@(AMHI)="T00001Result"_$C(30)
S DIK="^AMHPTXP("_DA(1)_",41,"
D ^DIK
Q
;
DELPAR(RETVAL,AMHSTR) ;-- delete treatment plan review participants
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,P,R,AMHIEN,AMHOEN,AMHUEN
S P="|",R="~"
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
K ^AMHTMP($J)
S AMHIEN=$P(AMHSTR,P)
S AMHOEN=$P(AMHSTR,P,2)
S AMHUEN=$P(AMHSTR,P,3)
S DA(2)=AMHIEN
S DA(1)=AMHOEN
S DA=AMHUEN
S @RETVAL@(AMHI)="T00001Result"_$C(30)
S DIK="^AMHPTXP("_DA(2)_",41,"_DA(1)_",12,"
D ^DIK
Q
;
AMHGDTP ; IHS/CMI/MAW - AMHG Treatment Plan Data Entry 1/6/2009 9:05:55 AM ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;**1,4**;JUN 18, 2010;Build 28
+2 ;
+3 ;
+4 ;this routine will handle data on the Treatment Plan Data Entry Form (frmTreatmentPlanDataEntry)
+5 ;
DEBUG(RETVAL,AMHSTR) ;-- debug entry point
+1 DO DEBUG^%Serenji("EP^AMHGD(RETVAL,.AMHSTR)")
+2 QUIT
+3 ;
TP(RETVAL,AMHSTR) ;-- get treatment plan 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^T00030DateEstablished^T00030Program^T00030TargetDate^T00030ReviewDate^T00030DateClosed^T00030DesignatedProvider^T00240ProblemList^T00030CaseAdmit^T00030ConcurredDate^T00030ConcurSupervisor^T00001dsm4"_$CHAR(30)
+9 NEW AMHDE,AMHPRGI,AMHPRG,AMHPRGS,AMHTD,AMHRD,AMHDC,AMHPRVI,AMHPRV,AMHPRVS,AMHPRBL,AMHCA,AMHCD,AMHCS,AMHCSI,AMHCSS,AMHDSM4
+10 SET AMHDE=$$GET1^DIQ(9002011.56,AMHIEN,.01,"I")
+11 SET AMHTD=$$GET1^DIQ(9002011.56,AMHIEN,.03,"I")
+12 SET AMHRD=$$GET1^DIQ(9002011.56,AMHIEN,.09,"I")
+13 SET AMHDC=$$GET1^DIQ(9002011.56,AMHIEN,.12,"I")
+14 SET AMHPRGI=$$GET1^DIQ(9002011.56,AMHIEN,.17,"I")
+15 SET AMHPRG=$$GET1^DIQ(9002011.56,AMHIEN,.17)
+16 IF AMHPRGI]""
SET AMHPRGS=AMHPRGI_R_AMHPRG
+17 SET AMHPRVI=$$GET1^DIQ(9002011.56,AMHIEN,.04,"I")
+18 SET AMHPRV=$$GET1^DIQ(9002011.56,AMHIEN,.04)
+19 IF AMHPRVI
SET AMHPRVS=AMHPRVI_R_AMHPRV
+20 SET AMHPRBL=$$GET1^DIQ(9002011.56,AMHIEN,1101)
+21 SET AMHCA=$$GET1^DIQ(9002011.56,AMHIEN,.16,"I")
+22 SET AMHCD=$$GET1^DIQ(9002011.56,AMHIEN,.06,"I")
+23 SET AMHCSI=$$GET1^DIQ(9002011.56,AMHIEN,.05,"I")
+24 SET AMHCS=$$GET1^DIQ(9002011.56,AMHIEN,.05)
+25 SET AMHCSS=$SELECT(AMHCSI:AMHCSI_R_AMHCS,1:"")
+26 SET AMHDSM4=$$GET1^DIQ(9002011.56,AMHIEN,.22,"I")
+27 SET AMHI=AMHI+1
+28 SET @RETVAL@(AMHI)=AMHIEN_U_AMHDE_U_$GET(AMHPRG)_U_AMHTD_U_AMHRD_U_AMHDC_U_$GET(AMHPRVS)_U_AMHPRBL_U_AMHCA_U_AMHCD_U_AMHCSS_U_AMHDSM4_$CHAR(30)
+29 SET @RETVAL@(AMHI+1)=$CHAR(31)
+30 QUIT
+31 ;
AXISI(RETVAL,AMHSTR) ;-- get axis I data
+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)="T00250AxisI"_$CHAR(30)
+9 NEW AMHDA
+10 SET AMHDA=0
FOR
SET AMHDA=$ORDER(^AMHPTXP(AMHIEN,6,AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+11 NEW AMHDATA
+12 SET AMHDATA=$GET(^AMHPTXP(AMHIEN,6,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)=AMHDATA_$CHAR(30)
End DoDot:1
+16 SET @RETVAL@(AMHI+1)=$CHAR(31)
+17 QUIT
+18 ;
AXISII(RETVAL,AMHSTR) ;-- get axis II data
+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)="T00250AxisII"_$CHAR(30)
+9 NEW AMHDA
+10 SET AMHDA=0
FOR
SET AMHDA=$ORDER(^AMHPTXP(AMHIEN,8,AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+11 NEW AMHDATA
+12 SET AMHDATA=$GET(^AMHPTXP(AMHIEN,8,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)=AMHDATA_$CHAR(30)
End DoDot:1
+16 SET @RETVAL@(AMHI+1)=$CHAR(31)
+17 QUIT
+18 ;
AXISIII(RETVAL,AMHSTR) ;-- get axis III data
+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)="T00250AxisIII"_$CHAR(30)
+9 NEW AMHDA
+10 SET AMHDA=0
FOR
SET AMHDA=$ORDER(^AMHPTXP(AMHIEN,7,AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+11 NEW AMHDATA
+12 SET AMHDATA=$GET(^AMHPTXP(AMHIEN,7,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)=AMHDATA_$CHAR(30)
End DoDot:1
+16 SET @RETVAL@(AMHI+1)=$CHAR(31)
+17 QUIT
+18 ;
AXISIV(RETVAL,AMHSTR) ;-- get axis IV data
+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^T00030Code^T00080Narrative"_$CHAR(30)
+9 NEW AMHDA
+10 SET AMHDA=0
FOR
SET AMHDA=$ORDER(^AMHPTXP(AMHIEN,9,AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+11 NEW AMHXI,AMHXC,AMHXE
+12 SET AMHXI=$PIECE($GET(^AMHPTXP(AMHIEN,9,AMHDA,0)),U)
+13 SET AMHXC=$$GET1^DIQ(9002012.9,AMHXI,.01)
+14 SET AMHXE=$$GET1^DIQ(9002012.9,AMHXI,.02)
+15 SET AMHI=AMHI+1
+16 SET @RETVAL@(AMHI)=AMHXI_U_AMHXC_U_AMHXE_$CHAR(30)
End DoDot:1
+17 QUIT
+18 ;
AXISV(RETVAL,AMHSTR) ;-- get axis V data
+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)="T00030AxisV^T00020GAF"_$CHAR(30)
+9 NEW AMHDATA,AMHA5,AMHGAF
+10 SET AMHDATA=$GET(^AMHPTXP(AMHIEN,16))
+11 SET AMHA5=$PIECE(AMHDATA,U)
+12 SET AMHGAF=$PIECE(AMHDATA,U,2)
+13 SET AMHI=AMHI+1
+14 SET @RETVAL@(AMHI)=AMHA5_U_AMHGAF_$CHAR(30)
+15 SET @RETVAL@(AMHI+1)=$CHAR(31)
+16 QUIT
+17 ;
DX(RETVAL,AMHSTR) ;-- get DX data
+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)="T00250Dx"_$CHAR(30)
+9 NEW AMHDA
+10 SET AMHDA=0
FOR
SET AMHDA=$ORDER(^AMHPTXP(AMHIEN,21,AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+11 NEW AMHDATA
+12 SET AMHDATA=$GET(^AMHPTXP(AMHIEN,21,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)=AMHDATA_$CHAR(30)
End DoDot:1
+16 SET @RETVAL@(AMHI+1)=$CHAR(31)
+17 QUIT
+18 ;
NARR(RETVAL,AMHSTR) ;-- get narrative data
+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)="T00250TreatmentPlanNarrative"_$CHAR(30)
+9 NEW AMHDA
+10 SET AMHDA=0
FOR
SET AMHDA=$ORDER(^AMHPTXP(AMHIEN,18,AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+11 NEW AMHDATA
+12 SET AMHDATA=$GET(^AMHPTXP(AMHIEN,18,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)=AMHDATA_$CHAR(30)
End DoDot:1
+16 SET @RETVAL@(AMHI+1)=$CHAR(31)
+17 QUIT
+18 ;
REV(RETVAL,AMHSTR) ;-- get treatment plan review list view
+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^T00010BMXIEN2^T00030ReviewDate^T00030ReviewProvider^T00030ReviewSupervisor^T00030NextReviewDate^T00050ReviewProviderComplete^T00050ReviewSupervisorComplete"_$CHAR(30)
+9 NEW AMHDA
+10 SET AMHDA=0
FOR
SET AMHDA=$ORDER(^AMHPTXP(AMHIEN,41,AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+11 NEW AMHDATA,AMHRD,AMHRP,AMHRS,AMHNR,AMHRPI,AMHRPS,AMHRSI,AMHRSS
+12 SET AMHDATA=$GET(^AMHPTXP(AMHIEN,41,AMHDA,0))
+13 SET AMHRD=$PIECE(AMHDATA,U)
+14 SET AMHRPI=$PIECE(AMHDATA,U,3)
+15 SET AMHRSI=$PIECE(AMHDATA,U,4)
+16 SET AMHRP=$SELECT($PIECE(AMHDATA,U,3):$$GET1^DIQ(200,$PIECE(AMHDATA,U,3),.01),1:"")
+17 SET AMHRS=$SELECT($PIECE(AMHDATA,U,4):$$GET1^DIQ(200,$PIECE(AMHDATA,U,4),.01),1:"")
+18 IF AMHRPI]""
SET AMHRPS=AMHRPI_R_AMHRP
+19 IF AMHRSI]""
SET AMHRSS=AMHRSI_R_AMHRS
+20 SET AMHNR=$PIECE(AMHDATA,U,2)
+21 SET AMHI=AMHI+1
+22 SET @RETVAL@(AMHI)=AMHIEN_U_AMHDA_U_$$LVDT^AMHGU(AMHRD)_U_AMHRP_U_AMHRS_U_$$LVDT^AMHGU(AMHNR)_U_$GET(AMHRPS)_U_$GET(AMHRSS)_$CHAR(30)
End DoDot:1
+23 SET @RETVAL@(AMHI+1)=$CHAR(31)
+24 QUIT
+25 ;
PPAR(RETVAL,AMHSTR) ;-- get plan participants
+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^T00030Participant^T00030Relationship"_$CHAR(30)
+9 NEW AMHDA
+10 SET AMHDA=0
FOR
SET AMHDA=$ORDER(^AMHPTXP(AMHIEN,17,AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+11 NEW AMHDATA,AMHPAR,AMHREL
+12 SET AMHDATA=$GET(^AMHPTXP(AMHIEN,17,AMHDA,0))
+13 SET AMHPAR=$PIECE(AMHDATA,U)
+14 SET AMHREL=$PIECE(AMHDATA,U,2)
+15 SET AMHI=AMHI+1
+16 SET @RETVAL@(AMHI)=AMHIEN_U_AMHPAR_U_AMHREL_$CHAR(30)
End DoDot:1
+17 SET @RETVAL@(AMHI+1)=$CHAR(31)
+18 QUIT
+19 ;
PAR(RETVAL,AMHSTR) ;-- get participants for treatment plan review
+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^T00010BMXIEN2^T00010BMXIEN3^T00030Participant^T00030Relationship"_$CHAR(30)
+9 NEW AMHDA
+10 SET AMHDA=0
FOR
SET AMHDA=$ORDER(^AMHPTXP(AMHIEN,41,AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+11 NEW AMHOEN
+12 SET AMHOEN=0
FOR
SET AMHOEN=$ORDER(^AMHPTXP(AMHIEN,41,AMHDA,12,AMHOEN))
IF 'AMHOEN
QUIT
Begin DoDot:2
+13 NEW AMHDATA,AMHPAR,AMHREL
+14 SET AMHDATA=$GET(^AMHPTXP(AMHIEN,41,AMHDA,12,AMHOEN,0))
+15 SET AMHPAR=$PIECE(AMHDATA,U)
+16 SET AMHREL=$PIECE(AMHDATA,U,2)
+17 SET AMHI=AMHI+1
+18 SET @RETVAL@(AMHI)=AMHIEN_U_AMHDA_U_AMHOEN_U_AMHPAR_U_AMHREL_$CHAR(30)
End DoDot:2
End DoDot:1
+19 SET @RETVAL@(AMHI+1)=$CHAR(31)
+20 QUIT
+21 ;
SUM(RETVAL,AMHSTR) ;-- get participants for treatment plan review
+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^T00010BMXIEN2^T00010BMXIEN3^T00250ProgressSummary"_$CHAR(30)
+9 NEW AMHDA
+10 SET AMHDA=0
FOR
SET AMHDA=$ORDER(^AMHPTXP(AMHIEN,41,AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+11 NEW AMHOEN
+12 SET AMHOEN=0
FOR
SET AMHOEN=$ORDER(^AMHPTXP(AMHIEN,41,AMHDA,1,AMHOEN))
IF 'AMHOEN
QUIT
Begin DoDot:2
+13 NEW AMHSUM
+14 SET AMHSUM=$GET(^AMHPTXP(AMHIEN,41,AMHDA,1,AMHOEN,0))
+15 ;I AMHSUM'[$C(10) S AMHSUM=AMHSUM_$C(10) ;cmi/maw 06/16/2010 try removing this and see what happens 11/18/2010
+16 SET AMHI=AMHI+1
+17 SET @RETVAL@(AMHI)=AMHIEN_U_AMHDA_U_AMHOEN_U_AMHSUM_$CHAR(30)
End DoDot:2
End DoDot:1
+18 SET @RETVAL@(AMHI+1)=$CHAR(31)
+19 QUIT
+20 ;
DELRD(RETVAL,AMHSTR) ;-- delete treatment plan review data
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,P,R,AMHIEN,AMHOEN
+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 AMHOEN=$PIECE(AMHSTR,P,2)
+9 SET DA(1)=AMHIEN
+10 SET DA=AMHOEN
+11 SET @RETVAL@(AMHI)="T00001Result"_$CHAR(30)
+12 SET DIK="^AMHPTXP("_DA(1)_",41,"
+13 DO ^DIK
+14 QUIT
+15 ;
DELPAR(RETVAL,AMHSTR) ;-- delete treatment plan review participants
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,P,R,AMHIEN,AMHOEN,AMHUEN
+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 AMHOEN=$PIECE(AMHSTR,P,2)
+9 SET AMHUEN=$PIECE(AMHSTR,P,3)
+10 SET DA(2)=AMHIEN
+11 SET DA(1)=AMHOEN
+12 SET DA=AMHUEN
+13 SET @RETVAL@(AMHI)="T00001Result"_$CHAR(30)
+14 SET DIK="^AMHPTXP("_DA(2)_",41,"_DA(1)_",12,"
+15 DO ^DIK
+16 QUIT
+17 ;
