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