AMHGDVF1.m

AMHGDVF1 ; IHS/CMI/MAW - AMH BH GUI Visit Form (frmVisitDataEntry)

 ;;4.0;IHS BEHAVIORAL HEALTH;**1,6**;JUN 02, 2010;Build 10

 ;

 ;

MSRV(RETVAL,AMHSTR) ;-- vst meas from all enc dt range for vst meas tab

 S X="MERR^AMHGU",@^%ZOSF("TRAP")

 N AMHI,P,R,AMHB,AMHE,AMHP

 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^T00030MeasurementDate^T00010Measurement^T00050Description^T00030Value^T00010Provider IEN^T00030Provider"_$C(30)

 N AMHT

 S AMHT=0 F  S AMHT=$O(^AMHRMSR("AA",AMHP,AMHT)) Q:'AMHT  D

 . N AMHDA

 . S AMHDA=(AMHE-.0001) F  S AMHDA=$O(^AMHRMSR("AA",AMHP,AMHT,AMHDA)) Q:'AMHDA!(AMHDA>(AMHB+.9999))  D

 .. N AMHIEN

 .. S AMHIEN=0 F  S AMHIEN=$O(^AMHRMSR("AA",AMHP,AMHT,AMHDA,AMHIEN)) Q:'AMHIEN  D

 ... N AMHMSRTI,AMHMSRT,AMHMSRD,AMHV,AMHMDT,AMHMPRVI,AMHMPRV

 ... S AMHMDT=9999999-AMHDA

 ... S AMHMDT=$$LVDT^AMHGU(AMHMDT)

 ... S AMHMSRTI=$$GET1^DIQ(9002011.12,AMHIEN,.01,"I")

 ... S AMHMSRT=$$GET1^DIQ(9002011.12,AMHIEN,.01)

 ... S AMHMSRD=$$GET1^DIQ(9999999.07,AMHMSRTI,.02)

 ... S AMHV=$$GET1^DIQ(9002011.12,AMHIEN,.04)

 ... S AMHMPRVI=$$GET1^DIQ(9002011.12,AMHIEN,1204,"I")

 ... S AMHMPRV=$$GET1^DIQ(9002011.12,AMHIEN,1204)

 ... S AMHI=AMHI+1

 ... S @RETVAL@(AMHI)=AMHIEN_U_AMHMDT_U_AMHMSRT_U_AMHMSRD_U_AMHV_U_AMHMPRVI_U_AMHMPRV_$C(30)

 S @RETVAL@(AMHI+1)=$C(31)

 Q

 ;

MSR(RETVAL,AMHSTR) ;-- vst meas from 1 enc for vst meas 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^T00010Measurement^T00030Description^T00030Value^T00010Provider IEN^T00030Provider"_$C(30)

 N AMHDA

 S AMHDA=0 F  S AMHDA=$O(^AMHRMSR("AD",AMHIEN,AMHDA)) Q:'AMHDA  D

 . N AMHMSRTI,AMHMSRT,AMHMSRD,AMHV,AMHMPRVI,AMHMPRV

 . S AMHMSRTI=$$GET1^DIQ(9002011.12,AMHDA,.01,"I")

 . S AMHMSRT=$$GET1^DIQ(9002011.12,AMHDA,.01)

 . S AMHMSRD=$$GET1^DIQ(9999999.07,AMHMSRTI,.02)

 . S AMHV=$$GET1^DIQ(9002011.12,AMHDA,.04)

 . S AMHMPRVI=$$GET1^DIQ(9002011.12,AMHDA,1204,"I")

 . S AMHMPRV=$$GET1^DIQ(9002011.12,AMHDA,1204)

 . S AMHI=AMHI+1

 . S @RETVAL@(AMHI)=AMHMSRTI_U_AMHMSRT_U_AMHMSRD_U_AMHV_U_AMHMPRVI_U_AMHMPRV_$C(30)

 S @RETVAL@(AMHI+1)=$C(31)

 Q

 ;

