AMHGD ; IHS/CMI/MAW - AMHG Get Data for GUI Front End 11/25/2008 9:38:11 AM ; 26 Jun 2017 3:55 PM
;;4.0;IHS BEHAVIORAL HEALTH;**1,4,8**;JUN 02, 2010;Build 7
;
;
;
DEBUG(RETVAL,AMHSTR) ;-- debug entry point
D DEBUG^%Serenji("ADML^AMHGD(.RETVAL,.AMHSTR)")
Q
;
VISITL(RETVAL,AMHSTR) ;-- get visit list for record selector screen
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,AMHP,AMHE,AMHB,P,AMHIVB,AMHIVE,AMHDA,AMHIEN
S P="|"
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
K ^AMHTMP($J)
S @RETVAL@(AMHI)="T00010BMXIEN^T00030SortDate^T00030Date^T00050POV^T00020Axis V^T00020Clinic^T00020Activity^T00020Visit Type^T00020Contact Type^T00030Provider^T00001Signed^T00001EHR^T00001DeleteIntakes^T00030LocationofEncounter"
S @RETVAL@(AMHI)=@RETVAL@(AMHI)_"^T00001Group"_U_"T00080Program"_$C(30)
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
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 AMHD0,AHMD11,AMHD14,AHMD15,AHMD16,AMHD17,AMHD21,AMHESIG,AMHPOVE,AMHIDEL,AMHLOC,AMHGRP
.. N AMHDT,AMHPOV,AMHAXV,AMHCLN,AMHACT,AMHVT,AMHCT,AMHPRV,AMHPOVI,AMHPRVI,AMHACTI,AMHEHR
.. N AMHPRVM,AMHPROG
.. S AMHPRVM=0
.. Q:'$$ALLOWVI^AMHUTIL(DUZ,AMHIEN) ;screen on user and visit
.. S AMHD0=$G(^AMHREC(AMHIEN,0))
.. S AMHDT=$P($$GET1^DIQ(9002011,AMHIEN,.01,"I"),".")
.. S AMHPOVI=$O(^AMHRPRO("AD",AMHIEN,0))
.. S AMHPOV=$S($G(AMHPOVI):$$GET1^DIQ(9002011.01,AMHPOVI,.01,"I"),1:"")
.. S AMHPOVE=$S($G(AMHPOVI):$$GET1^DIQ(9002011.01,AMHPOVI,.04),1:"")
.. I $G(AMHPOVE)="" S AMHPOVE=$S($G(AMHPOV):$$GET1^DIQ(9002012.2,AMHPOV,.02),1:"")
.. S AMHAXV=$$GET1^DIQ(9002011,AMHIEN,.14)
.. S AMHCLN=$$GET1^DIQ(9002011,AMHIEN,.25)
.. S AMHACTI=$$GET1^DIQ(9002011,AMHIEN,.06,"I")
.. S AMHACT=$S($G(AMHACTI):$$GET1^DIQ(9002012,AMHACTI,.02),1:"")
.. S AMHVT=$$GET1^DIQ(9002011,AMHIEN,.33)
.. S AMHCT=$$GET1^DIQ(9002011,AMHIEN,.07)
.. S AMHPRVI=$$GETPRV^AMHGU(AMHIEN,"P")
.. S AMHPRV=$S($G(AMHPRVI):$$GET1^DIQ(200,AMHPRVI,.01),1:"")
.. S AMHESIG=$S('$$GET1^DIQ(9002011,AMHIEN,1112,"I"):"*",1:"")
.. S AMHEHR=$$GET1^DIQ(9002011,AMHIEN,1110,"I")
.. I $G(AMHEHR) S AMHESIG="" ;cmi/maw pr580/581
.. S AMHIDEL=$$IINTAKE^AMHLEDEL(AMHIEN)
.. S AMHLOC=$$GET1^DIQ(9002011,AMHIEN,.04)
.. S AMHGRP=$$GET1^DIQ(9002011,AMHIEN,.34,"I")
.. S AMHPROG=$$GET1^DIQ(9002011,AMHIEN,.02)
.. S AMHI=AMHI+1
.. S @RETVAL@(AMHI)=AMHIEN_U_AMHDT_U_$$LVDT^AMHGU(AMHDT)_U_AMHPOVE_U_AMHAXV_U_AMHCLN_U_AMHACT_U_AMHVT_U_AMHCT_U_AMHPRV_U_AMHESIG_U_AMHEHR_U_AMHIDEL_U_AMHLOC_U_AMHGRP_U_AMHPROG_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
VISITAP(RETVAL,AMHSTR) ;-- get visit list for record selector screen all patients
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,AMHP,AMHE,AMHB,P,AMHIVB,AMHIVE,AMHDA,R,AMHIEN
S P="|",R="~"
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
K ^AMHTMP($J)
S @RETVAL@(AMHI)="T00010BMXIEN^T00030SortDate^T00030Date^T00040Patient^T00010Chart^T00001Sex^T00030DOB^T00050POV^T00020Axis V^T00020Clinic^T00020Activity^T00020Visit Type^T00020Contact Type^T00030Provider^T00001Signed^T00001EHR"
S @RETVAL@(AMHI)=@RETVAL@(AMHI)_"^T00001DeleteIntakes^T00030LocationofEncounter^T00001Group^T00001Spt^T02500Message^T00080Program"_$C(30)
S AMHB=$P(AMHSTR,P)
S AMHE=$P(AMHSTR,P,2)
S AMHP=$P(AMHSTR,P,3)
S AMHIVB=(9999999-AMHB)+.0001
S AMHIVE=(9999999-AMHE)-.9999
S AMHDA=AMHIVE F S AMHDA=$O(^AMHREC("AB",AMHDA)) Q:'AMHDA!(AMHDA>AMHIVB) D
. S AMHIEN=0 F S AMHIEN=$O(^AMHREC("AB",AMHDA,AMHIEN)) Q:'AMHIEN D
.. N AMHD0,AHMD11,AMHD14,AHMD15,AHMD16,AMHD17,AMHD21,AMHPIEN,AMHPAT,AMHCHT,AMHDOB,AMHSEX,AMHPOVE,AMHLOC,AMHLOCI,AMHLOCA
.. N AMHDT,AMHPOV,AMHAXV,AMHCLN,AMHACT,AMHVT,AMHCT,AMHPRV,AMHPOVI,AMHPRVI,AMHACTI,AMHESIG,AMHEHR,AMHIDEL,AMHNCHT,AMHGRP
.. N AMHPRVM,AMHSPT,AMHMSG,AMHPROG
.. S AMHPRVM=0
.. Q:'$$ALLOWVI^AMHUTIL(DUZ,AMHIEN) ;screen on user and visit
.. S AMHD0=$G(^AMHREC(AMHIEN,0))
.. S AMHPIEN=$P(AMHD0,U,8)
.. Q:'AMHPIEN
.. S AMHPAT=$$GET1^DIQ(2,AMHPIEN,.01)
.. S AMHCHT=$$HRN^AUPNPAT(AMHPIEN,DUZ(2))
.. S AMHDOB=$$GET1^DIQ(2,AMHPIEN,.03,"I")
.. S AMHDOB=$$LVDT^AMHGU(AMHDOB)
.. S AMHSEX=$$GET1^DIQ(2,AMHPIEN,.02,"I")
.. S AMHDT=$P($$GET1^DIQ(9002011,AMHIEN,.01,"I"),".")
.. S AMHPOVI=$O(^AMHRPRO("AD",AMHIEN,0))
.. S AMHPOV=$S($G(AMHPOVI):$$GET1^DIQ(9002011.01,AMHPOVI,.01,"I"),1:"")
.. S AMHPOVE=$S($G(AMHPOVI):$$GET1^DIQ(9002011.01,AMHPOVI,.04),1:"")
.. I $G(AMHPOVE)="" S AMHPOVE=$S($G(AMHPOV):$$GET1^DIQ(9002012.2,AMHPOV,.02),1:"")
.. S AMHAXV=$$GET1^DIQ(9002011,AMHIEN,.14)
.. S AMHCLN=$$GET1^DIQ(9002011,AMHIEN,.25)
.. S AMHACTI=$$GET1^DIQ(9002011,AMHIEN,.06,"I")
.. S AMHACT=$S($G(AMHACTI):$$GET1^DIQ(9002012,AMHACTI,.02),1:"")
.. S AMHVT=$$GET1^DIQ(9002011,AMHIEN,.33)
.. S AMHCT=$$GET1^DIQ(9002011,AMHIEN,.07)
.. S AMHPRVI=$$GETPRV^AMHGU(AMHIEN,"P")
.. S AMHPRV=$S($G(AMHPRVI):$$GET1^DIQ(200,AMHPRVI,.01),1:"")
.. S AMHESIG=$S('$$GET1^DIQ(9002011,AMHIEN,1112,"I"):"*",1:"")
.. S AMHEHR=$$GET1^DIQ(9002011,AMHIEN,1110,"I")
.. I $G(AMHEHR) S AMHESIG="" ;cmi/maw pr580/581
.. S AMHIDEL=$$IINTAKE^AMHLEDEL(AMHIEN)
.. S AMHLOC=$$GET1^DIQ(9002011,AMHIEN,.04)
.. S AMHLOCI=$$GET1^DIQ(9002011,AMHIEN,.04,"I")
.. S AMHLOCA=$S(AMHLOCI:$$GET1^DIQ(9999999.06,AMHLOCI,.08),1:"")
.. S AMHGRP=$$GET1^DIQ(9002011,AMHIEN,.34,"I")
.. S AMHNCHT=AMHLOCA_$$HRN^AUPNPAT(AMHPIEN,AMHLOCI)
.. S AMHSPT=$$SPT^AMHGDA(AMHPIEN)
.. S AMHPROG=$$GET1^DIQ(9002011,AMHIEN,.02)
.. I $G(AMHSPT) D
... S AMHDOB="**SENSITIVE**"
... S AMHMSG=$G(AMHDGMSG)
.. S AMHI=AMHI+1
.. S @RETVAL@(AMHI)=AMHIEN_U_AMHDT_U_$$LVDT^AMHGU(AMHDT)_U_AMHPIEN_R_AMHPAT_U_AMHNCHT_U_AMHSEX_U_AMHDOB_U_AMHPOVE_U_AMHAXV_U_AMHCLN_U_AMHACT_U_AMHVT_U_AMHCT_U_AMHPRV_U_AMHESIG_U_AMHEHR_U_AMHIDEL_U_AMHLOC_U_AMHGRP_U_$G(AMHSPT)
.. S @RETVAL@(AMHI)=@RETVAL@(AMHI)_U_$G(AMHMSG)_U_AMHPROG_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
CML(RETVAL,AMHSTR) ;-- get case management list for record selector screen
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,AMHP,AMHE,AMHB,P,AMHIVB,AMHIVE,AMHDA,AMHIEN
S P="|",R="~"
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
K ^AMHTMP($J)
S @RETVAL@(AMHI)="T00010BMXIEN^T00030SortDate^T00030OpenDate^T00030AdmitDate^T00030ClosedDate^T00050Disposition^T00030Program^T00030Provider"_$C(30)
S AMHB=$P(AMHSTR,P)
S AMHE=$P(AMHSTR,P,2)
S AMHP=$P(AMHSTR,P,3)
S AMHIVB=(9999999-AMHB)+.0001
S AMHIVE=(9999999-AMHE)-.9999
S AMHDA=AMHIVE F S AMHDA=$O(^AMHPCASE("AA",AMHP,AMHDA)) Q:'AMHDA!(AMHDA>AMHIVB) D
. S AMHIEN=0 F S AMHIEN=$O(^AMHPCASE("AA",AMHP,AMHDA,AMHIEN)) Q:'AMHIEN D
.. N AMHCO,AMHCA,AMHCC,AMHDSPI,AMHDSP,AMHDSPS,AMHPRGI,AMHPRG,AMHPRGS,AMHPRVI,AMHPRV,AMHPRVS
.. Q:'$$ALLOWCD^AMHLCD(DUZ,AMHIEN) ;screen on duz and case
.. S AMHCO=$$GET1^DIQ(9002011.58,AMHIEN,.01,"I")
.. S AMHCA=$$GET1^DIQ(9002011.58,AMHIEN,.04,"I")
.. S AMHCC=$$GET1^DIQ(9002011.58,AMHIEN,.05,"I")
.. S AMHDSPI=$$GET1^DIQ(9002011.58,AMHIEN,.06,"I")
.. S AMHDSP=$$GET1^DIQ(9002011.58,AMHIEN,.06)
.. I AMHDSPI S AMHDSPS=AMHDSPI_R_AMHDSP
.. S AMHPRGI=$$GET1^DIQ(9002011.58,AMHIEN,.03,"I")
.. S AMHPRG=$$GET1^DIQ(9002011.58,AMHIEN,.03)
.. I AMHPRGI]"" S AMHPRGS=AMHPRGI_R_AMHPRG
.. S AMHPRVI=$$GET1^DIQ(9002011.58,AMHIEN,.08,"I")
.. S AMHPRV=$$GET1^DIQ(9002011.58,AMHIEN,.08)
.. I AMHPRVI S AMHPRVS=AMHPRVI_R_AMHPRV
.. S AMHI=AMHI+1
.. S @RETVAL@(AMHI)=AMHIEN_U_AMHCO_U_$$LVDT^AMHGU(AMHCO)_U_$$LVDT^AMHGU(AMHCA)_U_$$LVDT^AMHGU(AMHCC)_U_$G(AMHDSPS)_U_$G(AMHPRGS)_U_$G(AMHPRVS)_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
TPL(RETVAL,AMHSTR) ;-- get treatment plans for record selector screen
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,AMHP,AMHE,AMHB,P,AMHIVB,AMHIVE,AMHDA,AMHIEN
S P="|",R="~"
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
K ^AMHTMP($J)
S @RETVAL@(AMHI)="T00010BMXIEN^T00030SortDate^T00030DateEstablished^T00030Program^T00030Status^T00080Problem^T00030Provider^T00030ReviewDate^T00010Reviews"_$C(30)
S AMHB=$P(AMHSTR,P)
S AMHE=$P(AMHSTR,P,2)
S AMHP=$P(AMHSTR,P,3)
S AMHIVB=(9999999-AMHB)+.0001
S AMHIVE=(9999999-AMHE)-.9999
S AMHDA=AMHIVE F S AMHDA=$O(^AMHPTXP("AA",AMHP,AMHDA)) Q:'AMHDA!(AMHDA>AMHIVB) D
. S AMHIEN=0 F S AMHIEN=$O(^AMHPTXP("AA",AMHP,AMHDA,AMHIEN)) Q:'AMHIEN D
.. N AMHDE,AMHPRG,AMHST,AMHPRB,AMHPRV,AMHRD
.. N AMHPRVM,AMHRCNT
.. S AMHPRVM=0
.. Q:'$$ALLOWTP^AMHLETP(DUZ,AMHIEN) ;screen on user and treatment plan
.. S AMHDE=$$GET1^DIQ(9002011.56,AMHIEN,.01,"I")
.. S AMHPRG=$$GET1^DIQ(9002011.56,AMHIEN,.17)
.. S AMHST=$$GET1^DIQ(9002011.56,AMHIEN,.15)
.. S AMHPRB=$$GET1^DIQ(9002011.56,AMHIEN,1101)
.. I AMHPRB="" S AMHPRB=$G(^AMHPTXP(AMHIEN,21,1,0)) ;v4.0p4 display the dx if no problem
.. S AMHPRV=$$GET1^DIQ(9002011.56,AMHIEN,.04)
.. S AMHRD=$$GET1^DIQ(9002011.56,AMHIEN,.09,"I")
.. S AMHRCNT=+$P($G(^AMHPTXP(AMHIEN,41,0)),U,4)
.. S AMHI=AMHI+1
.. S @RETVAL@(AMHI)=AMHIEN_U_AMHDE_U_$$LVDT^AMHGU(AMHDE)_U_AMHPRG_U_AMHST_U_AMHPRB_U_AMHPRV_U_$$LVDT^AMHGU(AMHRD)_U_AMHRCNT_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
TPLAP(RETVAL,AMHSTR) ;-- get treatment plans for record selector screen all patients
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,AMHP,AMHE,AMHB,P,AMHIVB,AMHIVE,AMHDA,AMHIEN
S P="|",R="~"
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
K ^AMHTMP($J)
S @RETVAL@(AMHI)="T00010BMXIEN^T00030SortDate^T00030DateEstablished^T00040Patient^T00010Chart^T00001Sex^T00030DOB^T00030Program^T00030Status^T00080Problem^T00030Provider^T00030ReviewDate^T00010Reviews^T00001Spt^T02500Message"_$C(30)
S AMHB=$P(AMHSTR,P)
S AMHE=$P(AMHSTR,P,2)
S AMHP=$P(AMHSTR,P,3)
S AMHIVB=(9999999-AMHB)+.0001
S AMHIVE=(9999999-AMHE)-.9999
S AMHDA=AMHIVE F S AMHDA=$O(^AMHPTXP("AB",AMHDA)) Q:'AMHDA!(AMHDA>AMHIVB) D
. S AMHIEN=0 F S AMHIEN=$O(^AMHPTXP("AB",AMHDA,AMHIEN)) Q:'AMHIEN D
.. N AMHDE,AMHPRG,AMHST,AMHPRB,AMHPRV,AMHRD,AMHPIEN,AMHPAT,AMHDOB,AMHSEX,AMHCHT
.. N AMHPRVM,AMHSPT,AMHMSG
.. S AMHPRVM=0
.. Q:'$$ALLOWTP^AMHLETP(DUZ,AMHIEN) ;screen on user and treatment plan
.. S AMHPIEN=$$GET1^DIQ(9002011.56,AMHIEN,.02,"I")
.. Q:'AMHPIEN
.. S AMHPAT=$$GET1^DIQ(2,AMHPIEN,.01)
.. S AMHCHT=$$HRN^AUPNPAT(AMHPIEN,DUZ(2))
.. S AMHDOB=$$GET1^DIQ(2,AMHPIEN,.03,"I")
.. S AMHDOB=$$LVDT^AMHGU(AMHDOB)
.. S AMHSEX=$$GET1^DIQ(2,AMHPIEN,.02,"I")
.. S AMHDE=$$GET1^DIQ(9002011.56,AMHIEN,.01,"I")
.. S AMHPRG=$$GET1^DIQ(9002011.56,AMHIEN,.17)
.. S AMHST=$$GET1^DIQ(9002011.56,AMHIEN,.15)
.. S AMHPRB=$$GET1^DIQ(9002011.56,AMHIEN,1101)
.. I AMHPRB="" S AMHPRB=$G(^AMHPTXP(AMHIEN,21,1,0)) ;v4.0p4 display the dx if no problem
.. S AMHPRV=$$GET1^DIQ(9002011.56,AMHIEN,.04)
.. S AMHRD=$$GET1^DIQ(9002011.56,AMHIEN,.09,"I")
.. S AMHRCNT=+$P($G(^AMHPTXP(AMHIEN,41,0)),U,4)
.. S AMHSPT=$$SPT^AMHGDA(AMHPIEN)
.. I $G(AMHSPT) D
... S AMHDOB="**SENSITIVE**"
... S AMHMSG=$G(AMHDGMSG)
.. S AMHI=AMHI+1
.. S @RETVAL@(AMHI)=AMHIEN_U_AMHDE_U_$$LVDT^AMHGU(AMHDE)_U_AMHPIEN_R_AMHPAT_U_AMHCHT_U_AMHSEX_U_AMHDOB_U_AMHPRG_U_AMHST_U_AMHPRB_U_AMHPRV_U_$$LVDT^AMHGU(AMHRD)_U_AMHRCNT_U_+$G(AMHSPT)_U_$G(AMHMSG)_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
SFL(RETVAL,AMHSTR) ;-- get suicide forms for record selector screen
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,AMHP,AMHE,AMHB,P,AMHIVB,AMHIVE,AMHDA,AMHIEN
S P="|",R="~"
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
K ^AMHTMP($J)
S @RETVAL@(AMHI)="T00010BMXIEN^T00030SortDate^T00030Date^T00030LocalCaseNumber^T00030Provider^T00080SuicidalBehavior^T00001Incomplete"_$C(30)
S AMHB=$P(AMHSTR,P)
S AMHE=$P(AMHSTR,P,2)
S AMHP=$P(AMHSTR,P,3)
S AMHIVB=(9999999-AMHB)+.0001
S AMHIVE=(9999999-AMHE)-.9999
S AMHDA=AMHIVE F S AMHDA=$O(^AMHPSUIC("AA",AMHP,AMHDA)) Q:'AMHDA!(AMHDA>AMHIVB) D
. S AMHIEN=0 F S AMHIEN=$O(^AMHPSUIC("AA",AMHP,AMHDA,AMHIEN)) Q:'AMHIEN D
.. N AMHPRVM
.. S AMHPRVM=0
.. Q:'$$ALLOW^AMHSFR(DUZ,AMHIEN) ;screen on user and suicide form
.. N AMHD,AMHLCN,AMHPRV,AMHSB,AMHINC
.. S AMHINC=$S($$INCOMPSF^AMHLESF(AMHIEN):"I",1:"") ;v4.0 p1
.. S AMHD=$$GET1^DIQ(9002011.65,AMHIEN,.06,"I")
.. S AMHLCN=$$GET1^DIQ(9002011.65,AMHIEN,.02)
.. S AMHPRV=$$GET1^DIQ(9002011.65,AMHIEN,.03)
.. S AMHSB=$$GET1^DIQ(9002011.65,AMHIEN,.13)
.. S AMHI=AMHI+1
.. S @RETVAL@(AMHI)=AMHIEN_U_AMHD_U_$$LVDT^AMHGU(AMHD)_U_AMHLCN_U_AMHPRV_U_AMHSB_U_AMHINC_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
SFLAP(RETVAL,AMHSTR) ;-- get suicide forms for record selector screen all patients
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,AMHP,AMHE,AMHB,P,AMHIVB,AMHIVE,AMHDA,AMHIEN
S P="|",R="~"
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
K ^AMHTMP($J)
S @RETVAL@(AMHI)="T00010BMXIEN^T00030SortDate^T00030Date^T00040Patient^T00010Chart^T00001Sex^T00030DOB^T00030LocalCaseNumber^T00030Provider^T00080SuicidalBehavior^T00001Spt^T02500Message^T00001Incomplete"_$C(30)
S AMHB=$P(AMHSTR,P)
S AMHE=$P(AMHSTR,P,2)
S AMHP=$P(AMHSTR,P,3)
S AMHIVB=(9999999-AMHB)+.0001
S AMHIVE=(9999999-AMHE)-.9999
S AMHDA=AMHIVE F S AMHDA=$O(^AMHPSUIC("AB",AMHDA)) Q:'AMHDA!(AMHDA>AMHIVB) D
. S AMHIEN=0 F S AMHIEN=$O(^AMHPSUIC("AB",AMHDA,AMHIEN)) Q:'AMHIEN D
.. N AMHPRVM
.. S AMHPRVM=0
.. Q:'$$ALLOW^AMHSFR(DUZ,AMHIEN) ;screen on user and suicide form
.. N AMHD,AMHLCN,AMHPRV,AMHSB,AMHPIEN,AMHPAT,AMHSPT,AMHMSG,AMHCHT,AMHSEX,AMHINC
.. S AMHPIEN=$$GET1^DIQ(9002011.65,AMHIEN,.04,"I")
.. Q:'AMHPIEN
.. S AMHINC=$S($$INCOMPSF^AMHLESF(AMHIEN):"I",1:"") ;v4.0 p1
.. S AMHPAT=$$GET1^DIQ(2,AMHPIEN,.01)
.. S AMHCHT=$$HRN^AUPNPAT(AMHPIEN,DUZ(2))
.. S AMHDOB=$$GET1^DIQ(2,AMHPIEN,.03,"I")
.. S AMHDOB=$$LVDT^AMHGU(AMHDOB)
.. S AMHSEX=$$GET1^DIQ(2,AMHPIEN,.02,"I")
.. S AMHD=$$GET1^DIQ(9002011.65,AMHIEN,.06,"I")
.. S AMHLCN=$$GET1^DIQ(9002011.65,AMHIEN,.02)
.. S AMHPRV=$$GET1^DIQ(9002011.65,AMHIEN,.03)
.. S AMHSB=$$GET1^DIQ(9002011.65,AMHIEN,.13)
.. S AMHSPT=$$SPT^AMHGDA(AMHPIEN)
.. I $G(AMHSPT) D
... S AMHDOB="**SENSITIVE**"
... S AMHMSG=$G(AMHDGMSG)
.. S AMHI=AMHI+1
.. S @RETVAL@(AMHI)=AMHIEN_U_AMHD_U_$$LVDT^AMHGU(AMHD)_U_AMHPIEN_R_AMHPAT_U_AMHCHT_U_AMHSEX_U_AMHDOB_U_AMHLCN_U_AMHPRV_U_AMHSB_U_+$G(AMHSPT)_U_$G(AMHMSG)_U_AMHINC_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
AMHGD ; IHS/CMI/MAW - AMHG Get Data for GUI Front End 11/25/2008 9:38:11 AM ; 26 Jun 2017 3:55 PM
+1 ;;4.0;IHS BEHAVIORAL HEALTH;**1,4,8**;JUN 02, 2010;Build 7
+2 ;
+3 ;
+4 ;
DEBUG(RETVAL,AMHSTR) ;-- debug entry point
+1 DO DEBUG^%Serenji("ADML^AMHGD(.RETVAL,.AMHSTR)")
+2 QUIT
+3 ;
VISITL(RETVAL,AMHSTR) ;-- get visit list for record selector screen
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,AMHP,AMHE,AMHB,P,AMHIVB,AMHIVE,AMHDA,AMHIEN
+3 SET P="|"
+4 SET RETVAL="^AMHTMP("_$JOB_")"
+5 SET AMHI=0
+6 KILL ^AMHTMP($JOB)
+7 SET @RETVAL@(AMHI)="T00010BMXIEN^T00030SortDate^T00030Date^T00050POV^T00020Axis V^T00020Clinic^T00020Activity^T00020Visit Type^T00020Contact Type^T00030Provider^T00001Signed^T00001EHR^T00001DeleteIntakes^T00030LocationofEncounter"
+8 SET @RETVAL@(AMHI)=@RETVAL@(AMHI)_"^T00001Group"_U_"T00080Program"_$CHAR(30)
+9 SET AMHB=$PIECE(AMHSTR,P)
+10 SET AMHE=$PIECE(AMHSTR,P,2)
+11 SET AMHP=$PIECE(AMHSTR,P,3)
+12 SET AMHIVB=(9999999-AMHB)+.9999
+13 SET AMHIVE=(9999999-AMHE)-.0001
+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 AMHD0,AHMD11,AMHD14,AHMD15,AHMD16,AMHD17,AMHD21,AMHESIG,AMHPOVE,AMHIDEL,AMHLOC,AMHGRP
+17 NEW AMHDT,AMHPOV,AMHAXV,AMHCLN,AMHACT,AMHVT,AMHCT,AMHPRV,AMHPOVI,AMHPRVI,AMHACTI,AMHEHR
+18 NEW AMHPRVM,AMHPROG
+19 SET AMHPRVM=0
+20 ;screen on user and visit
IF '$$ALLOWVI^AMHUTIL(DUZ,AMHIEN)
QUIT
+21 SET AMHD0=$GET(^AMHREC(AMHIEN,0))
+22 SET AMHDT=$PIECE($$GET1^DIQ(9002011,AMHIEN,.01,"I"),".")
+23 SET AMHPOVI=$ORDER(^AMHRPRO("AD",AMHIEN,0))
+24 SET AMHPOV=$SELECT($GET(AMHPOVI):$$GET1^DIQ(9002011.01,AMHPOVI,.01,"I"),1:"")
+25 SET AMHPOVE=$SELECT($GET(AMHPOVI):$$GET1^DIQ(9002011.01,AMHPOVI,.04),1:"")
+26 IF $GET(AMHPOVE)=""
SET AMHPOVE=$SELECT($GET(AMHPOV):$$GET1^DIQ(9002012.2,AMHPOV,.02),1:"")
+27 SET AMHAXV=$$GET1^DIQ(9002011,AMHIEN,.14)
+28 SET AMHCLN=$$GET1^DIQ(9002011,AMHIEN,.25)
+29 SET AMHACTI=$$GET1^DIQ(9002011,AMHIEN,.06,"I")
+30 SET AMHACT=$SELECT($GET(AMHACTI):$$GET1^DIQ(9002012,AMHACTI,.02),1:"")
+31 SET AMHVT=$$GET1^DIQ(9002011,AMHIEN,.33)
+32 SET AMHCT=$$GET1^DIQ(9002011,AMHIEN,.07)
+33 SET AMHPRVI=$$GETPRV^AMHGU(AMHIEN,"P")
+34 SET AMHPRV=$SELECT($GET(AMHPRVI):$$GET1^DIQ(200,AMHPRVI,.01),1:"")
+35 SET AMHESIG=$SELECT('$$GET1^DIQ(9002011,AMHIEN,1112,"I"):"*",1:"")
+36 SET AMHEHR=$$GET1^DIQ(9002011,AMHIEN,1110,"I")
+37 ;cmi/maw pr580/581
IF $GET(AMHEHR)
SET AMHESIG=""
+38 SET AMHIDEL=$$IINTAKE^AMHLEDEL(AMHIEN)
+39 SET AMHLOC=$$GET1^DIQ(9002011,AMHIEN,.04)
+40 SET AMHGRP=$$GET1^DIQ(9002011,AMHIEN,.34,"I")
+41 SET AMHPROG=$$GET1^DIQ(9002011,AMHIEN,.02)
+42 SET AMHI=AMHI+1
+43 SET @RETVAL@(AMHI)=AMHIEN_U_AMHDT_U_$$LVDT^AMHGU(AMHDT)_U_AMHPOVE_U_AMHAXV_U_AMHCLN_U_AMHACT_U_AMHVT_U_AMHCT_U_AMHPRV_U_AMHESIG_U_AMHEHR_U_AMHIDEL_U_AMHLOC_U_AMHGRP_U_AMHPROG_$CHAR(30)
End DoDot:2
End DoDot:1
+44 SET @RETVAL@(AMHI+1)=$CHAR(31)
+45 QUIT
+46 ;
VISITAP(RETVAL,AMHSTR) ;-- get visit list for record selector screen all patients
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,AMHP,AMHE,AMHB,P,AMHIVB,AMHIVE,AMHDA,R,AMHIEN
+3 SET P="|"
SET R="~"
+4 SET RETVAL="^AMHTMP("_$JOB_")"
+5 SET AMHI=0
+6 KILL ^AMHTMP($JOB)
+7 SET @RETVAL@(AMHI)="T00010BMXIEN^T00030SortDate^T00030Date^T00040Patient^T00010Chart^T00001Sex^T00030DOB^T00050POV^T00020Axis V^T00020Clinic^T00020Activity^T00020Visit Type^T00020Contact Type^T00030Provider^T00001Signed^T00001EHR"
+8 SET @RETVAL@(AMHI)=@RETVAL@(AMHI)_"^T00001DeleteIntakes^T00030LocationofEncounter^T00001Group^T00001Spt^T02500Message^T00080Program"_$CHAR(30)
+9 SET AMHB=$PIECE(AMHSTR,P)
+10 SET AMHE=$PIECE(AMHSTR,P,2)
+11 SET AMHP=$PIECE(AMHSTR,P,3)
+12 SET AMHIVB=(9999999-AMHB)+.0001
+13 SET AMHIVE=(9999999-AMHE)-.9999
+14 SET AMHDA=AMHIVE
FOR
SET AMHDA=$ORDER(^AMHREC("AB",AMHDA))
IF 'AMHDA!(AMHDA>AMHIVB)
QUIT
Begin DoDot:1
+15 SET AMHIEN=0
FOR
SET AMHIEN=$ORDER(^AMHREC("AB",AMHDA,AMHIEN))
IF 'AMHIEN
QUIT
Begin DoDot:2
+16 NEW AMHD0,AHMD11,AMHD14,AHMD15,AHMD16,AMHD17,AMHD21,AMHPIEN,AMHPAT,AMHCHT,AMHDOB,AMHSEX,AMHPOVE,AMHLOC,AMHLOCI,AMHLOCA
+17 NEW AMHDT,AMHPOV,AMHAXV,AMHCLN,AMHACT,AMHVT,AMHCT,AMHPRV,AMHPOVI,AMHPRVI,AMHACTI,AMHESIG,AMHEHR,AMHIDEL,AMHNCHT,AMHGRP
+18 NEW AMHPRVM,AMHSPT,AMHMSG,AMHPROG
+19 SET AMHPRVM=0
+20 ;screen on user and visit
IF '$$ALLOWVI^AMHUTIL(DUZ,AMHIEN)
QUIT
+21 SET AMHD0=$GET(^AMHREC(AMHIEN,0))
+22 SET AMHPIEN=$PIECE(AMHD0,U,8)
+23 IF 'AMHPIEN
QUIT
+24 SET AMHPAT=$$GET1^DIQ(2,AMHPIEN,.01)
+25 SET AMHCHT=$$HRN^AUPNPAT(AMHPIEN,DUZ(2))
+26 SET AMHDOB=$$GET1^DIQ(2,AMHPIEN,.03,"I")
+27 SET AMHDOB=$$LVDT^AMHGU(AMHDOB)
+28 SET AMHSEX=$$GET1^DIQ(2,AMHPIEN,.02,"I")
+29 SET AMHDT=$PIECE($$GET1^DIQ(9002011,AMHIEN,.01,"I"),".")
+30 SET AMHPOVI=$ORDER(^AMHRPRO("AD",AMHIEN,0))
+31 SET AMHPOV=$SELECT($GET(AMHPOVI):$$GET1^DIQ(9002011.01,AMHPOVI,.01,"I"),1:"")
+32 SET AMHPOVE=$SELECT($GET(AMHPOVI):$$GET1^DIQ(9002011.01,AMHPOVI,.04),1:"")
+33 IF $GET(AMHPOVE)=""
SET AMHPOVE=$SELECT($GET(AMHPOV):$$GET1^DIQ(9002012.2,AMHPOV,.02),1:"")
+34 SET AMHAXV=$$GET1^DIQ(9002011,AMHIEN,.14)
+35 SET AMHCLN=$$GET1^DIQ(9002011,AMHIEN,.25)
+36 SET AMHACTI=$$GET1^DIQ(9002011,AMHIEN,.06,"I")
+37 SET AMHACT=$SELECT($GET(AMHACTI):$$GET1^DIQ(9002012,AMHACTI,.02),1:"")
+38 SET AMHVT=$$GET1^DIQ(9002011,AMHIEN,.33)
+39 SET AMHCT=$$GET1^DIQ(9002011,AMHIEN,.07)
+40 SET AMHPRVI=$$GETPRV^AMHGU(AMHIEN,"P")
+41 SET AMHPRV=$SELECT($GET(AMHPRVI):$$GET1^DIQ(200,AMHPRVI,.01),1:"")
+42 SET AMHESIG=$SELECT('$$GET1^DIQ(9002011,AMHIEN,1112,"I"):"*",1:"")
+43 SET AMHEHR=$$GET1^DIQ(9002011,AMHIEN,1110,"I")
+44 ;cmi/maw pr580/581
IF $GET(AMHEHR)
SET AMHESIG=""
+45 SET AMHIDEL=$$IINTAKE^AMHLEDEL(AMHIEN)
+46 SET AMHLOC=$$GET1^DIQ(9002011,AMHIEN,.04)
+47 SET AMHLOCI=$$GET1^DIQ(9002011,AMHIEN,.04,"I")
+48 SET AMHLOCA=$SELECT(AMHLOCI:$$GET1^DIQ(9999999.06,AMHLOCI,.08),1:"")
+49 SET AMHGRP=$$GET1^DIQ(9002011,AMHIEN,.34,"I")
+50 SET AMHNCHT=AMHLOCA_$$HRN^AUPNPAT(AMHPIEN,AMHLOCI)
+51 SET AMHSPT=$$SPT^AMHGDA(AMHPIEN)
+52 SET AMHPROG=$$GET1^DIQ(9002011,AMHIEN,.02)
+53 IF $GET(AMHSPT)
Begin DoDot:3
+54 SET AMHDOB="**SENSITIVE**"
+55 SET AMHMSG=$GET(AMHDGMSG)
End DoDot:3
+56 SET AMHI=AMHI+1
+57 SET @RETVAL@(AMHI)=AMHIEN_U_AMHDT_U_$$LVDT^AMHGU(AMHDT)_U_AMHPIEN_R_AMHPAT_U_AMHNCHT_U_AMHSEX_U_AMHDOB_U_AMHPOVE_U_AMHAXV_U_AMHCLN_U_AMHACT_U_AMHVT_U_AMHCT_U_AMHPRV_U_AMHESIG_U_AMHEHR_U_AMHIDEL_U_AMHLOC_U_AMHGRP_U_$GET(AMHSPT)
+58 SET @RETVAL@(AMHI)=@RETVAL@(AMHI)_U_$GET(AMHMSG)_U_AMHPROG_$CHAR(30)
End DoDot:2
End DoDot:1
+59 SET @RETVAL@(AMHI+1)=$CHAR(31)
+60 QUIT
+61 ;
CML(RETVAL,AMHSTR) ;-- get case management list for record selector screen
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,AMHP,AMHE,AMHB,P,AMHIVB,AMHIVE,AMHDA,AMHIEN
+3 SET P="|"
SET R="~"
+4 SET RETVAL="^AMHTMP("_$JOB_")"
+5 SET AMHI=0
+6 KILL ^AMHTMP($JOB)
+7 SET @RETVAL@(AMHI)="T00010BMXIEN^T00030SortDate^T00030OpenDate^T00030AdmitDate^T00030ClosedDate^T00050Disposition^T00030Program^T00030Provider"_$CHAR(30)
+8 SET AMHB=$PIECE(AMHSTR,P)
+9 SET AMHE=$PIECE(AMHSTR,P,2)
+10 SET AMHP=$PIECE(AMHSTR,P,3)
+11 SET AMHIVB=(9999999-AMHB)+.0001
+12 SET AMHIVE=(9999999-AMHE)-.9999
+13 SET AMHDA=AMHIVE
FOR
SET AMHDA=$ORDER(^AMHPCASE("AA",AMHP,AMHDA))
IF 'AMHDA!(AMHDA>AMHIVB)
QUIT
Begin DoDot:1
+14 SET AMHIEN=0
FOR
SET AMHIEN=$ORDER(^AMHPCASE("AA",AMHP,AMHDA,AMHIEN))
IF 'AMHIEN
QUIT
Begin DoDot:2
+15 NEW AMHCO,AMHCA,AMHCC,AMHDSPI,AMHDSP,AMHDSPS,AMHPRGI,AMHPRG,AMHPRGS,AMHPRVI,AMHPRV,AMHPRVS
+16 ;screen on duz and case
IF '$$ALLOWCD^AMHLCD(DUZ,AMHIEN)
QUIT
+17 SET AMHCO=$$GET1^DIQ(9002011.58,AMHIEN,.01,"I")
+18 SET AMHCA=$$GET1^DIQ(9002011.58,AMHIEN,.04,"I")
+19 SET AMHCC=$$GET1^DIQ(9002011.58,AMHIEN,.05,"I")
+20 SET AMHDSPI=$$GET1^DIQ(9002011.58,AMHIEN,.06,"I")
+21 SET AMHDSP=$$GET1^DIQ(9002011.58,AMHIEN,.06)
+22 IF AMHDSPI
SET AMHDSPS=AMHDSPI_R_AMHDSP
+23 SET AMHPRGI=$$GET1^DIQ(9002011.58,AMHIEN,.03,"I")
+24 SET AMHPRG=$$GET1^DIQ(9002011.58,AMHIEN,.03)
+25 IF AMHPRGI]""
SET AMHPRGS=AMHPRGI_R_AMHPRG
+26 SET AMHPRVI=$$GET1^DIQ(9002011.58,AMHIEN,.08,"I")
+27 SET AMHPRV=$$GET1^DIQ(9002011.58,AMHIEN,.08)
+28 IF AMHPRVI
SET AMHPRVS=AMHPRVI_R_AMHPRV
+29 SET AMHI=AMHI+1
+30 SET @RETVAL@(AMHI)=AMHIEN_U_AMHCO_U_$$LVDT^AMHGU(AMHCO)_U_$$LVDT^AMHGU(AMHCA)_U_$$LVDT^AMHGU(AMHCC)_U_$GET(AMHDSPS)_U_$GET(AMHPRGS)_U_$GET(AMHPRVS)_$CHAR(30)
End DoDot:2
End DoDot:1
+31 SET @RETVAL@(AMHI+1)=$CHAR(31)
+32 QUIT
+33 ;
TPL(RETVAL,AMHSTR) ;-- get treatment plans for record selector screen
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,AMHP,AMHE,AMHB,P,AMHIVB,AMHIVE,AMHDA,AMHIEN
+3 SET P="|"
SET R="~"
+4 SET RETVAL="^AMHTMP("_$JOB_")"
+5 SET AMHI=0
+6 KILL ^AMHTMP($JOB)
+7 SET @RETVAL@(AMHI)="T00010BMXIEN^T00030SortDate^T00030DateEstablished^T00030Program^T00030Status^T00080Problem^T00030Provider^T00030ReviewDate^T00010Reviews"_$CHAR(30)
+8 SET AMHB=$PIECE(AMHSTR,P)
+9 SET AMHE=$PIECE(AMHSTR,P,2)
+10 SET AMHP=$PIECE(AMHSTR,P,3)
+11 SET AMHIVB=(9999999-AMHB)+.0001
+12 SET AMHIVE=(9999999-AMHE)-.9999
+13 SET AMHDA=AMHIVE
FOR
SET AMHDA=$ORDER(^AMHPTXP("AA",AMHP,AMHDA))
IF 'AMHDA!(AMHDA>AMHIVB)
QUIT
Begin DoDot:1
+14 SET AMHIEN=0
FOR
SET AMHIEN=$ORDER(^AMHPTXP("AA",AMHP,AMHDA,AMHIEN))
IF 'AMHIEN
QUIT
Begin DoDot:2
+15 NEW AMHDE,AMHPRG,AMHST,AMHPRB,AMHPRV,AMHRD
+16 NEW AMHPRVM,AMHRCNT
+17 SET AMHPRVM=0
+18 ;screen on user and treatment plan
IF '$$ALLOWTP^AMHLETP(DUZ,AMHIEN)
QUIT
+19 SET AMHDE=$$GET1^DIQ(9002011.56,AMHIEN,.01,"I")
+20 SET AMHPRG=$$GET1^DIQ(9002011.56,AMHIEN,.17)
+21 SET AMHST=$$GET1^DIQ(9002011.56,AMHIEN,.15)
+22 SET AMHPRB=$$GET1^DIQ(9002011.56,AMHIEN,1101)
+23 ;v4.0p4 display the dx if no problem
IF AMHPRB=""
SET AMHPRB=$GET(^AMHPTXP(AMHIEN,21,1,0))
+24 SET AMHPRV=$$GET1^DIQ(9002011.56,AMHIEN,.04)
+25 SET AMHRD=$$GET1^DIQ(9002011.56,AMHIEN,.09,"I")
+26 SET AMHRCNT=+$PIECE($GET(^AMHPTXP(AMHIEN,41,0)),U,4)
+27 SET AMHI=AMHI+1
+28 SET @RETVAL@(AMHI)=AMHIEN_U_AMHDE_U_$$LVDT^AMHGU(AMHDE)_U_AMHPRG_U_AMHST_U_AMHPRB_U_AMHPRV_U_$$LVDT^AMHGU(AMHRD)_U_AMHRCNT_$CHAR(30)
End DoDot:2
End DoDot:1
+29 SET @RETVAL@(AMHI+1)=$CHAR(31)
+30 QUIT
+31 ;
TPLAP(RETVAL,AMHSTR) ;-- get treatment plans for record selector screen all patients
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,AMHP,AMHE,AMHB,P,AMHIVB,AMHIVE,AMHDA,AMHIEN
+3 SET P="|"
SET R="~"
+4 SET RETVAL="^AMHTMP("_$JOB_")"
+5 SET AMHI=0
+6 KILL ^AMHTMP($JOB)
+7 SET @RETVAL@(AMHI)="T00010BMXIEN^T00030SortDate^T00030DateEstablished^T00040Patient^T00010Chart^T00001Sex^T00030DOB^T00030Program^T00030Status^T00080Problem^T00030Provider^T00030ReviewDate^T00010Reviews^T00001Spt^T02500Message"_$CHAR(30)
+8 SET AMHB=$PIECE(AMHSTR,P)
+9 SET AMHE=$PIECE(AMHSTR,P,2)
+10 SET AMHP=$PIECE(AMHSTR,P,3)
+11 SET AMHIVB=(9999999-AMHB)+.0001
+12 SET AMHIVE=(9999999-AMHE)-.9999
+13 SET AMHDA=AMHIVE
FOR
SET AMHDA=$ORDER(^AMHPTXP("AB",AMHDA))
IF 'AMHDA!(AMHDA>AMHIVB)
QUIT
Begin DoDot:1
+14 SET AMHIEN=0
FOR
SET AMHIEN=$ORDER(^AMHPTXP("AB",AMHDA,AMHIEN))
IF 'AMHIEN
QUIT
Begin DoDot:2
+15 NEW AMHDE,AMHPRG,AMHST,AMHPRB,AMHPRV,AMHRD,AMHPIEN,AMHPAT,AMHDOB,AMHSEX,AMHCHT
+16 NEW AMHPRVM,AMHSPT,AMHMSG
+17 SET AMHPRVM=0
+18 ;screen on user and treatment plan
IF '$$ALLOWTP^AMHLETP(DUZ,AMHIEN)
QUIT
+19 SET AMHPIEN=$$GET1^DIQ(9002011.56,AMHIEN,.02,"I")
+20 IF 'AMHPIEN
QUIT
+21 SET AMHPAT=$$GET1^DIQ(2,AMHPIEN,.01)
+22 SET AMHCHT=$$HRN^AUPNPAT(AMHPIEN,DUZ(2))
+23 SET AMHDOB=$$GET1^DIQ(2,AMHPIEN,.03,"I")
+24 SET AMHDOB=$$LVDT^AMHGU(AMHDOB)
+25 SET AMHSEX=$$GET1^DIQ(2,AMHPIEN,.02,"I")
+26 SET AMHDE=$$GET1^DIQ(9002011.56,AMHIEN,.01,"I")
+27 SET AMHPRG=$$GET1^DIQ(9002011.56,AMHIEN,.17)
+28 SET AMHST=$$GET1^DIQ(9002011.56,AMHIEN,.15)
+29 SET AMHPRB=$$GET1^DIQ(9002011.56,AMHIEN,1101)
+30 ;v4.0p4 display the dx if no problem
IF AMHPRB=""
SET AMHPRB=$GET(^AMHPTXP(AMHIEN,21,1,0))
+31 SET AMHPRV=$$GET1^DIQ(9002011.56,AMHIEN,.04)
+32 SET AMHRD=$$GET1^DIQ(9002011.56,AMHIEN,.09,"I")
+33 SET AMHRCNT=+$PIECE($GET(^AMHPTXP(AMHIEN,41,0)),U,4)
+34 SET AMHSPT=$$SPT^AMHGDA(AMHPIEN)
+35 IF $GET(AMHSPT)
Begin DoDot:3
+36 SET AMHDOB="**SENSITIVE**"
+37 SET AMHMSG=$GET(AMHDGMSG)
End DoDot:3
+38 SET AMHI=AMHI+1
+39 SET @RETVAL@(AMHI)=AMHIEN_U_AMHDE_U_$$LVDT^AMHGU(AMHDE)_U_AMHPIEN_R_AMHPAT_U_AMHCHT_U_AMHSEX_U_AMHDOB_U_AMHPRG_U_AMHST_U_AMHPRB_U_AMHPRV_U_$$LVDT^AMHGU(AMHRD)_U_AMHRCNT_U_+$GET(AMHSPT)_U_$GET(AMHMSG)_$CHAR(30)
End DoDot:2
End DoDot:1
+40 SET @RETVAL@(AMHI+1)=$CHAR(31)
+41 QUIT
+42 ;
SFL(RETVAL,AMHSTR) ;-- get suicide forms for record selector screen
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,AMHP,AMHE,AMHB,P,AMHIVB,AMHIVE,AMHDA,AMHIEN
+3 SET P="|"
SET R="~"
+4 SET RETVAL="^AMHTMP("_$JOB_")"
+5 SET AMHI=0
+6 KILL ^AMHTMP($JOB)
+7 SET @RETVAL@(AMHI)="T00010BMXIEN^T00030SortDate^T00030Date^T00030LocalCaseNumber^T00030Provider^T00080SuicidalBehavior^T00001Incomplete"_$CHAR(30)
+8 SET AMHB=$PIECE(AMHSTR,P)
+9 SET AMHE=$PIECE(AMHSTR,P,2)
+10 SET AMHP=$PIECE(AMHSTR,P,3)
+11 SET AMHIVB=(9999999-AMHB)+.0001
+12 SET AMHIVE=(9999999-AMHE)-.9999
+13 SET AMHDA=AMHIVE
FOR
SET AMHDA=$ORDER(^AMHPSUIC("AA",AMHP,AMHDA))
IF 'AMHDA!(AMHDA>AMHIVB)
QUIT
Begin DoDot:1
+14 SET AMHIEN=0
FOR
SET AMHIEN=$ORDER(^AMHPSUIC("AA",AMHP,AMHDA,AMHIEN))
IF 'AMHIEN
QUIT
Begin DoDot:2
+15 NEW AMHPRVM
+16 SET AMHPRVM=0
+17 ;screen on user and suicide form
IF '$$ALLOW^AMHSFR(DUZ,AMHIEN)
QUIT
+18 NEW AMHD,AMHLCN,AMHPRV,AMHSB,AMHINC
+19 ;v4.0 p1
SET AMHINC=$SELECT($$INCOMPSF^AMHLESF(AMHIEN):"I",1:"")
+20 SET AMHD=$$GET1^DIQ(9002011.65,AMHIEN,.06,"I")
+21 SET AMHLCN=$$GET1^DIQ(9002011.65,AMHIEN,.02)
+22 SET AMHPRV=$$GET1^DIQ(9002011.65,AMHIEN,.03)
+23 SET AMHSB=$$GET1^DIQ(9002011.65,AMHIEN,.13)
+24 SET AMHI=AMHI+1
+25 SET @RETVAL@(AMHI)=AMHIEN_U_AMHD_U_$$LVDT^AMHGU(AMHD)_U_AMHLCN_U_AMHPRV_U_AMHSB_U_AMHINC_$CHAR(30)
End DoDot:2
End DoDot:1
+26 SET @RETVAL@(AMHI+1)=$CHAR(31)
+27 QUIT
+28 ;
SFLAP(RETVAL,AMHSTR) ;-- get suicide forms for record selector screen all patients
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,AMHP,AMHE,AMHB,P,AMHIVB,AMHIVE,AMHDA,AMHIEN
+3 SET P="|"
SET R="~"
+4 SET RETVAL="^AMHTMP("_$JOB_")"
+5 SET AMHI=0
+6 KILL ^AMHTMP($JOB)
+7 SET @RETVAL@(AMHI)="T00010BMXIEN^T00030SortDate^T00030Date^T00040Patient^T00010Chart^T00001Sex^T00030DOB^T00030LocalCaseNumber^T00030Provider^T00080SuicidalBehavior^T00001Spt^T02500Message^T00001Incomplete"_$CHAR(30)
+8 SET AMHB=$PIECE(AMHSTR,P)
+9 SET AMHE=$PIECE(AMHSTR,P,2)
+10 SET AMHP=$PIECE(AMHSTR,P,3)
+11 SET AMHIVB=(9999999-AMHB)+.0001
+12 SET AMHIVE=(9999999-AMHE)-.9999
+13 SET AMHDA=AMHIVE
FOR
SET AMHDA=$ORDER(^AMHPSUIC("AB",AMHDA))
IF 'AMHDA!(AMHDA>AMHIVB)
QUIT
Begin DoDot:1
+14 SET AMHIEN=0
FOR
SET AMHIEN=$ORDER(^AMHPSUIC("AB",AMHDA,AMHIEN))
IF 'AMHIEN
QUIT
Begin DoDot:2
+15 NEW AMHPRVM
+16 SET AMHPRVM=0
+17 ;screen on user and suicide form
IF '$$ALLOW^AMHSFR(DUZ,AMHIEN)
QUIT
+18 NEW AMHD,AMHLCN,AMHPRV,AMHSB,AMHPIEN,AMHPAT,AMHSPT,AMHMSG,AMHCHT,AMHSEX,AMHINC
+19 SET AMHPIEN=$$GET1^DIQ(9002011.65,AMHIEN,.04,"I")
+20 IF 'AMHPIEN
QUIT
+21 ;v4.0 p1
SET AMHINC=$SELECT($$INCOMPSF^AMHLESF(AMHIEN):"I",1:"")
+22 SET AMHPAT=$$GET1^DIQ(2,AMHPIEN,.01)
+23 SET AMHCHT=$$HRN^AUPNPAT(AMHPIEN,DUZ(2))
+24 SET AMHDOB=$$GET1^DIQ(2,AMHPIEN,.03,"I")
+25 SET AMHDOB=$$LVDT^AMHGU(AMHDOB)
+26 SET AMHSEX=$$GET1^DIQ(2,AMHPIEN,.02,"I")
+27 SET AMHD=$$GET1^DIQ(9002011.65,AMHIEN,.06,"I")
+28 SET AMHLCN=$$GET1^DIQ(9002011.65,AMHIEN,.02)
+29 SET AMHPRV=$$GET1^DIQ(9002011.65,AMHIEN,.03)
+30 SET AMHSB=$$GET1^DIQ(9002011.65,AMHIEN,.13)
+31 SET AMHSPT=$$SPT^AMHGDA(AMHPIEN)
+32 IF $GET(AMHSPT)
Begin DoDot:3
+33 SET AMHDOB="**SENSITIVE**"
+34 SET AMHMSG=$GET(AMHDGMSG)
End DoDot:3
+35 SET AMHI=AMHI+1
+36 SET @RETVAL@(AMHI)=AMHIEN_U_AMHD_U_$$LVDT^AMHGU(AMHD)_U_AMHPIEN_R_AMHPAT_U_AMHCHT_U_AMHSEX_U_AMHDOB_U_AMHLCN_U_AMHPRV_U_AMHSB_U_+$GET(AMHSPT)_U_$GET(AMHMSG)_U_AMHINC_$CHAR(30)
End DoDot:2
End DoDot:1
+37 SET @RETVAL@(AMHI+1)=$CHAR(31)
+38 QUIT
+39 ;
