AMHGDCOM ; IHS/CMI/MAW - AMHG Community Activities 1/16/2009 8:43:28 AM ;
;;4.0;IHS BEHAVIORAL HEALTH;**1**;JUN 18, 2010;Build 8
;
;
;
;
DEBUG(RETVAL,AMHSTR) ;-- debug entry point
D DEBUG^%Serenji("EP^AMHGD(RETVAL,.AMHSTR)")
Q
;
COM(RETVAL,AMHSTR) ;-- get community data for community data entry form (frmCommunityDataEntry)
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 @RETVAL@(AMHI)="T00010BMXIEN^T00050Provider^T00030Program^T00050TypeofContact^T00010StartTime^T00010Time^T00010NumberServed^T00030Target^T00030Date^T00050Location^T00050CommunityofService^T00060ActivityCode^T00050LocalServiceSite"
S @RETVAL@(AMHI)=@RETVAL@(AMHI)_"^T00010Flag^T00050Clinic"_$C(30)
S AMHIEN=$P(AMHSTR,P)
N AMHDT,AMHPRG,AMHACI,AMHAC,AMHACS,AMHACI,AMHTM,AMHPOVI,AMHPOV,AMHPOVS,AMHPRVN,AMHPRVI,AMHPRV,AMHPRVS,AMHNS,AMHTOC,AMHTOCS,AMHTOCI
N AMHST,AMHTGT,AMHLOCI,AMHLOC,AMHLOCS,AMHCOMI,AMHCOM,AMHCOMS,AMHLSSI,AMHLSS,AMHLSSS,AMHFLG,AMHPOVE,AMHCLNI,AMHCLN,AMHCLNS
S AMHDT=$$GET1^DIQ(9002011,AMHIEN,.01,"I")
S AMHDT=$$VCDT^AMHGU(AMHDT)
S AMHPRG=$$GET1^DIQ(9002011,AMHIEN,.02)
S AMHACI=$$GET1^DIQ(9002011,AMHIEN,.06,"I")
S AMHAC=$S(AMHACI:$$GET1^DIQ(9002012,AMHACI,.02),1:"")
S AMHACS=$S(AMHACI:AMHACI_R_AMHAC,1:"")
S AMHPOVI=$O(^AMHRPRO("AD",AMHIEN,0))
I AMHPOVI S AMHPOVE=$P($G(^AMHRPRO(AMHPOVI,0)),U)
S AMHPOV=$S($G(AMHPOVE):$$GET1^DIQ(9002012.2,AMHPOVE,.02),1:"")
S AMHPOVS=$S(AMHPOVI:AMHPOVI_R_AMHPOV,1:"")
S AMHPRVN=$S(AMHPOVI:$$GET1^DIQ(9002011.01,AMHPOVI,.04),1:"")
S AMHTOCI=$$GET1^DIQ(9002011,AMHIEN,.07,"I")
S AMHTOC=$$GET1^DIQ(9002011,AMHIEN,.07)
S AMHTOCS=$S(AMHTOCI:AMHTOCI_R_AMHTOC,1:"")
S AMHST="" ;$P($$GET1^DIQ(9002011,AMHIEN,.01),"@",2)
S AMHARR=$$LVDT^AMHGU(AMHDT)_" "_$$TIME^AMHGU(AMHST)
S AMHTM=$$GET1^DIQ(9002011,AMHIEN,.12)
S AMHPRVI=$$GETPRV^AMHGU(AMHIEN,"P")
S AMHPRV=$S($G(AMHPRVI):$$GET1^DIQ(200,AMHPRVI,.01),1:"")
S AMHPRVS=$S(AMHPRVI:AMHPRVI_R_AMHPRV,1:"")
S AMHNS=$$GET1^DIQ(9002011,AMHIEN,.09)
S AMHTGT=$$GET1^DIQ(9002011,AMHIEN,1106)
S AMHLOCI=$$GET1^DIQ(9002011,AMHIEN,.04,"I")
S AMHLOC=$$GET1^DIQ(9002011,AMHIEN,.04)
S AMHLOCS=$S(AMHLOCI:AMHLOCI_R_AMHLOC,1:"")
S AMHCOMI=$$GET1^DIQ(9002011,AMHIEN,.05,"I")
S AMHCOM=$$GET1^DIQ(9002011,AMHIEN,.05)
S AMHCOMS=$S(AMHCOMI:AMHCOMI_R_AMHCOM,1:"")
S AMHLSSI=$$GET1^DIQ(9002011,AMHIEN,.31,"I")
S AMHLSS=$$GET1^DIQ(9002011,AMHIEN,.31)
S AMHLSSS=$S(AMHLSSI:AMHLSSI_R_AMHLSS,1:"")
S AMHCLNI=$$GET1^DIQ(9002011,AMHIEN,.25,"I")
S AMHCLN=$$GET1^DIQ(9002011,AMHIEN,.25)
S AMHCLNS=$S(AMHCLNI:AMHCLNI_R_AMHCLN,1:"")
S AMHFLG=$$GET1^DIQ(9002011,AMHIEN,.27)
S AMHI=AMHI+1
S @RETVAL@(AMHI)=AMHIEN_U_AMHPRVS_U_AMHPRG_U_AMHTOCS_U_AMHST_U_AMHTM_U_AMHNS_U_AMHTGT_U_AMHDT_U_AMHLOCS_U_AMHCOMS_U_AMHACS_U_AMHLSSS_U_AMHFLG_U_AMHCLNS_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
PREV(RETVAL,AMHSTR) ;-- get prevention activities
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^T00030PreventionActivity^T00010Code^T00080Other"_$C(30)
N AMHDA
S AMHDA=0 F S AMHDA=$O(^AMHRPA("AD",AMHIEN,AMHDA)) Q:'AMHDA D
. N AMHPA,AMHPAI,AMHCOD,AMHOTH
. S AMHPAI=$$GET1^DIQ(9002011.09,AMHDA,.01,"I")
. S AMHPA=$$GET1^DIQ(9002011.09,AMHDA,.01)
. S AMHCOD=$$GET1^DIQ(9002014.8,AMHPAI,1)
. S AMHOTH=$$GET1^DIQ(9002011.09,AMHDA,.04)
. S AMHI=AMHI+1
. S @RETVAL@(AMHI)=AMHPAI_U_AMHPA_U_AMHCOD_U_AMHOTH_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
SP(RETVAL,AMHSTR) ;-- get secondary providers
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^T00030Provider"_$C(30)
N AMHDA
S AMHDA=0 F S AMHDA=$O(^AMHRPROV("AD",AMHIEN,AMHDA)) Q:'AMHDA D
. N AMHSPRV,AMHSPRVI
. Q:$$GET1^DIQ(9002011.02,AMHDA,.04,"I")'="S" ;filter out primary
. S AMHSPRVI=$$GET1^DIQ(9002011.02,AMHDA,.01,"I")
. S AMHSPRV=$$GET1^DIQ(9002011.02,AMHDA,.01)
. S AMHI=AMHI+1
. S @RETVAL@(AMHI)=AMHSPRVI_U_AMHSPRV_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
POV(RETVAL,AMHSTR) ;-- get POV's
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^T00010Code^T00100Narrative"_$C(30)
N AMHPOVI
S AMHPOVI=0 F S AMHPOVI=$O(^AMHRPRO("AD",AMHIEN,AMHPOVI)) Q:'AMHPOVI D
. N AMHPOV,AMHPOVC,AMHPOVE
. S AMHPOV=$$GET1^DIQ(9002011.01,AMHPOVI,.01,"I")
. S AMHPOVC=$$GET1^DIQ(9002011.01,AMHPOVI,.01)
. S AMHPOVE=$S(AMHPOV]"":$$GET1^DIQ(9002011.01,AMHPOVI,.04),1:"")
. S AMHI=AMHI+1
. S @RETVAL@(AMHI)=AMHPOV_U_AMHPOVC_U_AMHPOVE_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
NOTES(RETVAL,AMHSTR) ;-- get community notes
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)="T00250Notes"_$C(30)
N AMHDA,AMHOEN,AMHSUB
S AMHDA=0 F S AMHDA=$O(^AMHREC(AMHIEN,81,AMHDA)) Q:'AMHDA D
. N AMHDATA
. S AMHDATA=$G(^AMHREC(AMHIEN,81,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
;
AMHGDCOM ; IHS/CMI/MAW - AMHG Community Activities 1/16/2009 8:43:28 AM ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;**1**;JUN 18, 2010;Build 8
+2 ;
+3 ;
+4 ;
+5 ;
DEBUG(RETVAL,AMHSTR) ;-- debug entry point
+1 DO DEBUG^%Serenji("EP^AMHGD(RETVAL,.AMHSTR)")
+2 QUIT
+3 ;
COM(RETVAL,AMHSTR) ;-- get community data for community data entry form (frmCommunityDataEntry)
+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 @RETVAL@(AMHI)="T00010BMXIEN^T00050Provider^T00030Program^T00050TypeofContact^T00010StartTime^T00010Time^T00010NumberServed^T00030Target^T00030Date^T00050Location^T00050CommunityofService^T00060ActivityCode^T00050LocalServiceSite"
+8 SET @RETVAL@(AMHI)=@RETVAL@(AMHI)_"^T00010Flag^T00050Clinic"_$CHAR(30)
+9 SET AMHIEN=$PIECE(AMHSTR,P)
+10 NEW AMHDT,AMHPRG,AMHACI,AMHAC,AMHACS,AMHACI,AMHTM,AMHPOVI,AMHPOV,AMHPOVS,AMHPRVN,AMHPRVI,AMHPRV,AMHPRVS,AMHNS,AMHTOC,AMHTOCS,AMHTOCI
+11 NEW AMHST,AMHTGT,AMHLOCI,AMHLOC,AMHLOCS,AMHCOMI,AMHCOM,AMHCOMS,AMHLSSI,AMHLSS,AMHLSSS,AMHFLG,AMHPOVE,AMHCLNI,AMHCLN,AMHCLNS
+12 SET AMHDT=$$GET1^DIQ(9002011,AMHIEN,.01,"I")
+13 SET AMHDT=$$VCDT^AMHGU(AMHDT)
+14 SET AMHPRG=$$GET1^DIQ(9002011,AMHIEN,.02)
+15 SET AMHACI=$$GET1^DIQ(9002011,AMHIEN,.06,"I")
+16 SET AMHAC=$SELECT(AMHACI:$$GET1^DIQ(9002012,AMHACI,.02),1:"")
+17 SET AMHACS=$SELECT(AMHACI:AMHACI_R_AMHAC,1:"")
+18 SET AMHPOVI=$ORDER(^AMHRPRO("AD",AMHIEN,0))
+19 IF AMHPOVI
SET AMHPOVE=$PIECE($GET(^AMHRPRO(AMHPOVI,0)),U)
+20 SET AMHPOV=$SELECT($GET(AMHPOVE):$$GET1^DIQ(9002012.2,AMHPOVE,.02),1:"")
+21 SET AMHPOVS=$SELECT(AMHPOVI:AMHPOVI_R_AMHPOV,1:"")
+22 SET AMHPRVN=$SELECT(AMHPOVI:$$GET1^DIQ(9002011.01,AMHPOVI,.04),1:"")
+23 SET AMHTOCI=$$GET1^DIQ(9002011,AMHIEN,.07,"I")
+24 SET AMHTOC=$$GET1^DIQ(9002011,AMHIEN,.07)
+25 SET AMHTOCS=$SELECT(AMHTOCI:AMHTOCI_R_AMHTOC,1:"")
+26 ;$P($$GET1^DIQ(9002011,AMHIEN,.01),"@",2)
SET AMHST=""
+27 SET AMHARR=$$LVDT^AMHGU(AMHDT)_" "_$$TIME^AMHGU(AMHST)
+28 SET AMHTM=$$GET1^DIQ(9002011,AMHIEN,.12)
+29 SET AMHPRVI=$$GETPRV^AMHGU(AMHIEN,"P")
+30 SET AMHPRV=$SELECT($GET(AMHPRVI):$$GET1^DIQ(200,AMHPRVI,.01),1:"")
+31 SET AMHPRVS=$SELECT(AMHPRVI:AMHPRVI_R_AMHPRV,1:"")
+32 SET AMHNS=$$GET1^DIQ(9002011,AMHIEN,.09)
+33 SET AMHTGT=$$GET1^DIQ(9002011,AMHIEN,1106)
+34 SET AMHLOCI=$$GET1^DIQ(9002011,AMHIEN,.04,"I")
+35 SET AMHLOC=$$GET1^DIQ(9002011,AMHIEN,.04)
+36 SET AMHLOCS=$SELECT(AMHLOCI:AMHLOCI_R_AMHLOC,1:"")
+37 SET AMHCOMI=$$GET1^DIQ(9002011,AMHIEN,.05,"I")
+38 SET AMHCOM=$$GET1^DIQ(9002011,AMHIEN,.05)
+39 SET AMHCOMS=$SELECT(AMHCOMI:AMHCOMI_R_AMHCOM,1:"")
+40 SET AMHLSSI=$$GET1^DIQ(9002011,AMHIEN,.31,"I")
+41 SET AMHLSS=$$GET1^DIQ(9002011,AMHIEN,.31)
+42 SET AMHLSSS=$SELECT(AMHLSSI:AMHLSSI_R_AMHLSS,1:"")
+43 SET AMHCLNI=$$GET1^DIQ(9002011,AMHIEN,.25,"I")
+44 SET AMHCLN=$$GET1^DIQ(9002011,AMHIEN,.25)
+45 SET AMHCLNS=$SELECT(AMHCLNI:AMHCLNI_R_AMHCLN,1:"")
+46 SET AMHFLG=$$GET1^DIQ(9002011,AMHIEN,.27)
+47 SET AMHI=AMHI+1
+48 SET @RETVAL@(AMHI)=AMHIEN_U_AMHPRVS_U_AMHPRG_U_AMHTOCS_U_AMHST_U_AMHTM_U_AMHNS_U_AMHTGT_U_AMHDT_U_AMHLOCS_U_AMHCOMS_U_AMHACS_U_AMHLSSS_U_AMHFLG_U_AMHCLNS_$CHAR(30)
+49 SET @RETVAL@(AMHI+1)=$CHAR(31)
+50 QUIT
+51 ;
PREV(RETVAL,AMHSTR) ;-- get prevention activities
+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^T00030PreventionActivity^T00010Code^T00080Other"_$CHAR(30)
+9 NEW AMHDA
+10 SET AMHDA=0
FOR
SET AMHDA=$ORDER(^AMHRPA("AD",AMHIEN,AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+11 NEW AMHPA,AMHPAI,AMHCOD,AMHOTH
+12 SET AMHPAI=$$GET1^DIQ(9002011.09,AMHDA,.01,"I")
+13 SET AMHPA=$$GET1^DIQ(9002011.09,AMHDA,.01)
+14 SET AMHCOD=$$GET1^DIQ(9002014.8,AMHPAI,1)
+15 SET AMHOTH=$$GET1^DIQ(9002011.09,AMHDA,.04)
+16 SET AMHI=AMHI+1
+17 SET @RETVAL@(AMHI)=AMHPAI_U_AMHPA_U_AMHCOD_U_AMHOTH_$CHAR(30)
End DoDot:1
+18 SET @RETVAL@(AMHI+1)=$CHAR(31)
+19 QUIT
+20 ;
SP(RETVAL,AMHSTR) ;-- get secondary providers
+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^T00030Provider"_$CHAR(30)
+9 NEW AMHDA
+10 SET AMHDA=0
FOR
SET AMHDA=$ORDER(^AMHRPROV("AD",AMHIEN,AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+11 NEW AMHSPRV,AMHSPRVI
+12 ;filter out primary
IF $$GET1^DIQ(9002011.02,AMHDA,.04,"I")'="S"
QUIT
+13 SET AMHSPRVI=$$GET1^DIQ(9002011.02,AMHDA,.01,"I")
+14 SET AMHSPRV=$$GET1^DIQ(9002011.02,AMHDA,.01)
+15 SET AMHI=AMHI+1
+16 SET @RETVAL@(AMHI)=AMHSPRVI_U_AMHSPRV_$CHAR(30)
End DoDot:1
+17 SET @RETVAL@(AMHI+1)=$CHAR(31)
+18 QUIT
+19 ;
POV(RETVAL,AMHSTR) ;-- get POV's
+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^T00010Code^T00100Narrative"_$CHAR(30)
+9 NEW AMHPOVI
+10 SET AMHPOVI=0
FOR
SET AMHPOVI=$ORDER(^AMHRPRO("AD",AMHIEN,AMHPOVI))
IF 'AMHPOVI
QUIT
Begin DoDot:1
+11 NEW AMHPOV,AMHPOVC,AMHPOVE
+12 SET AMHPOV=$$GET1^DIQ(9002011.01,AMHPOVI,.01,"I")
+13 SET AMHPOVC=$$GET1^DIQ(9002011.01,AMHPOVI,.01)
+14 SET AMHPOVE=$SELECT(AMHPOV]"":$$GET1^DIQ(9002011.01,AMHPOVI,.04),1:"")
+15 SET AMHI=AMHI+1
+16 SET @RETVAL@(AMHI)=AMHPOV_U_AMHPOVC_U_AMHPOVE_$CHAR(30)
End DoDot:1
+17 SET @RETVAL@(AMHI+1)=$CHAR(31)
+18 QUIT
+19 ;
NOTES(RETVAL,AMHSTR) ;-- get community notes
+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)="T00250Notes"_$CHAR(30)
+9 NEW AMHDA,AMHOEN,AMHSUB
+10 SET AMHDA=0
FOR
SET AMHDA=$ORDER(^AMHREC(AMHIEN,81,AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+11 NEW AMHDATA
+12 SET AMHDATA=$GET(^AMHREC(AMHIEN,81,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 ;