BHWELL(RETVAL,AMHSTR) ;-- vst bh well listview for well tab

 S X="MERR^AMHGU",@^%ZOSF("TRAP")

 N AMHI,P,R,AMHB,AMHE,AMHP,AMHTI,AMHDA,AMHIEN,AMHIVB,AMHIVE

 S P="|",R="~"

 S RETVAL="^AMHTMP("_$J_")"

 S AMHI=0

 S AMHTI=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@(AMHTI)="T00010BMXIEN^T00030Date^T00030EducationTopic^T00030HealthFactor^T00020AlcoholScreening^T00020DepressionScreening^T00020IPV/DVScreening^T00020SRA^T00030Provider^T00010VisitIEN"_$C(30)

 S AMHIVB=AMHB+.9999

 S AMHIVE=-AMHE-.0001

 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 AMHDT,AMHAS,AMHDS,AMHIS,AMHPRVI,AMHPRV,AMHEDUI,AMHEDU,AMHHFI,AMHHF,AMHVIEN,AMHS

 .. S AMHDT=$$LVDT^AMHGU($$GET1^DIQ(9002011,AMHIEN,.01,"I"))

 .. S AMHAS=$$GET1^DIQ(9002011,AMHIEN,1403)

 .. S AMHDS=$$GET1^DIQ(9002011,AMHIEN,1405)

 .. S AMHIS=$$GET1^DIQ(9002011,AMHIEN,1401)

 .. S AMHS=$$GET1^DIQ(9002011,AMHIEN,1407)

 .. S AMHVIEN=$$GET1^DIQ(9002011,AMHIEN,.16,"I")

 .. S AMHPRVI=$$GETPRV^AMHGU(AMHIEN,"P")

 .. S AMHPRV=$S($G(AMHPRVI):$$GET1^DIQ(9002011.02,AMHPRVI,.01),1:"")

 .. S AMHEDUI=$O(^AMHREDU("AD",AMHIEN,0))

 .. S AMHEDU=$S(AMHEDUI:$$GET1^DIQ(9002011.05,AMHEDUI,.01),1:"")

 .. S AMHHFI=$O(^AMHRHF("AD",AMHIEN,0))

 .. S AMHHF=$S(AMHHFI:$$GET1^DIQ(9002011.08,AMHHFI,.01),1:"")

 .. I AMHAS="",AMHDS="",AMHIS="",AMHEDU="",AMHHF="",AMHS="" Q

 .. S AMHI=AMHI+1

 .. S ^TMP($J,"AMHWELL",AMHDA,AMHI)=AMHIEN_U_AMHDT_U_AMHEDU_U_AMHHF_U_AMHAS_U_AMHDS_U_AMHIS_U_AMHS_U_AMHPRV_U_AMHVIEN

 D PCCWELL(AMHB,AMHE,AMHP)

 N AMHTDA,AMHTIEN

 S AMHTDA=0 F  S AMHTDA=$O(^TMP($J,"AMHWELL",AMHTDA)) Q:'AMHTDA  D

 . S AMHTIEN=0 F  S AMHTIEN=$O(^TMP($J,"AMHWELL",AMHTDA,AMHTIEN)) Q:'AMHTIEN  D

 .. S AMHTI=AMHTI+1

 .. S @RETVAL@(AMHTI)=$G(^TMP($J,"AMHWELL",AMHTDA,AMHTIEN))_$C(30)

 S @RETVAL@(AMHTI+1)=$C(31)

 K ^TMP($J,"AMHWELL")

 Q

 ;

PCCWELL(B,E,PAT) ;-- vst pcc well listview for well tab

 N AMHDA,AMHIEN

 S AMHIVB=B+.9999

 S AMHIVE=-E-.0001

 S AMHDA=AMHIVE F  S AMHDA=$O(^AUPNVSIT("AA",PAT,AMHDA)) Q:'AMHDA!(AMHDA>AMHIVB)  D

 . S AMHIEN=0 F  S AMHIEN=$O(^AUPNVSIT("AA",PAT,AMHDA,AMHIEN)) Q:'AMHIEN  D

 .. N AMHDT,AMHAS,AMHDS,AMHIS,AMHS,AMHPRVI,AMHPRV,AMHEDUI,AMHEDU,AMHHFI,AMHHF,AMHVIEN

 .. Q:$O(^AMHREC("AVISIT",AMHIEN,0))

 .. S AMHDT=$$LVDT^AMHGU($$GET1^DIQ(9000010,AMHIEN,.01,"I"))

 .. S AMHAS=""

 .. S AMHDS=""

 .. S AMHIS=""

 .. S AMHS=""

 .. S AMHVIEN=""

 .. S AMHPRV=$$PRIMPROV^APCLV(AMHIEN,"N")

 .. S AMHEDUI=$O(^AUPNVPED("AD",AMHIEN,0))

 .. S AMHEDU=$S(AMHEDUI:$$GET1^DIQ(9000010.16,AMHEDUI,.01),1:"")

 .. S AMHHFI=$O(^AUPNVHF("AD",AMHIEN,0))

 .. S AMHHF=$S(AMHHFI:$$GET1^DIQ(9000010.23,AMHHFI,.01),1:"")

 .. I AMHEDU="",AMHHF="" Q

 .. S AMHI=AMHI+1

 .. S ^TMP($J,"AMHWELL",AMHDA,AMHI)=AMHIEN_U_AMHDT_U_AMHEDU_U_AMHHF_U_AMHAS_U_AMHDS_U_AMHIS_U_AMHS_U_AMHPRV_U_AMHVIEN

 Q

 ;

