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

AMHGDVF.m

Go to the documentation of this file. 
  1. AMHGDVF ; IHS/CMI/MAW - AMH BH GUI Visit Form (frmVisitDataEntry) Data ;
  1.  ;;4.0;IHS BEHAVIORAL HEALTH;**1,4**;JUN 18, 2010;Build 28
  1.  ;
  1.  ;
  1. DEBUG(RETVAL,AMHSTR) ;-- debug entry point
  1.  D DEBUG^%Serenji("EP^AMHGD(RETVAL,.AMHSTR)")
  1.  Q
  1.  ;
  1. VI(RETVAL,AMHSTR) ;-- retrieve visit information
  1.  S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
  1.  N AMHI,P,R
  1.  S P="|",R="~"
  1.  S RETVAL="^AMHTMP("_$J_")"
  1.  S AMHI=0
  1.  K ^AMHTMP($J)
  1.  S @RETVAL@(AMHI)="T00010BMXIEN^T00030PrimaryProvider^T00030Program^T00030Clinic^T00030TypeofContact^T00010ArrivalTime^T00020EncounterDate^T00030EncounterLocation^T00010ApptWi^T00030CommofService^T00010Visit^T00001EHR"_$C(30)
  1.  N AMHIEN,AMHPRVI,AMHPRV,AMHPRGI,AMHPRG,AMHCLNI,AMHCLN,AMHTOCI,AMHTOC,AMHARR,AMHENCDT,AMHELOCI,AMHELOC,AMHAPWII,AMHAPWI,AMHCOMMI,AMHCOMM,AMHVST
  1.  N AMHPRVS,AMHPRGS,AMHCLNS,AMHTOCS,AMHLOCS,AMHAPWIS,AMHCOMMS,AMHEHR
  1.  S AMHIEN=$P(AMHSTR,P)
  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 AMHENCDT=$$GET1^DIQ(9002011,AMHIEN,.01,"I")
  1.  S AMHPRGI=$$GET1^DIQ(9002011,AMHIEN,.02,"I")
  1.  S AMHPRG=$$GET1^DIQ(9002011,AMHIEN,.02)
  1.  S AMHPRGS=AMHPRGI
  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 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 AMHARR=$P($$GET1^DIQ(9002011,AMHIEN,.01,"I"),".",2)
  1.  I $G(AMHARR) D
  1.  . I $L(AMHARR)=2 S AMHARR=AMHARR_"00" Q
  1.  . I $L(AMHARR)=3 S AMHARR=AMHARR_"0" Q
  1.  S AMHENCDT=$$VCDT^AMHGU(AMHENCDT)
  1.  S AMHARR=""  ;$$LVDT^AMHGU(AMHENCDT)_" "_$$TIME^AMHGU(AMHARR)
  1.  S AMHELOCI=$$GET1^DIQ(9002011,AMHIEN,.04,"I")
  1.  S AMHELOC=$$GET1^DIQ(9002011,AMHIEN,.04)
  1.  S AMHLOCS=$S(AMHELOCI:AMHELOCI_R_AMHELOC,1:"")
  1.  S AMHAPWII=$$GET1^DIQ(9002011,AMHIEN,.11,"I")
  1.  S AMHAPWI=$$GET1^DIQ(9002011,AMHIEN,.11)
  1.  S AMHAPWIS=AMHAPWII
  1.  S AMHCOMMI=$$GET1^DIQ(9002011,AMHIEN,.05,"I")
  1.  S AMHCOMM=$$GET1^DIQ(9002011,AMHIEN,.05)
  1.  S AMHCOMMS=$S(AMHCOMMI:AMHCOMMI_R_AMHCOMM,1:"")
  1.  S AMHVST=$$GET1^DIQ(9002011,AMHIEN,.16,"I")
  1.  S AMHEHR=$S($$GET1^DIQ(9002011,AMHIEN,1110,"I"):1,1:"")
  1.  S AMHI=AMHI+1
  1.  S @RETVAL@(AMHI)=AMHIEN_U_AMHPRVS_U_AMHPRG_U_AMHCLNS_U_AMHTOCS_U_AMHARR_U_AMHENCDT_U_AMHLOCS_U_AMHAPWI_U_AMHCOMMS_U_AMHVST_U_AMHEHR_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. AXIS2(RETVAL,AMHSTR) ;-- retrieve POV information
  1.  S X="MERR^AMHGU",@^%ZOSF("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.  . ;I $G(AMHPOVE)="" S AMHPOVE=$$GET1^DIQ(9002012.2,AMHPOV,.02)
  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. AXIS3(RETVAL,AMHSTR) ;-- retrieve AXIS III information
  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(^AMHREC(AMHIEN,53,AMHDA)) Q:'AMHDA  D
  1.  . N AMHDATA
  1.  . S AMHDATA=$TR($G(^AMHREC(AMHIEN,53,AMHDA,0)),U," ")
  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. AXIS4(RETVAL,AMHSTR) ;-- retrieve AXIS IV information
  1.  S X="MERR^AMHGU",@^%ZOSF("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 AMHDA
  1.  S AMHDA=0 F  S AMHDA=$O(^AMHREC(AMHIEN,61,AMHDA)) Q:'AMHDA  D
  1.  . N AMHAXI4I,AMHAXI4C,AMHAXI4E
  1.  . S AMHAXI4I=$G(^AMHREC(AMHIEN,61,AMHDA,0))
  1.  . S AMHAXI4C=$$GET1^DIQ(9002012.9,AMHAXI4I,.01)
  1.  . S AMHAXI4E=$$GET1^DIQ(9002012.9,AMHAXI4I,.02)
  1.  . S AMHI=AMHI+1
  1.  . S @RETVAL@(AMHI)=AMHAXI4I_U_AMHAXI4C_U_AMHAXI4E_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. AXIS5(RETVAL,AMHSTR) ;-- retreive the AXIS GAF scale for this visit form
  1.  S X="MERR^AMHGU",@^%ZOSF("TRAP")
  1.  N AMHI,P,R,AMHAXV,AMHIEN
  1.  S P="|",R="~"
  1.  S RETVAL="^AMHTMP("_$J_")"
  1.  S AMHI=0
  1.  K ^AMHTMP($J)
  1.  S @RETVAL@(AMHI)="T00010AxisV^T00020GAF"_$C(30)
  1.  S AMHIEN=$P(AMHSTR,P)
  1.  S AMHAXV=$$GET1^DIQ(9002011,AMHIEN,.14)
  1.  S AMHGAF=$$GET1^DIQ(9002011,AMHIEN,1115)
  1.  S AMHI=AMHI+1
  1.  S @RETVAL@(AMHI)=AMHAXV_U_AMHGAF_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. CC(RETVAL,AMHSTR) ;-- retrieve the CC CC/SOAP tab
  1.  S X="MERR^AMHGU",@^%ZOSF("TRAP")
  1.  N AMHI,P,R,AMHCC,AMHIEN
  1.  S P="|",R="~"
  1.  S RETVAL="^AMHTMP("_$J_")"
  1.  S AMHI=0
  1.  K ^AMHTMP($J)
  1.  S @RETVAL@(AMHI)="T00100ChiefComplaint"_$C(30)
  1.  S AMHIEN=$P(AMHSTR,P)
  1.  S AMHCC=$G(^AMHREC(AMHIEN,21))
  1.  S AMHI=AMHI+1
  1.  S @RETVAL@(AMHI)=AMHCC_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. SOAP(RETVAL,AMHSTR) ;-- retrieve the SOAP for the CC/SOAP tab
  1.  S X="MERR^AMHGU",@^%ZOSF("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.  I $P($G(^AMHREC(AMHIEN,11)),U,10) D  Q
  1.  . D TIU^AMHGDVF2(.RETVAL,AMHIEN)
  1.  S @RETVAL@(AMHI)="T00250Soap"_$C(30)
  1.  N AMHDA
  1.  S AMHDA=0 F  S AMHDA=$O(^AMHREC(AMHIEN,31,AMHDA)) Q:'AMHDA  D
  1.  . N AMHDATA
  1.  . S AMHDATA=$G(^AMHREC(AMHIEN,31,AMHDA,0))
  1.  . S AMHI=AMHI+1
  1.  . S @RETVAL@(AMHI)=AMHDATA_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. COMAPP(RETVAL,AMHSTR) ;-- retrieve the comment/next appointment for the CC/SOAP tab
  1.  S X="MERR^AMHGU",@^%ZOSF("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)="T00250CommentAppointment"_$C(30)
  1.  N AMHDA
  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.  . S AMHI=AMHI+1
  1.  . S @RETVAL@(AMHI)=AMHDATA_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. PDPN(RETVAL,AMHSTR) ;-- retrieve the placement disposition and placement name for CC/SOAP tab
  1.  S X="MERR^AMHGU",@^%ZOSF("TRAP")
  1.  N AMHI,P,R,AMHIEN,AMHPDI,AMHPDE,AMHPDS,AMHPDN
  1.  S P="|",R="~"
  1.  S RETVAL="^AMHTMP("_$J_")"
  1.  S AMHI=0
  1.  K ^AMHTMP($J)
  1.  S @RETVAL@(AMHI)="T00010BMXIEN^T00050PlacementDisposition^T00050PlacementName"_$C(30)
  1.  S AMHIEN=$P(AMHSTR,P)
  1.  S AMHPDI=$$GET1^DIQ(9002011,AMHIEN,.17,"I")
  1.  S AMHPDE=$$GET1^DIQ(9002011,AMHIEN,.17)
  1.  S AMHPDS=$S(AMHPDI:AMHPDI_R_AMHPDE,1:"")
  1.  S AMHPDN=$$GET1^DIQ(9002011,AMHIEN,.18)
  1.  S AMHI=AMHI+1
  1.  S @RETVAL@(AMHI)=AMHPDI_U_AMHPDS_U_AMHPDN_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. PCCMED(RETVAL,AMHSTR) ;-- retrieve PCC Medications for Rx Tab
  1.  S X="MERR^AMHGU",@^%ZOSF("TRAP")
  1.  N AMHI,P,R,AMHBD,AMHED,AMHP,AMHB,AMHE
  1.  S P="|",R="~"
  1.  S RETVAL="^AMHTMP("_$J_")"
  1.  S AMHI=0
  1.  K ^AMHTMP($J)
  1.  S AMHB=$P(AMHSTR,P)
  1.  S AMHE=$P(AMHSTR,P,2)
  1.  S AMHP=$P(AMHSTR,P,3)
  1.  S AMHB=9999999-AMHB
  1.  S AMHE=9999999-AMHE
  1.  S @RETVAL@(AMHI)="T00010BMXIEN^T00030VisitDate^T00050Medication^T00010SIG^T00010Qty^T00010Days^T00030Provider"_$C(30)
  1.  N AMHDA
  1.  S AMHDA=(AMHE-.0001) F  S AMHDA=$O(^AUPNVMED("AA",AMHP,AMHDA)) Q:'AMHDA!(AMHDA>(AMHB+.9999))  D
  1.  . N AMHIEN
  1.  . S AMHIEN=0 F  S AMHIEN=$O(^AUPNVMED("AA",AMHP,AMHDA,AMHIEN)) Q:'AMHIEN  D
  1.  .. N AMHDATA,AMHVDT,AMHRX,AMHSIG,AMHQTY,AMHDAYS,AMHPRV
  1.  .. S AMHDATA=$G(^AUPNVMED(AMHIEN,0))
  1.  .. S AMHVDT=$P($G(^AUPNVSIT($P(AMHDATA,U,3),0)),U)
  1.  .. I $L($P(AMHVDT,".")<4) D
  1.  ... S AMHTIME=$P(AMHVDT,".",2)
  1.  ... S AMHVDT=$P(AMHVDT,".")
  1.  ... I $L(AMHTIME)=1 S AMHTIME=AMHTIME_"000"
  1.  ... I $L(AMHTIME)=2 S AMHTIME=AMHTIME_"00"
  1.  ... I $L(AMHTIME)=3 S AMHTIME=AMHTIME_"0"
  1.  ... S AMHVDT=AMHVDT_"."_AMHTIME
  1.  .. S AMHMED=$$GET1^DIQ(9000010.14,AMHIEN,.01)
  1.  .. S AMHSIG=$$GET1^DIQ(9000010.14,AMHIEN,.05)
  1.  .. S AMHQTY=$$GET1^DIQ(9000010.14,AMHIEN,.06)
  1.  .. S AMHDAYS=$$GET1^DIQ(9000010.14,AMHIEN,.07)
  1.  .. S AMHPRV=$$GET1^DIQ(9000010.14,AMHIEN,1202)
  1.  .. S AMHI=AMHI+1
  1.  .. S @RETVAL@(AMHI)=AMHIEN_U_AMHVDT_U_AMHMED_U_AMHSIG_U_AMHQTY_U_AMHDAYS_U_AMHPRV_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. BHMED(RETVAL,AMHSTR) ;-- retrieve Behavioral Health Medications for Rx Tab
  1.  S AMHX="MERR^AMHGU",@^%ZOSF("TRAP")
  1.  N AMHI,P,R,AMHBD,AMHED,AMHP,AMHDASH,AMHB,AMHE,AMHDA,AMHIEN,AMHIVB,AMHIVE
  1.  S P="|",R="~"
  1.  S RETVAL="^AMHTMP("_$J_")"
  1.  S AMHI=0
  1.  K ^AMHTMP($J)
  1.  S AMHB=$P(AMHSTR,P)
  1.  S AMHE=$P(AMHSTR,P,2)
  1.  S AMHP=$P(AMHSTR,P,3)
  1.  S AMHIVB=(9999999-AMHB)+.9999
  1.  S AMHIVE=(9999999-AMHE)-.0001
  1.  F I=1:1:80 S $E(AMHDASH,I)="-"
  1.  S @RETVAL@(AMHI)="T00010BMXIEN^T00030VisitDate^T00250Medications"_$C(30)
  1.  S AMHDA=AMHIVE F  S AMHDA=$O(^AMHREC("AE",AMHP,AMHDA)) Q:'AMHDA!(AMHDA>AMHIVB)  D
  1.  . S AMHIEN=0 F  S AMHIEN=$O(^AMHREC("AE",AMHP,AMHDA,AMHIEN)) Q:'AMHIEN  D
  1.  .. N AMHOEN,AMHVDTI,AMHVDT
  1.  .. Q:$G(^AMHREC(AMHIEN,41,1,0))=""
  1.  .. I $D(^AMHREC(AMHIEN,41)),$G(^AMHREC(AMHIEN,41,1,0))]"" D
  1.  ... S AMHVDTI=$P($G(^AMHREC(AMHIEN,0)),U)
  1.  ... S AMHVDT=$S($G(AMHVDTI):$$LVDT^AMHGU($P(AMHVDTI,"."))_"@"_$P(AMHVDTI,".",2),1:"")
  1.  ... S AMHI=AMHI+1
  1.  ... S @RETVAL@(AMHI)=AMHIEN_U_AMHVDT_U_$C(30)
  1.  .. S AMHOEN=0 F  S AMHOEN=$O(^AMHREC(AMHIEN,41,AMHOEN)) Q:'AMHOEN  D
  1.  ... S AMHI=AMHI+1
  1.  ... S AMHDATA=$G(^AMHREC(AMHIEN,41,AMHOEN,0))
  1.  ... ;S AMHDATA=$TR(AMHDATA,$C(13))
  1.  ... S AMHDATA=$TR(AMHDATA,$C(10))
  1.  ... ;S AMHDATA=$TR(AMHDATA,$C(10,10))
  1.  ... S @RETVAL@(AMHI)=AMHIEN_U_U_$G(AMHDATA)_$C(30)
  1.  .. I $D(^AMHREC(AMHIEN,41)),$G(^AMHREC(AMHIEN,41,1,0))]"" S AMHI=AMHI+1,@RETVAL@(AMHI)=AMHIEN_U_U_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. RXENT(RETVAL,AMHSTR) ;-- retrieve the prescription entry for Rx Tab
  1.  S X="MERR^AMHGU",@^%ZOSF("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)="T00250Medications"_$C(30)
  1.  N AMHDA
  1.  S AMHDA=0 F  S AMHDA=$O(^AMHREC(AMHIEN,41,AMHDA)) Q:'AMHDA  D
  1.  . N AMHDATA
  1.  . S AMHDATA=$G(^AMHREC(AMHIEN,41,AMHDA,0))
  1.  . S AMHI=AMHI+1
  1.  . S @RETVAL@(AMHI)=AMHDATA_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. ACT(RETVAL,AMHSTR) ;-- retrieve activity for visit activity tab
  1.  S X="MERR^AMHGU",@^%ZOSF("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^T00030ActivityType^T00010ActivityTime^T00010Flag^T00030LocalServiceSite^T00010NumberServed^T00001InterpreterUtilized"_$C(30)
  1.  N AMHACTI,AMHACT,AMHACTS,AMHACTM,AMHFLG,AMHLSSI,AMHLSS,AMHLSSS,AMHNS,AMHINT
  1.  S AMHACTI=$$GET1^DIQ(9002011,AMHIEN,.06,"I")
  1.  S AMHACT=$S($G(AMHACTI):$$GET1^DIQ(9002012,AMHACTI,.02),1:"")
  1.  S AMHACTS=$S(AMHACTI:AMHACTI_R_AMHACT,1:"")
  1.  S AMHACTM=$$GET1^DIQ(9002011,AMHIEN,.12)
  1.  S AMHFLG=$$GET1^DIQ(9002011,AMHIEN,.27)
  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 AMHNS=$$GET1^DIQ(9002011,AMHIEN,.09)
  1.  S AMHINT=$$GET1^DIQ(9002011,AMHIEN,.15,"I")
  1.  I 'AMHINT S AMHINT=""
  1.  S AMHI=AMHI+1
  1.  S @RETVAL@(AMHI)=AMHIEN_U_AMHACTS_U_AMHACTM_U_AMHFLG_U_AMHLSSS_U_AMHNS_U_AMHINT_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. CPT(RETVAL,AMHSTR) ;-- retrieve cpt codes for visit activity tab
  1.  S X="MERR^AMHGU",@^%ZOSF("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^T00050Narrative^T00010Quantity^T00010Mod1IEN^T00010Mod1^T00010Mod2IEN^T00010Mod2"_$C(30)
  1.  N AMHDA
  1.  S AMHDA=0 F  S AMHDA=$O(^AMHRPROC("AD",AMHIEN,AMHDA)) Q:'AMHDA  D
  1.  . N AMHCPTI,AMHCPT,AMHCPTE,AMHQTY,AMHMOD1,AMHMOD2,AMHMOD1I,AMHMOD2I
  1.  . S AMHCPTI=$$GET1^DIQ(9002011.04,AMHDA,.01,"I")
  1.  . S AMHCPT=$$GET1^DIQ(9002011.04,AMHDA,.01)
  1.  . S AMHCPTE=$$GET1^DIQ(81,AMHCPTI,2)
  1.  . S AMHQTY=$$GET1^DIQ(9002011.04,AMHDA,.16)
  1.  . S AMHMOD1=$$GET1^DIQ(9002011.04,AMHDA,.08)
  1.  . S AMHMOD2=$$GET1^DIQ(9002011.04,AMHDA,.09)
  1.  . S AMHMOD1I=$$GET1^DIQ(9002011.04,AMHDA,.08,"I")
  1.  . S AMHMOD2I=$$GET1^DIQ(9002011.04,AMHDA,.09,"I")
  1.  . S AMHI=AMHI+1
  1.  . S @RETVAL@(AMHI)=AMHCPTI_U_AMHCPT_U_AMHCPTE_U_AMHQTY_U_AMHMOD1I_U_AMHMOD1_U_AMHMOD2I_U_AMHMOD2_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. SP(RETVAL,AMHSTR) ;-- retrieve secondary prov for visit activity tab
  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,AMHSPRVO
  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. ASSESS(RETVAL,AMHSTR) ;-- retrieve the assessment for assessment tab
  1.  S X="MERR^AMHGU",@^%ZOSF("TRAP")
  1.  N AMHI,P,R,AMHIEN,AMHVIEN
  1.  S P="|",R="~"
  1.  S RETVAL="^AMHTMP("_$J_")"
  1.  S AMHI=0
  1.  K ^AMHTMP($J)
  1.  S AMHVIEN=$P(AMHSTR,P)
  1.  S AMHIEN=$O(^AMHRINTK("AD",AMHVIEN,0))
  1.  S @RETVAL@(AMHI)="T00250Assessment^T00010IntakeIEN"_$C(30)
  1.  N AMHDA
  1.  I $G(AMHIEN) D
  1.  . S AMHDA=0 F  S AMHDA=$O(^AMHRINTK(AMHIEN,41,AMHDA)) Q:'AMHDA  D
  1.  .. N AMHDATA
  1.  .. S AMHDATA=$G(^AMHRINTK(AMHIEN,41,AMHDA,0))
  1.  .. S AMHI=AMHI+1
  1.  .. S @RETVAL@(AMHI)=AMHDATA_U_AMHIEN_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. CD(RETVAL,AMHSTR) ;-- retrieve CD Data for visit CD Data tab
  1.  S X="MERR^AMHGU",@^%ZOSF("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^T00050ComponentCode^T00030TypeofComponent^T00030TypeofContact^T00010DaysInResidential^T00010DaysInAftercare"_$C(30)
  1.  N AMHCCI,AMHCC,AMHCCS,AMHCMPI,AMHCMP,AMHCMPS,AMHTOCI,AMHTOC,AMHTOCS,AMHDIR,AMHDIA
  1.  S AMHCCI=$$GET1^DIQ(9002011,AMHIEN,1101,"I")
  1.  S AMHCC=$S($G(AMHCCI):$$GET1^DIQ(9002011,AMHIEN,1101),1:"")
  1.  S AMHCCS=$S(AMHCCI:AMHCCI_R_AMHCC,1:"")
  1.  S AMHCMPI=$$GET1^DIQ(9002011,AMHIEN,1105,"I")
  1.  S AMHCMP=$$GET1^DIQ(9002011,AMHIEN,1105)
  1.  S AMHCMPS=$S(AMHCMPI]"":AMHCMPI_"-"_AMHCMP,1:"")
  1.  S AMHTOCI=$$GET1^DIQ(9002011,AMHIEN,.32,"I")
  1.  S AMHTOC=$$GET1^DIQ(9002011,AMHIEN,.32)
  1.  S AMHTOCS=$S(AMHTOCI]"":AMHTOCI_"-"_AMHTOC,1:"")
  1.  S AMHDIR=$$GET1^DIQ(9002011,AMHIEN,1102)
  1.  S AMHDIA=$$GET1^DIQ(9002011,AMHIEN,1103)
  1.  S AMHI=AMHI+1
  1.  S @RETVAL@(AMHI)=AMHIEN_U_AMHCCS_U_AMHCMPS_U_AMHTOCS_U_AMHDIR_U_AMHDIA_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;