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

AMHGDCOM.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ;
  1.  ;
  1.  ;
  1. DEBUG(RETVAL,AMHSTR) ;-- debug entry point
  1.  D DEBUG^%Serenji("EP^AMHGD(RETVAL,.AMHSTR)")
  1.  Q
  1.  ;
  1. COM(RETVAL,AMHSTR) ;-- get community data for community data entry form (frmCommunityDataEntry)
  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 @RETVAL@(AMHI)="T00010BMXIEN^T00050Provider^T00030Program^T00050TypeofContact^T00010StartTime^T00010Time^T00010NumberServed^T00030Target^T00030Date^T00050Location^T00050CommunityofService^T00060ActivityCode^T00050LocalServiceSite"
  1.  S @RETVAL@(AMHI)=@RETVAL@(AMHI)_"^T00010Flag^T00050Clinic"_$C(30)
  1.  S AMHIEN=$P(AMHSTR,P)
  1.  N AMHDT,AMHPRG,AMHACI,AMHAC,AMHACS,AMHACI,AMHTM,AMHPOVI,AMHPOV,AMHPOVS,AMHPRVN,AMHPRVI,AMHPRV,AMHPRVS,AMHNS,AMHTOC,AMHTOCS,AMHTOCI
  1.  N AMHST,AMHTGT,AMHLOCI,AMHLOC,AMHLOCS,AMHCOMI,AMHCOM,AMHCOMS,AMHLSSI,AMHLSS,AMHLSSS,AMHFLG,AMHPOVE,AMHCLNI,AMHCLN,AMHCLNS
  1.  S AMHDT=$$GET1^DIQ(9002011,AMHIEN,.01,"I")
  1.  S AMHDT=$$VCDT^AMHGU(AMHDT)
  1.  S AMHPRG=$$GET1^DIQ(9002011,AMHIEN,.02)
  1.  S AMHACI=$$GET1^DIQ(9002011,AMHIEN,.06,"I")
  1.  S AMHAC=$S(AMHACI:$$GET1^DIQ(9002012,AMHACI,.02),1:"")
  1.  S AMHACS=$S(AMHACI:AMHACI_R_AMHAC,1:"")
  1.  S AMHPOVI=$O(^AMHRPRO("AD",AMHIEN,0))
  1.  I AMHPOVI S AMHPOVE=$P($G(^AMHRPRO(AMHPOVI,0)),U)
  1.  S AMHPOV=$S($G(AMHPOVE):$$GET1^DIQ(9002012.2,AMHPOVE,.02),1:"")
  1.  S AMHPOVS=$S(AMHPOVI:AMHPOVI_R_AMHPOV,1:"")
  1.  S AMHPRVN=$S(AMHPOVI:$$GET1^DIQ(9002011.01,AMHPOVI,.04),1:"")
  1.  S AMHTOCI=$$GET1^DIQ(9002011,AMHIEN,.07,"I")
  1.  S AMHTOC=$$GET1^DIQ(9002011,AMHIEN,.07)
  1.  S AMHTOCS=$S(AMHTOCI:AMHTOCI_R_AMHTOC,1:"")
  1.  S AMHST=""  ;$P($$GET1^DIQ(9002011,AMHIEN,.01),"@",2)
  1.  S AMHARR=$$LVDT^AMHGU(AMHDT)_" "_$$TIME^AMHGU(AMHST)
  1.  S AMHTM=$$GET1^DIQ(9002011,AMHIEN,.12)
  1.  S AMHPRVI=$$GETPRV^AMHGU(AMHIEN,"P")
  1.  S AMHPRV=$S($G(AMHPRVI):$$GET1^DIQ(200,AMHPRVI,.01),1:"")
  1.  S AMHPRVS=$S(AMHPRVI:AMHPRVI_R_AMHPRV,1:"")
  1.  S AMHNS=$$GET1^DIQ(9002011,AMHIEN,.09)
  1.  S AMHTGT=$$GET1^DIQ(9002011,AMHIEN,1106)
  1.  S AMHLOCI=$$GET1^DIQ(9002011,AMHIEN,.04,"I")
  1.  S AMHLOC=$$GET1^DIQ(9002011,AMHIEN,.04)
  1.  S AMHLOCS=$S(AMHLOCI:AMHLOCI_R_AMHLOC,1:"")
  1.  S AMHCOMI=$$GET1^DIQ(9002011,AMHIEN,.05,"I")
  1.  S AMHCOM=$$GET1^DIQ(9002011,AMHIEN,.05)
  1.  S AMHCOMS=$S(AMHCOMI:AMHCOMI_R_AMHCOM,1:"")
  1.  S AMHLSSI=$$GET1^DIQ(9002011,AMHIEN,.31,"I")
  1.  S AMHLSS=$$GET1^DIQ(9002011,AMHIEN,.31)
  1.  S AMHLSSS=$S(AMHLSSI:AMHLSSI_R_AMHLSS,1:"")
  1.  S AMHCLNI=$$GET1^DIQ(9002011,AMHIEN,.25,"I")
  1.  S AMHCLN=$$GET1^DIQ(9002011,AMHIEN,.25)
  1.  S AMHCLNS=$S(AMHCLNI:AMHCLNI_R_AMHCLN,1:"")
  1.  S AMHFLG=$$GET1^DIQ(9002011,AMHIEN,.27)
  1.  S AMHI=AMHI+1
  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)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. PREV(RETVAL,AMHSTR) ;-- get prevention activities
  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^T00030PreventionActivity^T00010Code^T00080Other"_$C(30)
  1.  N AMHDA
  1.  S AMHDA=0 F  S AMHDA=$O(^AMHRPA("AD",AMHIEN,AMHDA)) Q:'AMHDA  D
  1.  . N AMHPA,AMHPAI,AMHCOD,AMHOTH
  1.  . S AMHPAI=$$GET1^DIQ(9002011.09,AMHDA,.01,"I")
  1.  . S AMHPA=$$GET1^DIQ(9002011.09,AMHDA,.01)
  1.  . S AMHCOD=$$GET1^DIQ(9002014.8,AMHPAI,1)
  1.  . S AMHOTH=$$GET1^DIQ(9002011.09,AMHDA,.04)
  1.  . S AMHI=AMHI+1
  1.  . S @RETVAL@(AMHI)=AMHPAI_U_AMHPA_U_AMHCOD_U_AMHOTH_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. SP(RETVAL,AMHSTR) ;-- get secondary providers
  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^T00030Provider"_$C(30)
  1.  N AMHDA
  1.  S AMHDA=0 F  S AMHDA=$O(^AMHRPROV("AD",AMHIEN,AMHDA)) Q:'AMHDA  D
  1.  . N AMHSPRV,AMHSPRVI
  1.  . Q:$$GET1^DIQ(9002011.02,AMHDA,.04,"I")'="S"  ;filter out primary
  1.  . S AMHSPRVI=$$GET1^DIQ(9002011.02,AMHDA,.01,"I")
  1.  . S AMHSPRV=$$GET1^DIQ(9002011.02,AMHDA,.01)
  1.  . S AMHI=AMHI+1
  1.  . S @RETVAL@(AMHI)=AMHSPRVI_U_AMHSPRV_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. POV(RETVAL,AMHSTR) ;-- get POV's
  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^T00010Code^T00100Narrative"_$C(30)
  1.  N AMHPOVI
  1.  S AMHPOVI=0 F  S AMHPOVI=$O(^AMHRPRO("AD",AMHIEN,AMHPOVI)) Q:'AMHPOVI  D
  1.  . N AMHPOV,AMHPOVC,AMHPOVE
  1.  . S AMHPOV=$$GET1^DIQ(9002011.01,AMHPOVI,.01,"I")
  1.  . S AMHPOVC=$$GET1^DIQ(9002011.01,AMHPOVI,.01)
  1.  . S AMHPOVE=$S(AMHPOV]"":$$GET1^DIQ(9002011.01,AMHPOVI,.04),1:"")
  1.  . S AMHI=AMHI+1
  1.  . S @RETVAL@(AMHI)=AMHPOV_U_AMHPOVC_U_AMHPOVE_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. NOTES(RETVAL,AMHSTR) ;-- get community notes
  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)="T00250Notes"_$C(30)
  1.  N AMHDA,AMHOEN,AMHSUB
  1.  S AMHDA=0 F  S AMHDA=$O(^AMHREC(AMHIEN,81,AMHDA)) Q:'AMHDA  D
  1.  . N AMHDATA
  1.  . S AMHDATA=$G(^AMHREC(AMHIEN,81,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.  ;