HHF(RETVAL,AMHSTR) ;-- get hist hf

 S X="MERR^AMHGU",@^%ZOSF("TRAP")

 N AMHI,P,R,AMHB,AMHE,AMHP,AMHTI,AMHDA,AMHIEN

 S P="|",R="~"

 S RETVAL="^AMHTMP("_$J_")"

 S AMHI=0

 S AMHTI=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^T00030Date^T00030HealthFactor^T00030LevelSeverity^T00010Quantity^T00030Provider^T00100Comment"_$C(30)

 S AMHIVB=AMHB+.9999

 S AMHIVE=-AMHE-.0001

 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 AMHDT,AMHPRVI,AMHPRV,AMHEDUI,AMHVIEN

 .. S AMHDT=$$LVDT^AMHGU($$GET1^DIQ(9002011,AMHIEN,.01,"I"))

 .. S AMHVIEN=$$GET1^DIQ(9002011,AMHIEN,.16,"I")

 .. S AMHPRVI=$$GETPRV^AMHGU(AMHIEN,"P")

 .. S AMHPRV=$S($G(AMHPRVI):$$GET1^DIQ(9002011.02,AMHPRVI,.01),1:"")

 .. N AMHHDA

 .. S AMHHDA=0 F  S AMHHDA=$O(^AMHRHF("AD",AMHIEN,AMHHDA)) Q:'AMHHDA  D

 ... N AMHHF,AMHSEV,AMHQTY,AMHPRV,AMHCMT

 ... S AMHHF=$$GET1^DIQ(9002011.08,AMHHDA,.01)

 ... S AMHSEVI=$$GET1^DIQ(9002011.08,AMHHDA,.04,"I")

 ... S AMHSEV=$$GET1^DIQ(9002011.08,AMHHDA,.04)

 ... S AMHSEVS=$S($G(AMHSEVI)]"":AMHSEVI_"-"_AMHSEV,1:"")

 ... S AMHQTY=$$GET1^DIQ(9002011.08,AMHHDA,.06)

 ... S AMHPRV=$$GET1^DIQ(9002011.08,AMHHDA,.05)

 ... S AMHCMT=$$GET1^DIQ(9002011.08,AMHHDA,81101)

 ... Q:$O(^TMP($J,"AMHHF",$P(AMHDA,"."),AMHHF,0))

 ... S AMHI=AMHI+1

 ... S ^TMP($J,"AMHHF",$P(AMHDA,"."),AMHHF,AMHI)=AMHHDA_U_AMHDT_U_AMHHF_U_AMHSEV_U_AMHQTY_U_AMHPRV_U_AMHCMT

 D PCCHF(AMHB,AMHE,AMHP)

 N AMHTDA,AMHTIEN

 S AMHTDA=0 F  S AMHTDA=$O(^TMP($J,"AMHHF",AMHTDA)) Q:'AMHTDA  D

 . S AMHTIEN=0 F  S AMHTIEN=$O(^TMP($J,"AMHHF",AMHTDA,AMHTIEN)) Q:AMHTIEN=""  D

 .. N AMHTOEN

 .. S AMHTOEN=0 F  S AMHTOEN=$O(^TMP($J,"AMHHF",AMHTDA,AMHTIEN,AMHTOEN)) Q:'AMHTOEN  D

 ... S AMHTI=AMHTI+1

 ... S @RETVAL@(AMHTI)=$G(^TMP($J,"AMHHF",AMHTDA,AMHTIEN,AMHTOEN))_$C(30)

 S @RETVAL@(AMHTI+1)=$C(31)

 K ^TMP($J,"AMHHF")

 Q

 ;

