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

AMHGDTP.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ;
  1.  ;this routine will handle data on the Treatment Plan Data Entry Form (frmTreatmentPlanDataEntry)
  1.  ;
  1. DEBUG(RETVAL,AMHSTR) ;-- debug entry point
  1.  D DEBUG^%Serenji("EP^AMHGD(RETVAL,.AMHSTR)")
  1.  Q
  1.  ;
  1. TP(RETVAL,AMHSTR) ;-- get treatment plan 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^T00030DateEstablished^T00030Program^T00030TargetDate^T00030ReviewDate^T00030DateClosed^T00030DesignatedProvider^T00240ProblemList^T00030CaseAdmit^T00030ConcurredDate^T00030ConcurSupervisor^T00001dsm4"_$C(30)
  1.  N AMHDE,AMHPRGI,AMHPRG,AMHPRGS,AMHTD,AMHRD,AMHDC,AMHPRVI,AMHPRV,AMHPRVS,AMHPRBL,AMHCA,AMHCD,AMHCS,AMHCSI,AMHCSS,AMHDSM4
  1.  S AMHDE=$$GET1^DIQ(9002011.56,AMHIEN,.01,"I")
  1.  S AMHTD=$$GET1^DIQ(9002011.56,AMHIEN,.03,"I")
  1.  S AMHRD=$$GET1^DIQ(9002011.56,AMHIEN,.09,"I")
  1.  S AMHDC=$$GET1^DIQ(9002011.56,AMHIEN,.12,"I")
  1.  S AMHPRGI=$$GET1^DIQ(9002011.56,AMHIEN,.17,"I")
  1.  S AMHPRG=$$GET1^DIQ(9002011.56,AMHIEN,.17)
  1.  I AMHPRGI]"" S AMHPRGS=AMHPRGI_R_AMHPRG
  1.  S AMHPRVI=$$GET1^DIQ(9002011.56,AMHIEN,.04,"I")
  1.  S AMHPRV=$$GET1^DIQ(9002011.56,AMHIEN,.04)
  1.  I AMHPRVI S AMHPRVS=AMHPRVI_R_AMHPRV
  1.  S AMHPRBL=$$GET1^DIQ(9002011.56,AMHIEN,1101)
  1.  S AMHCA=$$GET1^DIQ(9002011.56,AMHIEN,.16,"I")
  1.  S AMHCD=$$GET1^DIQ(9002011.56,AMHIEN,.06,"I")
  1.  S AMHCSI=$$GET1^DIQ(9002011.56,AMHIEN,.05,"I")
  1.  S AMHCS=$$GET1^DIQ(9002011.56,AMHIEN,.05)
  1.  S AMHCSS=$S(AMHCSI:AMHCSI_R_AMHCS,1:"")
  1.  S AMHDSM4=$$GET1^DIQ(9002011.56,AMHIEN,.22,"I")
  1.  S AMHI=AMHI+1
  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)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. AXISI(RETVAL,AMHSTR) ;-- get axis I data
  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)="T00250AxisI"_$C(30)
  1.  N AMHDA
  1.  S AMHDA=0 F  S AMHDA=$O(^AMHPTXP(AMHIEN,6,AMHDA)) Q:'AMHDA  D
  1.  . N AMHDATA
  1.  . S AMHDATA=$G(^AMHPTXP(AMHIEN,6,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)=AMHDATA_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. AXISII(RETVAL,AMHSTR) ;-- get axis II data
  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)="T00250AxisII"_$C(30)
  1.  N AMHDA
  1.  S AMHDA=0 F  S AMHDA=$O(^AMHPTXP(AMHIEN,8,AMHDA)) Q:'AMHDA  D
  1.  . N AMHDATA
  1.  . S AMHDATA=$G(^AMHPTXP(AMHIEN,8,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)=AMHDATA_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. AXISIII(RETVAL,AMHSTR) ;-- get axis III data
  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)="T00250AxisIII"_$C(30)
  1.  N AMHDA
  1.  S AMHDA=0 F  S AMHDA=$O(^AMHPTXP(AMHIEN,7,AMHDA)) Q:'AMHDA  D
  1.  . N AMHDATA
  1.  . S AMHDATA=$G(^AMHPTXP(AMHIEN,7,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)=AMHDATA_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. AXISIV(RETVAL,AMHSTR) ;-- get axis IV data
  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^T00030Code^T00080Narrative"_$C(30)
  1.  N AMHDA
  1.  S AMHDA=0 F  S AMHDA=$O(^AMHPTXP(AMHIEN,9,AMHDA)) Q:'AMHDA  D
  1.  . N AMHXI,AMHXC,AMHXE
  1.  . S AMHXI=$P($G(^AMHPTXP(AMHIEN,9,AMHDA,0)),U)
  1.  . S AMHXC=$$GET1^DIQ(9002012.9,AMHXI,.01)
  1.  . S AMHXE=$$GET1^DIQ(9002012.9,AMHXI,.02)
  1.  . S AMHI=AMHI+1
  1.  . S @RETVAL@(AMHI)=AMHXI_U_AMHXC_U_AMHXE_$C(30)
  1.  Q
  1.  ;
  1. AXISV(RETVAL,AMHSTR) ;-- get axis V data
  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)="T00030AxisV^T00020GAF"_$C(30)
  1.  N AMHDATA,AMHA5,AMHGAF
  1.  S AMHDATA=$G(^AMHPTXP(AMHIEN,16))
  1.  S AMHA5=$P(AMHDATA,U)
  1.  S AMHGAF=$P(AMHDATA,U,2)
  1.  S AMHI=AMHI+1
  1.  S @RETVAL@(AMHI)=AMHA5_U_AMHGAF_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. DX(RETVAL,AMHSTR) ;-- get DX data
  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)="T00250Dx"_$C(30)
  1.  N AMHDA
  1.  S AMHDA=0 F  S AMHDA=$O(^AMHPTXP(AMHIEN,21,AMHDA)) Q:'AMHDA  D
  1.  . N AMHDATA
  1.  . S AMHDATA=$G(^AMHPTXP(AMHIEN,21,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)=AMHDATA_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. NARR(RETVAL,AMHSTR) ;-- get narrative data
  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)="T00250TreatmentPlanNarrative"_$C(30)
  1.  N AMHDA
  1.  S AMHDA=0 F  S AMHDA=$O(^AMHPTXP(AMHIEN,18,AMHDA)) Q:'AMHDA  D
  1.  . N AMHDATA
  1.  . S AMHDATA=$G(^AMHPTXP(AMHIEN,18,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)=AMHDATA_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. REV(RETVAL,AMHSTR) ;-- get treatment plan review list view
  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^T00010BMXIEN2^T00030ReviewDate^T00030ReviewProvider^T00030ReviewSupervisor^T00030NextReviewDate^T00050ReviewProviderComplete^T00050ReviewSupervisorComplete"_$C(30)
  1.  N AMHDA
  1.  S AMHDA=0 F  S AMHDA=$O(^AMHPTXP(AMHIEN,41,AMHDA)) Q:'AMHDA  D
  1.  . N AMHDATA,AMHRD,AMHRP,AMHRS,AMHNR,AMHRPI,AMHRPS,AMHRSI,AMHRSS
  1.  . S AMHDATA=$G(^AMHPTXP(AMHIEN,41,AMHDA,0))
  1.  . S AMHRD=$P(AMHDATA,U)
  1.  . S AMHRPI=$P(AMHDATA,U,3)
  1.  . S AMHRSI=$P(AMHDATA,U,4)
  1.  . S AMHRP=$S($P(AMHDATA,U,3):$$GET1^DIQ(200,$P(AMHDATA,U,3),.01),1:"")
  1.  . S AMHRS=$S($P(AMHDATA,U,4):$$GET1^DIQ(200,$P(AMHDATA,U,4),.01),1:"")
  1.  . I AMHRPI]"" S AMHRPS=AMHRPI_R_AMHRP
  1.  . I AMHRSI]"" S AMHRSS=AMHRSI_R_AMHRS
  1.  . S AMHNR=$P(AMHDATA,U,2)
  1.  . S AMHI=AMHI+1
  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)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. PPAR(RETVAL,AMHSTR) ;-- get plan participants
  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^T00030Participant^T00030Relationship"_$C(30)
  1.  N AMHDA
  1.  S AMHDA=0 F  S AMHDA=$O(^AMHPTXP(AMHIEN,17,AMHDA)) Q:'AMHDA  D
  1.  . N AMHDATA,AMHPAR,AMHREL
  1.  . S AMHDATA=$G(^AMHPTXP(AMHIEN,17,AMHDA,0))
  1.  . S AMHPAR=$P(AMHDATA,U)
  1.  . S AMHREL=$P(AMHDATA,U,2)
  1.  . S AMHI=AMHI+1
  1.  . S @RETVAL@(AMHI)=AMHIEN_U_AMHPAR_U_AMHREL_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. PAR(RETVAL,AMHSTR) ;-- get participants for treatment plan review
  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^T00010BMXIEN2^T00010BMXIEN3^T00030Participant^T00030Relationship"_$C(30)
  1.  N AMHDA
  1.  S AMHDA=0 F  S AMHDA=$O(^AMHPTXP(AMHIEN,41,AMHDA)) Q:'AMHDA  D
  1.  . N AMHOEN
  1.  . S AMHOEN=0 F  S AMHOEN=$O(^AMHPTXP(AMHIEN,41,AMHDA,12,AMHOEN)) Q:'AMHOEN  D
  1.  .. N AMHDATA,AMHPAR,AMHREL
  1.  .. S AMHDATA=$G(^AMHPTXP(AMHIEN,41,AMHDA,12,AMHOEN,0))
  1.  .. S AMHPAR=$P(AMHDATA,U)
  1.  .. S AMHREL=$P(AMHDATA,U,2)
  1.  .. S AMHI=AMHI+1
  1.  ..S @RETVAL@(AMHI)=AMHIEN_U_AMHDA_U_AMHOEN_U_AMHPAR_U_AMHREL_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. SUM(RETVAL,AMHSTR) ;-- get participants for treatment plan review
  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^T00010BMXIEN2^T00010BMXIEN3^T00250ProgressSummary"_$C(30)
  1.  N AMHDA
  1.  S AMHDA=0 F  S AMHDA=$O(^AMHPTXP(AMHIEN,41,AMHDA)) Q:'AMHDA  D
  1.  . N AMHOEN
  1.  . S AMHOEN=0 F  S AMHOEN=$O(^AMHPTXP(AMHIEN,41,AMHDA,1,AMHOEN)) Q:'AMHOEN  D
  1.  .. N AMHSUM
  1.  .. S AMHSUM=$G(^AMHPTXP(AMHIEN,41,AMHDA,1,AMHOEN,0))
  1.  .. ;I AMHSUM'[$C(10) S AMHSUM=AMHSUM_$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_AMHDA_U_AMHOEN_U_AMHSUM_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. DELRD(RETVAL,AMHSTR) ;-- delete treatment plan review data
  1.  S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
  1.  N AMHI,P,R,AMHIEN,AMHOEN
  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 AMHOEN=$P(AMHSTR,P,2)
  1.  S DA(1)=AMHIEN
  1.  S DA=AMHOEN
  1.  S @RETVAL@(AMHI)="T00001Result"_$C(30)
  1.  S DIK="^AMHPTXP("_DA(1)_",41,"
  1.  D ^DIK
  1.  Q
  1.  ;
  1. DELPAR(RETVAL,AMHSTR) ;-- delete treatment plan review participants
  1.  S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
  1.  N AMHI,P,R,AMHIEN,AMHOEN,AMHUEN
  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 AMHOEN=$P(AMHSTR,P,2)
  1.  S AMHUEN=$P(AMHSTR,P,3)
  1.  S DA(2)=AMHIEN
  1.  S DA(1)=AMHOEN
  1.  S DA=AMHUEN
  1.  S @RETVAL@(AMHI)="T00001Result"_$C(30)
  1.  S DIK="^AMHPTXP("_DA(2)_",41,"_DA(1)_",12,"
  1.  D ^DIK
  1.  Q
  1.  ;