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)
+35 NEW AMHTDA,AMHTIEN
+36 SET AMHTDA=0
FOR
SET AMHTDA=$ORDER(^TMP($JOB,"AMHWELL",AMHTDA))
IF 'AMHTDA
QUIT
Begin DoDot:1
+37 SET AMHTIEN=0
FOR
SET AMHTIEN=$ORDER(^TMP($JOB,"AMHWELL",AMHTDA,AMHTIEN))
IF 'AMHTIEN
QUIT
Begin DoDot:2
+38 SET AMHTI=AMHTI+1
+39 SET @RETVAL@(AMHTI)=$GET(^TMP($JOB,"AMHWELL",AMHTDA,AMHTIEN))_$CHAR(30)
End DoDot:2
End DoDot:1
+40 SET @RETVAL@(AMHTI+1)=$CHAR(31)
+41 KILL ^TMP($JOB,"AMHWELL")
+42 QUIT
+43 ;
PCCWELL(B,E,PAT) ;-- vst pcc well listview for well tab
+1 NEW AMHDA,AMHIEN
+2 SET AMHIVB=B+.9999
+3 SET AMHIVE=-E-.0001
+4 SET AMHDA=AMHIVE
FOR
SET AMHDA=$ORDER(^AUPNVSIT("AA",PAT,AMHDA))
IF 'AMHDA!(AMHDA>AMHIVB)
QUIT
Begin DoDot:1
+5 SET AMHIEN=0
FOR
SET AMHIEN=$ORDER(^AUPNVSIT("AA",PAT,AMHDA,AMHIEN))
IF 'AMHIEN
QUIT
Begin DoDot:2
+6 NEW AMHDT,AMHAS,AMHDS,AMHIS,AMHS,AMHPRVI,AMHPRV,AMHEDUI,AMHEDU,AMHHFI,AMHHF,AMHVIEN
+7 IF $ORDER(^AMHREC("AVISIT",AMHIEN,0))
QUIT
+8 SET AMHDT=$$LVDT^AMHGU($$GET1^DIQ(9000010,AMHIEN,.01,"I"))
+9 SET AMHAS=""
+10 SET AMHDS=""
+11 SET AMHIS=""
+12 SET AMHS=""
+13 SET AMHVIEN=""
+14 SET AMHPRV=$$PRIMPROV^APCLV(AMHIEN,"N")
+15 SET AMHEDUI=$ORDER(^AUPNVPED("AD",AMHIEN,0))
+16 SET AMHEDU=$SELECT(AMHEDUI:$$GET1^DIQ(9000010.16,AMHEDUI,.01),1:"")
+17 SET AMHHFI=$ORDER(^AUPNVHF("AD",AMHIEN,0))
+18 SET AMHHF=$SELECT(AMHHFI:$$GET1^DIQ(9000010.23,AMHHFI,.01),1:"")
+19 IF AMHEDU=""
IF AMHHF=""
QUIT
+20 SET AMHI=AMHI+1
+21 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
+22 QUIT
+23 ;
HHF(RETVAL,AMHSTR) ;-- get hist hf
+1 SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,P,R,AMHB,AMHE,AMHP,AMHTI,AMHDA,AMHIEN
+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@(AMHI)="T00010BMXIEN^T00030Date^T00030HealthFactor^T00030LevelSeverity^T00010Quantity^T00030Provider^T00100Comment"_$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,AMHPRVI,AMHPRV,AMHEDUI,AMHVIEN
+19 SET AMHDT=$$LVDT^AMHGU($$GET1^DIQ(9002011,AMHIEN,.01,"I"))
+20 SET AMHVIEN=$$GET1^DIQ(9002011,AMHIEN,.16,"I")
+21 SET AMHPRVI=$$GETPRV^AMHGU(AMHIEN,"P")
+22 SET AMHPRV=$SELECT($GET(AMHPRVI):$$GET1^DIQ(9002011.02,AMHPRVI,.01),1:"")
+23 NEW AMHHDA
+24 SET AMHHDA=0
FOR
SET AMHHDA=$ORDER(^AMHRHF("AD",AMHIEN,AMHHDA))
IF 'AMHHDA
QUIT
Begin DoDot:3
+25 NEW AMHHF,AMHSEV,AMHQTY,AMHPRV,AMHCMT
+26 SET AMHHF=$$GET1^DIQ(9002011.08,AMHHDA,.01)
+27 SET AMHSEVI=$$GET1^DIQ(9002011.08,AMHHDA,.04,"I")
+28 SET AMHSEV=$$GET1^DIQ(9002011.08,AMHHDA,.04)
+29 SET AMHSEVS=$SELECT($GET(AMHSEVI)]"":AMHSEVI_"-"_AMHSEV,1:"")
+30 SET AMHQTY=$$GET1^DIQ(9002011.08,AMHHDA,.06)
+31 SET AMHPRV=$$GET1^DIQ(9002011.08,AMHHDA,.05)
+32 SET AMHCMT=$$GET1^DIQ(9002011.08,AMHHDA,81101)
+33 IF $ORDER(^TMP($JOB,"AMHHF",$PIECE(AMHDA,"."),AMHHF,0))
QUIT
+34 SET AMHI=AMHI+1
+35 SET ^TMP($JOB,"AMHHF",$PIECE(AMHDA,"."),AMHHF,AMHI)=AMHHDA_U_AMHDT_U_AMHHF_U_AMHSEV_U_AMHQTY_U_AMHPRV_U_AMHCMT
End DoDot:3
End DoDot:2
End DoDot:1
+36 DO PCCHF(AMHB,AMHE,AMHP)
+37 NEW AMHTDA,AMHTIEN
+38 SET AMHTDA=0
FOR
SET AMHTDA=$ORDER(^TMP($JOB,"AMHHF",AMHTDA))
IF 'AMHTDA
QUIT
Begin DoDot:1
+39 SET AMHTIEN=0
FOR
SET AMHTIEN=$ORDER(^TMP($JOB,"AMHHF",AMHTDA,AMHTIEN))
IF AMHTIEN=""
QUIT
Begin DoDot:2
+40 NEW AMHTOEN
+41 SET AMHTOEN=0
FOR
SET AMHTOEN=$ORDER(^TMP($JOB,"AMHHF",AMHTDA,AMHTIEN,AMHTOEN))
IF 'AMHTOEN
QUIT
Begin DoDot:3
+42 SET AMHTI=AMHTI+1
+43 SET @RETVAL@(AMHTI)=$GET(^TMP($JOB,"AMHHF",AMHTDA,AMHTIEN,AMHTOEN))_$CHAR(30)
End DoDot:3
End DoDot:2
End DoDot:1
+44 SET @RETVAL@(AMHTI+1)=$CHAR(31)
+45 KILL ^TMP($JOB,"AMHHF")
+46 QUIT
+47 ;
PCCHF(B,E,PAT) ;-- vst pcc well listview for well tab
+1 NEW AMHDA,AMHIEN,AMHIVB,AMHIVE
+2 SET AMHIVB=B+.9999
+3 SET AMHIVE=-E-.0001
+4 SET AMHDA=AMHIVE
FOR
SET AMHDA=$ORDER(^AUPNVSIT("AA",PAT,AMHDA))
IF 'AMHDA!(AMHDA>AMHIVB)
QUIT
Begin DoDot:1
+5 SET AMHIEN=0
FOR
SET AMHIEN=$ORDER(^AUPNVSIT("AA",PAT,AMHDA,AMHIEN))
IF 'AMHIEN
QUIT
Begin DoDot:2
+6 NEW AMHDT,AMHAS,AMHDS,AMHIS,AMHPRVI,AMHPRV,AMHEDUI,AMHEDU,AMHHFI,AMHHF,AMHVIEN
+7 SET AMHDT=$$LVDT^AMHGU($$GET1^DIQ(9000010,AMHIEN,.01,"I"))
+8 SET AMHVIEN=""
+9 NEW AMHHDA
+10 SET AMHHDA=0
FOR
SET AMHHDA=$ORDER(^AUPNVHF("AD",AMHIEN,AMHHDA))
IF 'AMHHDA
QUIT
Begin DoDot:3
+11 SET AMHPRV=$$GET1^DIQ(9000010.23,AMHHDA,.05)
+12 SET AMHHF=$$GET1^DIQ(9000010.23,AMHHDA,.01)
+13 SET AMHSEVI=$$GET1^DIQ(9000010.23,AMHHDA,.04,"I")
+14 SET AMHSEV=$$GET1^DIQ(9000010.23,AMHHDA,.04)
+15 SET AMHSEVS=$SELECT($GET(AMHSEVI)]"":AMHSEVI_"-"_AMHSEV,1:"")
+16 SET AMHQTY=$$GET1^DIQ(9000010.23,AMHHDA,.06)
+17 SET AMHCMT=$$GET1^DIQ(9000010.23,AMHHDA,81101)
+18 IF $ORDER(^TMP($JOB,"AMHHF",$PIECE(AMHDA,"."),AMHHF,0))
QUIT
+19 SET AMHI=AMHI+1
+20 SET ^TMP($JOB,"AMHHF",$PIECE(AMHDA,"."),AMHHF,AMHI)=AMHHDA_U_AMHDT_U_AMHHF_U_AMHSEV_U_AMHQTY_U_AMHPRV_U_AMHCMT
End DoDot:3
End DoDot:2
End DoDot:1
+21 QUIT
+22 ;
HEDU(RETVAL,AMHSTR) ;-- get hist edu topics
+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@(AMHI)="T00010BMXIEN^T00030Date^T00030EducationTopic^T00010TimeSpent^T00030LevelOfUnderstanding^T00030CPT^T00030Goal^T00030Status^T00010Session^T00030Provider^T00100Comment^T00050Readiness"_$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,AMHPRVI,AMHPRV,AMHEDUI,AMHVIEN
+19 SET AMHDT=$$LVDT^AMHGU($$GET1^DIQ(9002011,AMHIEN,.01,"I"))
+20 SET AMHVIEN=$$GET1^DIQ(9002011,AMHIEN,.16,"I")
+21 SET AMHPRVI=$$GETPRV^AMHGU(AMHIEN,"P")
+22 SET AMHPRV=$SELECT($GET(AMHPRVI):$$GET1^DIQ(9002011.02,AMHPRVI,.01),1:"")
+23 NEW AMHHDA
+24 SET AMHHDA=0
FOR
SET AMHHDA=$ORDER(^AMHREDU("AD",AMHIEN,AMHHDA))
IF 'AMHHDA
QUIT
Begin DoDot:3
+25 NEW AMHEDU,AMHTS,AMHLOU,AMHCMT,AMHGOAL,AMHCPT,AMHST,AMHSES,AMHLOUI,AMHLOUS,AMHSTI,AMHSTS,AMHCPT,AMHPRV,AMHREA
+26 SET AMHEDU=$$GET1^DIQ(9002011.05,AMHHDA,.01)
+27 SET AMHPRV=$$GET1^DIQ(9002011.05,AMHHDA,.04)
+28 SET AMHTS=$$GET1^DIQ(9002011.05,AMHHDA,.06)
+29 SET AMHLOUI=$$GET1^DIQ(9002011.05,AMHHDA,.08,"I")
+30 SET AMHLOU=$$GET1^DIQ(9002011.05,AMHHDA,.08)
+31 SET AMHLOUS=$SELECT($GET(AMHLOUI)]"":AMHLOUI_"-"_AMHLOU,1:"")
+32 SET AMHCPT=$$GET1^DIQ(9002011.05,AMHHDA,.07)
+33 SET AMHCMT=$$GET1^DIQ(9002011.05,AMHHDA,1101)
+34 SET AMHGOAL=$$GET1^DIQ(9002011.05,AMHHDA,.09)
+35 SET AMHSTI=$$GET1^DIQ(9002011.05,AMHHDA,.11,"I")
+36 SET AMHST=$$GET1^DIQ(9002011.05,AMHHDA,.11)
+37 SET AMHSTS=$SELECT($GET(AMHSTI)]"":AMHSTI_"-"_AMHST,1:"")
+38 SET AMHSES=$$GET1^DIQ(9002011.05,AMHHDA,.05,"I")
+39 SET AMHREA=$$GET1^DIQ(9002011.05,AMHHDA,1102)
+40 IF $ORDER(^TMP($JOB,"AMHEDU",$PIECE(AMHDA,"."),AMHEDU,0))
QUIT
+41 SET AMHI=AMHI+1
+42 SET ^TMP($JOB,"AMHEDU",$PIECE(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
End DoDot:3
End DoDot:2
End DoDot:1
+43 DO PCCEDU(AMHB,AMHE,AMHP)
+44 NEW AMHTDA,AMHTIEN
+45 SET AMHTDA=0
FOR
SET AMHTDA=$ORDER(^TMP($JOB,"AMHEDU",AMHTDA))
IF 'AMHTDA
QUIT
Begin DoDot:1
+46 SET AMHTIEN=0
FOR
SET AMHTIEN=$ORDER(^TMP($JOB,"AMHEDU",AMHTDA,AMHTIEN))
IF AMHTIEN=""
QUIT
Begin DoDot:2
+47 NEW AMHTOEN
+48 SET AMHTOEN=0
FOR
SET AMHTOEN=$ORDER(^TMP($JOB,"AMHEDU",AMHTDA,AMHTIEN,AMHTOEN))
IF 'AMHTOEN
QUIT
Begin DoDot:3
+49 SET AMHTI=AMHTI+1
+50 SET @RETVAL@(AMHTI)=$GET(^TMP($JOB,"AMHEDU",AMHTDA,AMHTIEN,AMHTOEN))_$CHAR(30)
End DoDot:3
End DoDot:2
End DoDot:1
+51 SET @RETVAL@(AMHTI+1)=$CHAR(31)
+52 KILL ^TMP($JOB,"AMHEDU")
+53 QUIT
+54 ;
PCCEDU(B,E,PAT) ;-- vst pcc well list for well tab
+1 NEW AMHDA,AMHIEN,AMHIVB,AMHIVE
+2 SET AMHIVB=B+.9999
+3 SET AMHIVE=-E-.0001
+4 SET AMHDA=AMHIVE
FOR
SET AMHDA=$ORDER(^AUPNVSIT("AA",PAT,AMHDA))
IF 'AMHDA!(AMHDA>AMHIVB)
QUIT
Begin DoDot:1
+5 SET AMHIEN=0
FOR
SET AMHIEN=$ORDER(^AUPNVSIT("AA",PAT,AMHDA,AMHIEN))
IF 'AMHIEN
QUIT
Begin DoDot:2
+6 NEW AMHDT,AMHAS,AMHDS,AMHIS,AMHPRVI,AMHPRV,AMHEDUI,AMHEDU,AMHHFI,AMHHF,AMHVIEN
+7 SET AMHDT=$$LVDT^AMHGU($$GET1^DIQ(9000010,AMHIEN,.01,"I"))
+8 SET AMHVIEN=""
+9 NEW AMHHDA
+10 SET AMHHDA=0
FOR
SET AMHHDA=$ORDER(^AUPNVPED("AD",AMHIEN,AMHHDA))
IF 'AMHHDA
QUIT
Begin DoDot:3
+11 NEW AMHEDU,AMHTS,AMHLOU,AMHCMT,AMHGOAL,AMHCPT,AMHST,AMHSES,AMHLOUI,AMHLOUS,AMHSTI,AMHSTS,AMHCPT,AMHPRV,AMHREA
+12 SET AMHEDU=$$GET1^DIQ(9000010.16,AMHHDA,.01)
+13 SET AMHPRV=$$GET1^DIQ(9000010.16,AMHHDA,.05)
+14 SET AMHTS=$$GET1^DIQ(9000010.16,AMHHDA,.08)
+15 SET AMHLOUI=$$GET1^DIQ(9000010.16,AMHHDA,.06,"I")
+16 SET AMHLOU=$$GET1^DIQ(9000010.16,AMHHDA,.06)
+17 SET AMHLOUS=$SELECT($GET(AMHLOUI)]"":AMHLOUI_"-"_AMHLOU,1:"")
+18 SET AMHCPT=$$GET1^DIQ(9000010.16,AMHHDA,.09)
+19 SET AMHCMT=$$GET1^DIQ(9000010.16,AMHHDA,.11)
+20 SET AMHGOAL=$$GET1^DIQ(9000010.16,AMHHDA,.14)
+21 SET AMHSTI=$$GET1^DIQ(9000010.16,AMHHDA,.13,"I")
+22 SET AMHST=$$GET1^DIQ(9000010.16,AMHHDA,.13)
+23 SET AMHSTS=$SELECT($GET(AMHSTI)]"":AMHSTI_"-"_AMHST,1:"")
+24 SET AMHSES=$$GET1^DIQ(9000010.16,AMHHDA,.07,"I")
+25 SET AMHREA=$$GET1^DIQ(9000010.16,AMHHDA,1102)
+26 IF $ORDER(^TMP($JOB,"AMHEDU",$PIECE(AMHDA,"."),AMHEDU,0))
QUIT
+27 SET AMHI=AMHI+1
+28 SET ^TMP($JOB,"AMHEDU",$PIECE(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
End DoDot:3
End DoDot:2
End DoDot:1
+29 QUIT
+30 ;
HSCR(RETVAL,AMHSTR) ;-- get hist scrn
+1 SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,P,R,AMHB,AMHE,AMHP,AMHTI,AMHDA,AMHIEN,AMHIBV,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@(AMHI)="T00010BMXIEN^T00030Date^T00030Alcohol^T00030AlcoholProvider^T00250AlcoholComment^T00030Depression^T00030DepressionProvider^T00250DepressionComment^T00030IPV^T00250IPVComment^T00030IPVProvider"
+14 SET @RETVAL@(AMHI)=@RETVAL@(AMHI)_"^T00030SRA^T00250SRAComment^T00030SRAProvider"_$CHAR(30)
+15 SET AMHIVB=AMHB+.9999
+16 SET AMHIVE=-AMHE-.0001
+17 SET AMHDA=AMHIVE
FOR
SET AMHDA=$ORDER(^AMHREC("AE",AMHP,AMHDA))
IF 'AMHDA!(AMHDA>AMHIVB)
QUIT
Begin DoDot:1
+18 SET AMHIEN=0
FOR
SET AMHIEN=$ORDER(^AMHREC("AE",AMHP,AMHDA,AMHIEN))
IF 'AMHIEN
QUIT
Begin DoDot:2
+19 NEW AMHDT,AMHVIEN,AMHALC,AMHALCP,AMHALCC,AMHDEP,AMHDEPP,AMHDEPC,AMHIPV,AMHIPVC,AMHMTCH,AMHIPVP,AMHS,AMHSC,AMHSPRV
+20 SET AMHMTCH=0
+21 SET AMHDT=$$LVDT^AMHGU($$GET1^DIQ(9002011,AMHIEN,.01,"I"))
+22 SET AMHVIEN=$$GET1^DIQ(9002011,AMHIEN,.16,"I")
+23 SET AMHALC=$$GET1^DIQ(9002011,AMHIEN,1403)
+24 SET AMHALCP=$$GET1^DIQ(9002011,AMHIEN,1404)
+25 SET AMHALCC=$$GET1^DIQ(9002011,AMHIEN,1601)
+26 SET AMHDEP=$$GET1^DIQ(9002011,AMHIEN,1405)
+27 SET AMHDEPP=$$GET1^DIQ(9002011,AMHIEN,1406)
+28 SET AMHDEPC=$$GET1^DIQ(9002011,AMHIEN,1701)
+29 SET AMHIPV=$$GET1^DIQ(9002011,AMHIEN,1401)
+30 SET AMHIPVC=$$GET1^DIQ(9002011,AMHIEN,1501)
+31 SET AMHIPVP=$$GET1^DIQ(9002011,AMHIEN,1402)
+32 SET AMHS=$$GET1^DIQ(9002011,AMHIEN,1407)
+33 SET AMHSC=$$GET1^DIQ(9002011,AMHIEN,1901)
+34 SET AMHSPRV=$$GET1^DIQ(9002011,AMHIEN,1408)
+35 IF $GET(AMHALC)]""
SET AMHMTCH=1
+36 IF $GET(AMHDEP)]""
SET AMHMTCH=1
+37 IF $GET(AMHIPV)]""
SET AMHMTCH=1
+38 IF $GET(AMHS)]""
SET AMHMTCH=1
+39 IF '$GET(AMHMTCH)
QUIT
+40 SET AMHI=AMHI+1
+41 SET ^TMP($JOB,"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
End DoDot:2
End DoDot:1
+42 NEW AMHTDA,AMHTIEN
+43 SET AMHTDA=0
FOR
SET AMHTDA=$ORDER(^TMP($JOB,"AMHSCR",AMHTDA))
IF 'AMHTDA
QUIT
Begin DoDot:1
+44 SET AMHTIEN=0
FOR
SET AMHTIEN=$ORDER(^TMP($JOB,"AMHSCR",AMHTDA,AMHTIEN))
IF 'AMHTIEN
QUIT
Begin DoDot:2
+45 SET AMHTI=AMHTI+1
+46 SET @RETVAL@(AMHTI)=$GET(^TMP($JOB,"AMHSCR",AMHTDA,AMHTIEN))_$CHAR(30)
End DoDot:2
End DoDot:1
+47 SET @RETVAL@(AMHTI+1)=$CHAR(31)
+48 KILL ^TMP($JOB,"AMHSCR")
+49 QUIT
+50 ;