PCCHF(B,E,PAT) ;-- vst pcc well listview for well tab

 N AMHDA,AMHIEN,AMHIVB,AMHIVE

 S AMHIVB=B+.9999

 S AMHIVE=-E-.0001

 S AMHDA=AMHIVE F  S AMHDA=$O(^AUPNVSIT("AA",PAT,AMHDA)) Q:'AMHDA!(AMHDA>AMHIVB)  D

 . S AMHIEN=0 F  S AMHIEN=$O(^AUPNVSIT("AA",PAT,AMHDA,AMHIEN)) Q:'AMHIEN  D

 .. N AMHDT,AMHAS,AMHDS,AMHIS,AMHPRVI,AMHPRV,AMHEDUI,AMHEDU,AMHHFI,AMHHF,AMHVIEN

 .. S AMHDT=$$LVDT^AMHGU($$GET1^DIQ(9000010,AMHIEN,.01,"I"))

 .. S AMHVIEN=""

 .. N AMHHDA

 .. S AMHHDA=0 F  S AMHHDA=$O(^AUPNVHF("AD",AMHIEN,AMHHDA)) Q:'AMHHDA  D

 ... S AMHPRV=$$GET1^DIQ(9000010.23,AMHHDA,.05)

 ... S AMHHF=$$GET1^DIQ(9000010.23,AMHHDA,.01)

 ... S AMHSEVI=$$GET1^DIQ(9000010.23,AMHHDA,.04,"I")

 ... S AMHSEV=$$GET1^DIQ(9000010.23,AMHHDA,.04)

 ... S AMHSEVS=$S($G(AMHSEVI)]"":AMHSEVI_"-"_AMHSEV,1:"")

 ... S AMHQTY=$$GET1^DIQ(9000010.23,AMHHDA,.06)

 ... S AMHCMT=$$GET1^DIQ(9000010.23,AMHHDA,81101)

 ... Q:$O(^TMP($J,"AMHHF",$P(AMHDA,"."),AMHHF,0))

 ... S AMHI=AMHI+1

 ... S ^TMP($J,"AMHHF",$P(AMHDA,"."),AMHHF,AMHI)=AMHHDA_U_AMHDT_U_AMHHF_U_AMHSEV_U_AMHQTY_U_AMHPRV_U_AMHCMT

 Q

 ;

HEDU(RETVAL,AMHSTR) ;-- get hist edu topics

 S X="MERR^AMHGU",@^%ZOSF("TRAP")

 N AMHI,P,R,AMHB,AMHE,AMHP,AMHTI,AMHDA,AMHIEN,AMHIVB,AMHIVE

 S P="|",R="~"

 S RETVAL="^AMHTMP("_$J_")"

 S AMHI=0

 S AMHTI=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^T00030Date^T00030EducationTopic^T00010TimeSpent^T00030LevelOfUnderstanding^T00030CPT^T00030Goal^T00030Status^T00010Session^T00030Provider^T00100Comment^T00050Readiness"_$C(30)

 S AMHIVB=AMHB+.9999

 S AMHIVE=-AMHE-.0001

 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 AMHDT,AMHPRVI,AMHPRV,AMHEDUI,AMHVIEN

 .. S AMHDT=$$LVDT^AMHGU($$GET1^DIQ(9002011,AMHIEN,.01,"I"))

 .. S AMHVIEN=$$GET1^DIQ(9002011,AMHIEN,.16,"I")

 .. S AMHPRVI=$$GETPRV^AMHGU(AMHIEN,"P")

 .. S AMHPRV=$S($G(AMHPRVI):$$GET1^DIQ(9002011.02,AMHPRVI,.01),1:"")

 .. N AMHHDA

 .. S AMHHDA=0 F  S AMHHDA=$O(^AMHREDU("AD",AMHIEN,AMHHDA)) Q:'AMHHDA  D

 ... N AMHEDU,AMHTS,AMHLOU,AMHCMT,AMHGOAL,AMHCPT,AMHST,AMHSES,AMHLOUI,AMHLOUS,AMHSTI,AMHSTS,AMHCPT,AMHPRV,AMHREA

 ... S AMHEDU=$$GET1^DIQ(9002011.05,AMHHDA,.01)

 ... S AMHPRV=$$GET1^DIQ(9002011.05,AMHHDA,.04)

 ... S AMHTS=$$GET1^DIQ(9002011.05,AMHHDA,.06)

 ... S AMHLOUI=$$GET1^DIQ(9002011.05,AMHHDA,.08,"I")

 ... S AMHLOU=$$GET1^DIQ(9002011.05,AMHHDA,.08)

 ... S AMHLOUS=$S($G(AMHLOUI)]"":AMHLOUI_"-"_AMHLOU,1:"")

 ... S AMHCPT=$$GET1^DIQ(9002011.05,AMHHDA,.07)

 ... S AMHCMT=$$GET1^DIQ(9002011.05,AMHHDA,1101)

 ... S AMHGOAL=$$GET1^DIQ(9002011.05,AMHHDA,.09)

 ... S AMHSTI=$$GET1^DIQ(9002011.05,AMHHDA,.11,"I")

 ... S AMHST=$$GET1^DIQ(9002011.05,AMHHDA,.11)

 ... S AMHSTS=$S($G(AMHSTI)]"":AMHSTI_"-"_AMHST,1:"")

 ... S AMHSES=$$GET1^DIQ(9002011.05,AMHHDA,.05,"I")

 ... S AMHREA=$$GET1^DIQ(9002011.05,AMHHDA,1102)

 ... Q:$O(^TMP($J,"AMHEDU",$P(AMHDA,"."),AMHEDU,0))

 ... S AMHI=AMHI+1

 ... S ^TMP($J,"AMHEDU",$P(AMHDA,"."),AMHEDU,AMHI)=AMHHDA_U_AMHDT_U_AMHEDU_U_AMHTS_U_AMHLOU_U_AMHCPT_U_AMHGOAL_U_AMHST_U_AMHSES_U_AMHPRV_U_AMHCMT_U_AMHREA

 D PCCEDU(AMHB,AMHE,AMHP)

 N AMHTDA,AMHTIEN

 S AMHTDA=0 F  S AMHTDA=$O(^TMP($J,"AMHEDU",AMHTDA)) Q:'AMHTDA  D

 . S AMHTIEN=0 F  S AMHTIEN=$O(^TMP($J,"AMHEDU",AMHTDA,AMHTIEN)) Q:AMHTIEN=""  D

 .. N AMHTOEN

 .. S AMHTOEN=0 F  S AMHTOEN=$O(^TMP($J,"AMHEDU",AMHTDA,AMHTIEN,AMHTOEN)) Q:'AMHTOEN  D

 ... S AMHTI=AMHTI+1

 ... S @RETVAL@(AMHTI)=$G(^TMP($J,"AMHEDU",AMHTDA,AMHTIEN,AMHTOEN))_$C(30)

 S @RETVAL@(AMHTI+1)=$C(31)

 K ^TMP($J,"AMHEDU")

 Q

 ;

PCCEDU(B,E,PAT) ;-- vst pcc well list for well tab

 N AMHDA,AMHIEN,AMHIVB,AMHIVE

 S AMHIVB=B+.9999

 S AMHIVE=-E-.0001

 S AMHDA=AMHIVE F  S AMHDA=$O(^AUPNVSIT("AA",PAT,AMHDA)) Q:'AMHDA!(AMHDA>AMHIVB)  D

 . S AMHIEN=0 F  S AMHIEN=$O(^AUPNVSIT("AA",PAT,AMHDA,AMHIEN)) Q:'AMHIEN  D

 .. N AMHDT,AMHAS,AMHDS,AMHIS,AMHPRVI,AMHPRV,AMHEDUI,AMHEDU,AMHHFI,AMHHF,AMHVIEN

 .. S AMHDT=$$LVDT^AMHGU($$GET1^DIQ(9000010,AMHIEN,.01,"I"))

 .. S AMHVIEN=""

 .. N AMHHDA

 .. S AMHHDA=0 F  S AMHHDA=$O(^AUPNVPED("AD",AMHIEN,AMHHDA)) Q:'AMHHDA  D

 ... N AMHEDU,AMHTS,AMHLOU,AMHCMT,AMHGOAL,AMHCPT,AMHST,AMHSES,AMHLOUI,AMHLOUS,AMHSTI,AMHSTS,AMHCPT,AMHPRV,AMHREA

 ... S AMHEDU=$$GET1^DIQ(9000010.16,AMHHDA,.01)

 ... S AMHPRV=$$GET1^DIQ(9000010.16,AMHHDA,.05)

 ... S AMHTS=$$GET1^DIQ(9000010.16,AMHHDA,.08)

 ... S AMHLOUI=$$GET1^DIQ(9000010.16,AMHHDA,.06,"I")

 ... S AMHLOU=$$GET1^DIQ(9000010.16,AMHHDA,.06)

 ... S AMHLOUS=$S($G(AMHLOUI)]"":AMHLOUI_"-"_AMHLOU,1:"")

 ... S AMHCPT=$$GET1^DIQ(9000010.16,AMHHDA,.09)

 ... S AMHCMT=$$GET1^DIQ(9000010.16,AMHHDA,.11)

 ... S AMHGOAL=$$GET1^DIQ(9000010.16,AMHHDA,.14)

 ... S AMHSTI=$$GET1^DIQ(9000010.16,AMHHDA,.13,"I")

 ... S AMHST=$$GET1^DIQ(9000010.16,AMHHDA,.13)

 ... S AMHSTS=$S($G(AMHSTI)]"":AMHSTI_"-"_AMHST,1:"")

 ... S AMHSES=$$GET1^DIQ(9000010.16,AMHHDA,.07,"I")

 ... S AMHREA=$$GET1^DIQ(9000010.16,AMHHDA,1102)

 ... Q:$O(^TMP($J,"AMHEDU",$P(AMHDA,"."),AMHEDU,0))

 ... S AMHI=AMHI+1

 ... S ^TMP($J,"AMHEDU",$P(AMHDA,"."),AMHEDU,AMHI)=AMHHDA_U_AMHDT_U_AMHEDU_U_AMHTS_U_AMHLOU_U_AMHCPT_U_AMHGOAL_U_AMHST_U_AMHSES_U_AMHPRV_U_AMHCMT_U_AMHREA

 Q

 ;

HSCR(RETVAL,AMHSTR) ;-- get hist scrn

 S X="MERR^AMHGU",@^%ZOSF("TRAP")

 N AMHI,P,R,AMHB,AMHE,AMHP,AMHTI,AMHDA,AMHIEN,AMHIBV,AMHIVE

 S P="|",R="~"

 S RETVAL="^AMHTMP("_$J_")"

 S AMHI=0

 S AMHTI=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^T00030Date^T00030Alcohol^T00030AlcoholProvider^T00250AlcoholComment^T00030Depression^T00030DepressionProvider^T00250DepressionComment^T00030IPV^T00250IPVComment^T00030IPVProvider"

 S @RETVAL@(AMHI)=@RETVAL@(AMHI)_"^T00030SRA^T00250SRAComment^T00030SRAProvider"_$C(30)

 S AMHIVB=AMHB+.9999

 S AMHIVE=-AMHE-.0001

 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 AMHDT,AMHVIEN,AMHALC,AMHALCP,AMHALCC,AMHDEP,AMHDEPP,AMHDEPC,AMHIPV,AMHIPVC,AMHMTCH,AMHIPVP,AMHS,AMHSC,AMHSPRV

 .. S AMHMTCH=0

 .. S AMHDT=$$LVDT^AMHGU($$GET1^DIQ(9002011,AMHIEN,.01,"I"))

 .. S AMHVIEN=$$GET1^DIQ(9002011,AMHIEN,.16,"I")

 .. S AMHALC=$$GET1^DIQ(9002011,AMHIEN,1403)

 .. S AMHALCP=$$GET1^DIQ(9002011,AMHIEN,1404)

 .. S AMHALCC=$$GET1^DIQ(9002011,AMHIEN,1601)

 .. S AMHDEP=$$GET1^DIQ(9002011,AMHIEN,1405)

 .. S AMHDEPP=$$GET1^DIQ(9002011,AMHIEN,1406)

 .. S AMHDEPC=$$GET1^DIQ(9002011,AMHIEN,1701)

 .. S AMHIPV=$$GET1^DIQ(9002011,AMHIEN,1401)

 .. S AMHIPVC=$$GET1^DIQ(9002011,AMHIEN,1501)

 .. S AMHIPVP=$$GET1^DIQ(9002011,AMHIEN,1402)

 .. S AMHS=$$GET1^DIQ(9002011,AMHIEN,1407)

 .. S AMHSC=$$GET1^DIQ(9002011,AMHIEN,1901)

 .. S AMHSPRV=$$GET1^DIQ(9002011,AMHIEN,1408)

 .. I $G(AMHALC)]"" S AMHMTCH=1

 .. I $G(AMHDEP)]"" S AMHMTCH=1

 .. I $G(AMHIPV)]"" S AMHMTCH=1

 .. I $G(AMHS)]"" S AMHMTCH=1

 .. Q:'$G(AMHMTCH)

 .. S AMHI=AMHI+1

 .. S ^TMP($J,"AMHSCR",AMHDA,AMHI)=AMHIEN_U_AMHDT_U_AMHALC_U_AMHALCP_U_AMHALCC_U_AMHDEP_U_AMHDEPP_U_AMHDEPC_U_AMHIPV_U_AMHIPVC_U_AMHIPVP_U_AMHS_U_AMHSC_U_AMHSPRV

 N AMHTDA,AMHTIEN

 S AMHTDA=0 F  S AMHTDA=$O(^TMP($J,"AMHSCR",AMHTDA)) Q:'AMHTDA  D

 . S AMHTIEN=0 F  S AMHTIEN=$O(^TMP($J,"AMHSCR",AMHTDA,AMHTIEN)) Q:'AMHTIEN  D

 .. S AMHTI=AMHTI+1

 .. S @RETVAL@(AMHTI)=$G(^TMP($J,"AMHSCR",AMHTDA,AMHTIEN))_$C(30)

 S @RETVAL@(AMHTI+1)=$C(31)

 K ^TMP($J,"AMHSCR")

 Q

 ;

AMHGDVF1  ; IHS/CMI/MAW - AMH BH GUI Visit Form (frmVisitDataEntry)

 +1       ;;4.0;IHS BEHAVIORAL HEALTH;**1,6**;JUN 02, 2010;Build 10

 +2       ;

 +3       ;

MSRV(RETVAL,AMHSTR) ;-- vst meas from all enc dt range for vst meas tab

 +1        SET X="MERR^AMHGU"

           SET @^%ZOSF("TRAP")

 +2        NEW AMHI,P,R,AMHB,AMHE,AMHP

 +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^T00030MeasurementDate^T00010Measurement^T00050Description^T00030Value^T00010Provider IEN^T00030Provider"_$CHAR(30)

 +13       NEW AMHT

 +14       SET AMHT=0

           FOR 

               SET AMHT=$ORDER(^AMHRMSR("AA",AMHP,AMHT))

               IF 'AMHT

                   QUIT 

               Begin DoDot:1

 +15               NEW AMHDA

 +16               SET AMHDA=(AMHE-.0001)

                   FOR 

                       SET AMHDA=$ORDER(^AMHRMSR("AA",AMHP,AMHT,AMHDA))

                       IF 'AMHDA!(AMHDA>(AMHB+.9999))

                           QUIT 

                       Begin DoDot:2

 +17                       NEW AMHIEN

 +18                       SET AMHIEN=0

                           FOR 

                               SET AMHIEN=$ORDER(^AMHRMSR("AA",AMHP,AMHT,AMHDA,AMHIEN))

                               IF 'AMHIEN

                                   QUIT 

                               Begin DoDot:3

 +19                               NEW AMHMSRTI,AMHMSRT,AMHMSRD,AMHV,AMHMDT,AMHMPRVI,AMHMPRV

 +20                               SET AMHMDT=9999999-AMHDA

 +21                               SET AMHMDT=$$LVDT^AMHGU(AMHMDT)

 +22                               SET AMHMSRTI=$$GET1^DIQ(9002011.12,AMHIEN,.01,"I")

 +23                               SET AMHMSRT=$$GET1^DIQ(9002011.12,AMHIEN,.01)

 +24                               SET AMHMSRD=$$GET1^DIQ(9999999.07,AMHMSRTI,.02)

 +25                               SET AMHV=$$GET1^DIQ(9002011.12,AMHIEN,.04)

 +26                               SET AMHMPRVI=$$GET1^DIQ(9002011.12,AMHIEN,1204,"I")

 +27                               SET AMHMPRV=$$GET1^DIQ(9002011.12,AMHIEN,1204)

 +28                               SET AMHI=AMHI+1

 +29                               SET @RETVAL@(AMHI)=AMHIEN_U_AMHMDT_U_AMHMSRT_U_AMHMSRD_U_AMHV_U_AMHMPRVI_U_AMHMPRV_$CHAR(30)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +30       SET @RETVAL@(AMHI+1)=$CHAR(31)

 +31       QUIT 

 +32      ;

MSR(RETVAL,AMHSTR) ;-- vst meas from 1 enc for vst meas 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^T00010Measurement^T00030Description^T00030Value^T00010Provider IEN^T00030Provider"_$CHAR(30)

 +9        NEW AMHDA

 +10       SET AMHDA=0

           FOR 

               SET AMHDA=$ORDER(^AMHRMSR("AD",AMHIEN,AMHDA))

               IF 'AMHDA

                   QUIT 

               Begin DoDot:1

 +11               NEW AMHMSRTI,AMHMSRT,AMHMSRD,AMHV,AMHMPRVI,AMHMPRV

 +12               SET AMHMSRTI=$$GET1^DIQ(9002011.12,AMHDA,.01,"I")

 +13               SET AMHMSRT=$$GET1^DIQ(9002011.12,AMHDA,.01)

 +14               SET AMHMSRD=$$GET1^DIQ(9999999.07,AMHMSRTI,.02)

 +15               SET AMHV=$$GET1^DIQ(9002011.12,AMHDA,.04)

 +16               SET AMHMPRVI=$$GET1^DIQ(9002011.12,AMHDA,1204,"I")

 +17               SET AMHMPRV=$$GET1^DIQ(9002011.12,AMHDA,1204)

 +18               SET AMHI=AMHI+1

 +19               SET @RETVAL@(AMHI)=AMHMSRTI_U_AMHMSRT_U_AMHMSRD_U_AMHV_U_AMHMPRVI_U_AMHMPRV_$CHAR(30)

               End DoDot:1

 +20       SET @RETVAL@(AMHI+1)=$CHAR(31)

 +21       QUIT 

 +22      ;

BHWELL(RETVAL,AMHSTR) ;-- vst bh well listview for well tab

 +1        SET X="MERR^AMHGU"

           SET @^%ZOSF("TRAP")

 +2        NEW AMHI,P,R,AMHB,AMHE,AMHP,AMHTI,AMHDA,AMHIEN,AMHIVB,AMHIVE

 +3        SET P="|"

           SET R="~"

 +4        SET RETVAL="^AMHTMP("_$JOB_")"

 +5        SET AMHI=0

 +6        SET AMHTI=0

 +7        KILL ^AMHTMP($JOB)

 +8        SET AMHB=$PIECE(AMHSTR,P)

 +9        SET AMHE=$PIECE(AMHSTR,P,2)

 +10       SET AMHP=$PIECE(AMHSTR,P,3)

 +11       SET AMHB=9999999-AMHB

 +12       SET AMHE=9999999-AMHE

 +13       SET @RETVAL@(AMHTI)="T00010BMXIEN^T00030Date^T00030EducationTopic^T00030HealthFactor^T00020AlcoholScreening^T00020DepressionScreening^T00020IPV/DVScreening^T00020SRA^T00030Provider^T00010VisitIEN"_$CHAR(30)

 +14       SET AMHIVB=AMHB+.9999

 +15       SET AMHIVE=-AMHE-.0001

 +16       SET AMHDA=AMHIVE

           FOR 

               SET AMHDA=$ORDER(^AMHREC("AE",AMHP,AMHDA))

               IF 'AMHDA!(AMHDA>AMHIVB)

                   QUIT 

               Begin DoDot:1

 +17               SET AMHIEN=0

                   FOR 

                       SET AMHIEN=$ORDER(^AMHREC("AE",AMHP,AMHDA,AMHIEN))

                       IF 'AMHIEN

                           QUIT 

                       Begin DoDot:2

 +18                       NEW AMHDT,AMHAS,AMHDS,AMHIS,AMHPRVI,AMHPRV,AMHEDUI,AMHEDU,AMHHFI,AMHHF,AMHVIEN,AMHS

 +19                       SET AMHDT=$$LVDT^AMHGU($$GET1^DIQ(9002011,AMHIEN,.01,"I"))

 +20                       SET AMHAS=$$GET1^DIQ(9002011,AMHIEN,1403)

 +21                       SET AMHDS=$$GET1^DIQ(9002011,AMHIEN,1405)

 +22                       SET AMHIS=$$GET1^DIQ(9002011,AMHIEN,1401)

 +23                       SET AMHS=$$GET1^DIQ(9002011,AMHIEN,1407)

 +24                       SET AMHVIEN=$$GET1^DIQ(9002011,AMHIEN,.16,"I")

 +25                       SET AMHPRVI=$$GETPRV^AMHGU(AMHIEN,"P")

 +26                       SET AMHPRV=$SELECT($GET(AMHPRVI):$$GET1^DIQ(9002011.02,AMHPRVI,.01),1:"")

 +27                       SET AMHEDUI=$ORDER(^AMHREDU("AD",AMHIEN,0))

 +28                       SET AMHEDU=$SELECT(AMHEDUI:$$GET1^DIQ(9002011.05,AMHEDUI,.01),1:"")

 +29                       SET AMHHFI=$ORDER(^AMHRHF("AD",AMHIEN,0))

 +30                       SET AMHHF=$SELECT(AMHHFI:$$GET1^DIQ(9002011.08,AMHHFI,.01),1:"")

 +31                       IF AMHAS=""

                               IF AMHDS=""

                                   IF AMHIS=""

                                       IF AMHEDU=""

                                           IF AMHHF=""

                                               IF AMHS=""

                                                   QUIT 

 +32                       SET AMHI=AMHI+1

 +33                       SET ^TMP($JOB,"AMHWELL",AMHDA,AMHI)=AMHIEN_U_AMHDT_U_AMHEDU_U_AMHHF_U_AMHAS_U_AMHDS_U_AMHIS_U_AMHS_U_AMHPRV_U_AMHVIEN

                       End DoDot:2

               End DoDot:1

 +34       DO PCCWELL(AMHB,AMHE,AMHP)