BDMGT ; IHS/CMI/LAB - BDM DMS GUI Table Lookup ; 16 Apr 2010 8:30 AM
;;2.0;BDM DIABETES MANAGEMENT SYSTEM;**1,2,3,4,8**;JUN 14, 2007;Build 53
;
;
DEBUG(BDMRET,BDMSTR) ;-- debug entry point for Serenji
D DEBUG^%Serenji("ICD^BDMGT(.BDMRET,.BDMSTR)")
Q
;
DEBUGR(BDMRET) ;-- single entry point debugger
D DEBUG^%Serenji("ICD^BDMGT(.BDMRET)")
Q
;
LOCA(BDMRET) ;-- get all locations
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMLOC,BDMI,BDMERR,BDMLOCE,BDMASU,BDMIEN
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S BDMI=0
S BDMERR=""
S ^BDMTMP($J,BDMI)="T00060LOCATIONS"_$C(30)
S BDMLOC=0 F S BDMLOC=$O(^AUTTLOC("C",BDMLOC)) Q:BDMLOC="" D
. S BDMIEN=0 F S BDMIEN=$O(^AUTTLOC("C",BDMLOC,BDMIEN)) Q:'BDMIEN D
.. S BDMI=BDMI+1
.. S BDMASU=BDMLOC
.. S BDMLOCE=$P($G(^DIC(4,BDMIEN,0)),U)
.. S ^BDMTMP($J,BDMI)=BDMASU_"-"_BDMLOCE_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)
Q
;
USRA(BDMRET) ;-- get all Users
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMUSR,BDMI,BDMERR
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S BDMI=0
S BDMERR=""
S ^BDMTMP($J,BDMI)="T00060USER"_$C(30)
S BDMUSR=0 F S BDMUSR=$O(^VA(200,"B",BDMUSR)) Q:BDMUSR="" D
. S BDMI=BDMI+1
. S ^BDMTMP($J,BDMI)=BDMUSR_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)
Q
;
GETKEYS(BDMRET,BDMSTR) ;-- return keys by DUZ
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMDA,BDMNS,P,BDMDATA,BDMKEYI,BDMKEY,BDMI
S BDMI=0
S P="|"
S BDMNS=$P(BDMSTR,P)
S BDMDA=0 F S BDMDA=$O(^VA(200,DUZ,51,BDMDA)) Q:'BDMDA D
. S BDMDATA=$G(^VA(200,DUZ,51,BDMDA,0))
. S BDMKEYI=$P(BDMDATA,U)
. S BDMKEY=$P($G(^DIC(19.1,BDMKEYI,0)),U)
. I BDMNS'="*" Q:$E(BDMKEY,1,4)'[BDMNS
. S BDMI=BDMI+1
. S $P(BDMRET,"|",BDMI)=BDMKEY
S BDMRET=BDMI_"|"_BDMRET
Q
;
CMP(BDMRET,BDMSTR) ;-- return complications
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMCMP,BDMI,BDMERR,BDMREGE,BDMREG,BDMIEN,BDMCMPE
S BDMREGE=$P(BDMSTR,"|")
S BDMREG=$O(^ACM(41.1,"B",BDMREGE,0))
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S BDMI=0
S BDMERR=""
S ^BDMTMP($J,BDMI)="T00060COMPLICATION"_$C(30)
S BDMCMP=0 F S BDMCMP=$O(^ACM(42.1,"RG",BDMREG,BDMCMP)) Q:BDMCMP="" D
. ;S BDMIEN=$O(^ACM(42.1,"RG",BDMREG,BDMCMP,0))
. S BDMCMPE=$P($G(^ACM(42.1,BDMCMP,0)),U)
. S BDMI=BDMI+1
. S ^BDMTMP($J,BDMI)=BDMCMPE_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)
Q
;
CMPDX(BDMRET,BDMSTR) ;-- return complications diagnosis
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMCMP,BDMI,BDMERR,BDMREGE,BDMREG,BDMIEN,BDMCMPE,P,BDMCMP
S P="|"
S BDMREG=$P(BDMSTR,P)
S BDMCMPE=$P(BDMSTR,P,2)
S BDMCMP=$O(^ACM(42.1,"B",BDMCMPE,0))
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S BDMI=0
S BDMERR=""
S ^BDMTMP($J,BDMI)="T00007BMXIEN^T00060DIAGNOSIS"_$C(30)
N BDMDX
S BDMDX=0 F S BDMDX=$O(^ACM(42.1,BDMCMP,11,BDMDX)) Q:'BDMDX D
. N BDMDXI,BDMDXE
. S BDMDXI=$P($G(^ACM(42.1,BDMCMP,11,BDMDX,0)),U)
. S BDMDXE=$P($G(^ICD9(BDMDXI,0)),U)
. S BDMI=BDMI+1
. S ^BDMTMP($J,BDMI)=BDMDXI_U_BDMDXE_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)
Q
;
ST(BDMRET,BDMSTR) ;-- return complications status
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMST,BDMI,BDMERR
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S BDMI=0
S BDMERR=""
S ^BDMTMP($J,BDMI)="T00060STATUS"_$C(30)
S BDMST=0 F S BDMST=$O(^ACM(42.3,"B",BDMST)) Q:BDMST="" D
. S BDMI=BDMI+1
. S ^BDMTMP($J,BDMI)=BDMST_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)
Q
;
HS(BDMRET) ;-- get all health summary types
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMHS,BDMI,BDMERR,BDMHSE
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S BDMI=0
S BDMERR=""
S ^BDMTMP($J,BDMI)="T00060HEALTHSUMMARY"_$C(30)
S BDMHS=0 F S BDMHS=$O(^APCHSCTL("B",BDMHS)) Q:BDMHS="" D
. S BDMI=BDMI+1
. S ^BDMTMP($J,BDMI)=BDMHS_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)
Q
;
FLOW(BDMRET) ;-- get all flow sheet types
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMHS,BDMI,BDMERR,BDMHSE
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S BDMI=0
S BDMERR=""
S ^BDMTMP($J,BDMI)="T00060FLOWSHEET"_$C(30)
S BDMHS=0 F S BDMHS=$O(^APCHSFLC("B",BDMHS)) Q:BDMHS="" D
. S BDMI=BDMI+1
. S ^BDMTMP($J,BDMI)=BDMHS_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)
Q
;
LET(BDMRET) ;-- get all letter types
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMHS,BDMI,BDMERR,BDMHSE
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S BDMI=0
S BDMERR=""
S ^BDMTMP($J,BDMI)="T00007BMXIEN^T00060Letters^T00050Letter Directory^T00030Letter File"_$C(30)
S BDMHS=0 F S BDMHS=$O(^BDMLET("B",BDMHS)) Q:BDMHS="" D
. N BDMIEN
. S BDMIEN=0 F S BDMIEN=$O(^BDMLET("B",BDMHS,BDMIEN)) Q:'BDMIEN D
.. N BDMDIR,BDMFN,BDMDATA
.. S BDMI=BDMI+1
.. S BDMDATA=$G(^BDMLET(BDMIEN,0))
.. S BDMDIR=$P(BDMDATA,U,4)
.. S BDMFN=$P(BDMDATA,U,5)
.. Q:BDMFN="" ;don't display letters without a word document
.. S ^BDMTMP($J,BDMI)=BDMIEN_U_BDMHS_U_BDMDIR_U_BDMFN_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)
Q
;
EDU(BDMRET) ;-- get all education topics
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMEDU,BDMI,BDMERR,BDMIEN
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S BDMI=0
S BDMERR=""
S ^BDMTMP($J,BDMI)="T00050EDUCATIONTOPICS"_$C(30)
S BDMEDU=0 F S BDMEDU=$O(^AUTTEDT("B",BDMEDU)) Q:BDMEDU="" D
. S BDMIEN=0 F S BDMIEN=$O(^AUTTEDT("B",BDMEDU,BDMIEN)) Q:'BDMIEN D
.. Q:$P($G(^AUTTEDT(BDMIEN,0)),U,3) ;inactive
.. S BDMI=BDMI+1
.. S ^BDMTMP($J,BDMI)=BDMEDU_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)
Q
;
DEDU(BDMRET) ;-- get all diabetes education topics
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMEDU,BDMI,BDMERR,BDMIEN
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S BDMI=0
S BDMERR=""
S ^BDMTMP($J,BDMI)="T00050EDUCATIONTOPICS"_$C(30)
S BDMEDU=0 F S BDMEDU=$O(^AUTTEDT("B",BDMEDU)) Q:BDMEDU="" D
. S BDMIEN=0 F S BDMIEN=$O(^AUTTEDT("B",BDMEDU,BDMIEN)) Q:'BDMIEN D
.. Q:$P($G(^AUTTEDT(BDMIEN,0)),U,3) ;inactive
.. ;Q:$E($P($G(^AUTTEDT(BDMIEN,0)),U),1,2)'="DM"
.. S BDMI=BDMI+1
.. S ^BDMTMP($J,BDMI)=BDMEDU_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)
Q
;
ICD(BDMRET) ;-- get all POV's
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMPOV,BDMI,BDMERR,BDMPOVE,BDMPOVD,BDMPIEN
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S BDMI=0
S BDMERR=""
S ^BDMTMP($J,BDMI)="T00100POVS"_$C(30)
S BDMPOV="" F S BDMPOV=$O(^ICD9("AB",BDMPOV)) Q:BDMPOV="" D
. S BDMPIEN=0 F S BDMPIEN=$O(^ICD9("AB",BDMPOV,BDMPIEN)) Q:'BDMPIEN D
.. Q:$E(BDMPOV,1,1)="["
.. Q:BDMPOV="delete"
.. S BDMPOVE=$P($G(^ICD9(BDMPIEN,0)),U)
.. Q:$P($G(^ICD9(BDMPIEN,0)),U,9) ;inactive
.. S BDMI=BDMI+1
.. S BDMPOVD=$P($G(^ICD9(BDMPIEN,0)),U,3)
.. S ^BDMTMP($J,BDMI)=BDMPOVE_"-"_BDMPOVD_$C(30)
.. ;S ^BDMTMP($J,BDMI)=BDMPOVE_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)
Q
;
LAB(BDMRET) ;-- get all lab tests
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMLAB,BDMI,BDMERR
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S BDMI=0
S BDMERR=""
S ^BDMTMP($J,BDMI)="T00080LAB"_$C(30) ;^T00001Panel"_$C(30)
S BDMLAB=0 F S BDMLAB=$O(^LAB(60,"B",BDMLAB)) Q:BDMLAB="" D
. N BDMIEN,BDMPAN
. S BDMPAN=""
. S BDMIEN=0 F S BDMIEN=$O(^LAB(60,"B",BDMLAB,BDMIEN)) Q:'BDMIEN D
.. Q:$G(^LAB(60,"B",BDMLAB,BDMIEN))
.. I $O(^LAB(60,BDMIEN,2,0)) S BDMPAN=1
.. S BDMI=BDMI+1
.. S ^BDMTMP($J,BDMI)=BDMLAB_$C(30) ;_U_BDMPAN_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)
Q
;
HF(BDMRET) ;-- health factors table
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMHF,BDMI,BDMERR,BDMDA,BDMTB,BDMIEN
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S BDMI=0
S BDMERR=""
S ^BDMTMP($J,BDMI)="T00080HF"_$C(30)
S BDMDA=0 F S BDMDA=$O(^AUTTHF("B",BDMDA)) Q:BDMDA="" D
. S BDMIEN=0 F S BDMIEN=$O(^AUTTHF("B",BDMDA,BDMIEN)) Q:'BDMIEN D
.. Q:$P($G(^AUTTHF(BDMIEN,0)),U,13)
.. Q:$P($G(^AUTTHF(BDMIEN,0)),U,10)'="F"
.. S BDMHF=$P($G(^AUTTHF(BDMIEN,0)),U)
.. S BDMI=BDMI+1
.. S ^BDMTMP($J,BDMI)=BDMHF_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)
Q
;
TB(BDMRET) ;-- tb health factors table
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMHF,BDMI,BDMERR,BDMPIEN,BDMDA,BDMTB
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S BDMI=0
S BDMERR=""
S ^BDMTMP($J,BDMI)="T00080HF"_$C(30)
S BDMTB=$O(^AUTTHF("B","TB STATUS",0))
S BDMDA=0 F S BDMDA=$O(^AUTTHF("AC",BDMDA)) Q:BDMDA="" D
. S BDMPIEN=0 F S BDMPIEN=$O(^AUTTHF("AC",BDMDA,BDMPIEN)) Q:'BDMPIEN D
.. Q:$P($G(^AUTTHF(BDMPIEN,0)),U,13)
.. Q:$P($G(^AUTTHF(BDMPIEN,0)),U,3)'=BDMTB
.. Q:$P($G(^AUTTHF(BDMPIEN,0)),U,10)'="F"
.. S BDMHF=$P($G(^AUTTHF(BDMPIEN,0)),U)
.. S BDMI=BDMI+1
.. S ^BDMTMP($J,BDMI)=BDMHF_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)
Q
;
TU(BDMRET) ;-- tobacco use health factors table
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMHF,BDMI,BDMERR,BDMPIEN,BDMDA,BDMTU,BDMTOB
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S BDMI=0
S BDMERR=""
S ^BDMTMP($J,BDMI)="T00080HF"_$C(30)
N TDA,TIEN
S TDA=0 F S TDA=$O(^AUTTHF("B",TDA)) Q:TDA="" D
. Q:$E(TDA,1,7)'="TOBACCO"
. S TIEN=0 F S TIEN=$O(^AUTTHF("B",TDA,TIEN)) Q:'TIEN D
.. S BDMTOB(TIEN)=""
S BDMDA=0 F S BDMDA=$O(^AUTTHF("AC",BDMDA)) Q:BDMDA="" D
. S BDMPIEN=0 F S BDMPIEN=$O(^AUTTHF("AC",BDMDA,BDMPIEN)) Q:'BDMPIEN D
.. Q:$P($G(^AUTTHF(BDMPIEN,0)),U,13)
.. S BDMTU=$P($G(^AUTTHF(BDMPIEN,0)),U,3)
.. Q:'$D(BDMTOB(BDMTU))
.. Q:$P($G(^AUTTHF(BDMPIEN,0)),U,10)'="F"
.. S BDMHF=$P($G(^AUTTHF(BDMPIEN,0)),U)
.. S BDMI=BDMI+1
.. S ^BDMTMP($J,BDMI)=BDMHF_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)
Q
;
GLU(BDMRET) ;-- glucose health factors table
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMHF,BDMI,BDMERR,BDMPIEN,BDMDA,BDMGLU
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S BDMI=0
S BDMERR=""
S ^BDMTMP($J,BDMI)="T00080HF"_$C(30)
S BDMGLU=$O(^AUTTHF("B","DIABETES SELF MONITORING",0))
S BDMDA=0 F S BDMDA=$O(^AUTTHF("AC",BDMDA)) Q:BDMDA="" D
. S BDMPIEN=0 F S BDMPIEN=$O(^AUTTHF("AC",BDMDA,BDMPIEN)) Q:'BDMPIEN D
.. Q:$P($G(^AUTTHF(BDMPIEN,0)),U,13)
.. Q:$P($G(^AUTTHF(BDMPIEN,0)),U,3)'=BDMGLU
.. Q:$P($G(^AUTTHF(BDMPIEN,0)),U,10)'="F"
.. S BDMHF=$P($G(^AUTTHF(BDMPIEN,0)),U)
.. S BDMI=BDMI+1
.. S ^BDMTMP($J,BDMI)=BDMHF_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)
Q
;
BAR(BDMRET) ;-- barriers health factors table
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMHF,BDMI,BDMERR,BDMPIEN,BDMDA,BDMBAR
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S BDMI=0
S BDMERR=""
S ^BDMTMP($J,BDMI)="T00080HF"_$C(30)
S BDMBAR=$O(^AUTTHF("B","BARRIERS TO LEARNING",0))
S BDMDA=0 F S BDMDA=$O(^AUTTHF("AC",BDMDA)) Q:BDMDA="" D
. S BDMPIEN=0 F S BDMPIEN=$O(^AUTTHF("AC",BDMDA,BDMPIEN)) Q:'BDMPIEN D
.. Q:$P($G(^AUTTHF(BDMPIEN,0)),U,13)
.. Q:$P($G(^AUTTHF(BDMPIEN,0)),U,3)'=BDMBAR
.. Q:$P($G(^AUTTHF(BDMPIEN,0)),U,10)'="F"
.. S BDMHF=$P($G(^AUTTHF(BDMPIEN,0)),U)
.. S BDMI=BDMI+1
.. S ^BDMTMP($J,BDMI)=BDMHF_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)
Q
;
READ(BDMRET) ;-- readiness use health factors table
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMHF,BDMI,BDMERR,BDMPIEN,BDMDA,BDMR
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S BDMI=0
S BDMERR=""
S ^BDMTMP($J,BDMI)="T00080HF"_$C(30)
S BDMR=$O(^AUTTHF("B","READINESS TO LEARN",0))
S BDMDA=0 F S BDMDA=$O(^AUTTHF("AC",BDMDA)) Q:BDMDA="" D
. S BDMPIEN=0 F S BDMPIEN=$O(^AUTTHF("AC",BDMDA,BDMPIEN)) Q:'BDMPIEN D
.. Q:$P($G(^AUTTHF(BDMPIEN,0)),U,13)
.. Q:$P($G(^AUTTHF(BDMPIEN,0)),U,3)'=BDMR
.. Q:$P($G(^AUTTHF(BDMPIEN,0)),U,10)'="F"
.. S BDMHF=$P($G(^AUTTHF(BDMPIEN,0)),U)
.. S BDMI=BDMI+1
.. S ^BDMTMP($J,BDMI)=BDMHF_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)
Q
;
LRN(BDMRET) ;-- learning health factors table
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMHF,BDMI,BDMERR,BDMPIEN,BDMDA,BDML
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S BDMI=0
S BDMERR=""
S ^BDMTMP($J,BDMI)="T00080HF"_$C(30)
S BDML=$O(^AUTTHF("B","LEARNING PREFERENCE",0))
S BDMDA=0 F S BDMDA=$O(^AUTTHF("AC",BDMDA)) Q:BDMDA="" D
. S BDMPIEN=0 F S BDMPIEN=$O(^AUTTHF("AC",BDMDA,BDMPIEN)) Q:'BDMPIEN D
.. Q:$P($G(^AUTTHF(BDMPIEN,0)),U,13)
.. Q:$P($G(^AUTTHF(BDMPIEN,0)),U,3)'=BDML
.. Q:$P($G(^AUTTHF(BDMPIEN,0)),U,10)'="F"
.. S BDMHF=$P($G(^AUTTHF(BDMPIEN,0)),U)
.. S BDMI=BDMI+1
.. S ^BDMTMP($J,BDMI)=BDMHF_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)
Q
;
MED(BDMRET) ;-- get all drugs
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMMED,BDMI,BDMERR,BDMIEN
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S BDMI=0
S BDMERR=""
S ^BDMTMP($J,BDMI)="T00080MED"_$C(30)
S BDMMED=0 F S BDMMED=$O(^PSDRUG("B",BDMMED)) Q:BDMMED="" D
. S BDMIEN=0 F S BDMIEN=$O(^PSDRUG("B",BDMMED,BDMIEN)) Q:'BDMIEN D
.. ;Q:$G(^PSDRUG(BDMIEN,"I"))
.. S BDMI=BDMI+1
.. S ^BDMTMP($J,BDMI)=BDMMED_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)
Q
;
BDMGT ; IHS/CMI/LAB - BDM DMS GUI Table Lookup ; 16 Apr 2010 8:30 AM
+1 ;;2.0;BDM DIABETES MANAGEMENT SYSTEM;**1,2,3,4,8**;JUN 14, 2007;Build 53
+2 ;
+3 ;
DEBUG(BDMRET,BDMSTR) ;-- debug entry point for Serenji
+1 DO DEBUG^%Serenji("ICD^BDMGT(.BDMRET,.BDMSTR)")
+2 QUIT
+3 ;
DEBUGR(BDMRET) ;-- single entry point debugger
+1 DO DEBUG^%Serenji("ICD^BDMGT(.BDMRET)")
+2 QUIT
+3 ;
LOCA(BDMRET) ;-- get all locations
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMLOC,BDMI,BDMERR,BDMLOCE,BDMASU,BDMIEN
+3 KILL ^BDMTMP($JOB)
+4 SET BDMRET="^BDMTMP("_$JOB_")"
+5 SET BDMI=0
+6 SET BDMERR=""
+7 SET ^BDMTMP($JOB,BDMI)="T00060LOCATIONS"_$CHAR(30)
+8 SET BDMLOC=0
FOR
SET BDMLOC=$ORDER(^AUTTLOC("C",BDMLOC))
IF BDMLOC=""
QUIT
Begin DoDot:1
+9 SET BDMIEN=0
FOR
SET BDMIEN=$ORDER(^AUTTLOC("C",BDMLOC,BDMIEN))
IF 'BDMIEN
QUIT
Begin DoDot:2
+10 SET BDMI=BDMI+1
+11 SET BDMASU=BDMLOC
+12 SET BDMLOCE=$PIECE($GET(^DIC(4,BDMIEN,0)),U)
+13 SET ^BDMTMP($JOB,BDMI)=BDMASU_"-"_BDMLOCE_$CHAR(30)
End DoDot:2
End DoDot:1
+14 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)
+15 QUIT
+16 ;
USRA(BDMRET) ;-- get all Users
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMUSR,BDMI,BDMERR
+3 KILL ^BDMTMP($JOB)
+4 SET BDMRET="^BDMTMP("_$JOB_")"
+5 SET BDMI=0
+6 SET BDMERR=""
+7 SET ^BDMTMP($JOB,BDMI)="T00060USER"_$CHAR(30)
+8 SET BDMUSR=0
FOR
SET BDMUSR=$ORDER(^VA(200,"B",BDMUSR))
IF BDMUSR=""
QUIT
Begin DoDot:1
+9 SET BDMI=BDMI+1
+10 SET ^BDMTMP($JOB,BDMI)=BDMUSR_$CHAR(30)
End DoDot:1
+11 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)
+12 QUIT
+13 ;
GETKEYS(BDMRET,BDMSTR) ;-- return keys by DUZ
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMDA,BDMNS,P,BDMDATA,BDMKEYI,BDMKEY,BDMI
+3 SET BDMI=0
+4 SET P="|"
+5 SET BDMNS=$PIECE(BDMSTR,P)
+6 SET BDMDA=0
FOR
SET BDMDA=$ORDER(^VA(200,DUZ,51,BDMDA))
IF 'BDMDA
QUIT
Begin DoDot:1
+7 SET BDMDATA=$GET(^VA(200,DUZ,51,BDMDA,0))
+8 SET BDMKEYI=$PIECE(BDMDATA,U)
+9 SET BDMKEY=$PIECE($GET(^DIC(19.1,BDMKEYI,0)),U)
+10 IF BDMNS'="*"
IF $EXTRACT(BDMKEY,1,4)'[BDMNS
QUIT
+11 SET BDMI=BDMI+1
+12 SET $PIECE(BDMRET,"|",BDMI)=BDMKEY
End DoDot:1
+13 SET BDMRET=BDMI_"|"_BDMRET
+14 QUIT
+15 ;
CMP(BDMRET,BDMSTR) ;-- return complications
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMCMP,BDMI,BDMERR,BDMREGE,BDMREG,BDMIEN,BDMCMPE
+3 SET BDMREGE=$PIECE(BDMSTR,"|")
+4 SET BDMREG=$ORDER(^ACM(41.1,"B",BDMREGE,0))
+5 KILL ^BDMTMP($JOB)
+6 SET BDMRET="^BDMTMP("_$JOB_")"
+7 SET BDMI=0
+8 SET BDMERR=""
+9 SET ^BDMTMP($JOB,BDMI)="T00060COMPLICATION"_$CHAR(30)
+10 SET BDMCMP=0
FOR
SET BDMCMP=$ORDER(^ACM(42.1,"RG",BDMREG,BDMCMP))
IF BDMCMP=""
QUIT
Begin DoDot:1
+11 ;S BDMIEN=$O(^ACM(42.1,"RG",BDMREG,BDMCMP,0))
+12 SET BDMCMPE=$PIECE($GET(^ACM(42.1,BDMCMP,0)),U)
+13 SET BDMI=BDMI+1
+14 SET ^BDMTMP($JOB,BDMI)=BDMCMPE_$CHAR(30)
End DoDot:1
+15 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)
+16 QUIT
+17 ;
CMPDX(BDMRET,BDMSTR) ;-- return complications diagnosis
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMCMP,BDMI,BDMERR,BDMREGE,BDMREG,BDMIEN,BDMCMPE,P,BDMCMP
+3 SET P="|"
+4 SET BDMREG=$PIECE(BDMSTR,P)
+5 SET BDMCMPE=$PIECE(BDMSTR,P,2)
+6 SET BDMCMP=$ORDER(^ACM(42.1,"B",BDMCMPE,0))
+7 KILL ^BDMTMP($JOB)
+8 SET BDMRET="^BDMTMP("_$JOB_")"
+9 SET BDMI=0
+10 SET BDMERR=""
+11 SET ^BDMTMP($JOB,BDMI)="T00007BMXIEN^T00060DIAGNOSIS"_$CHAR(30)
+12 NEW BDMDX
+13 SET BDMDX=0
FOR
SET BDMDX=$ORDER(^ACM(42.1,BDMCMP,11,BDMDX))
IF 'BDMDX
QUIT
Begin DoDot:1
+14 NEW BDMDXI,BDMDXE
+15 SET BDMDXI=$PIECE($GET(^ACM(42.1,BDMCMP,11,BDMDX,0)),U)
+16 SET BDMDXE=$PIECE($GET(^ICD9(BDMDXI,0)),U)
+17 SET BDMI=BDMI+1
+18 SET ^BDMTMP($JOB,BDMI)=BDMDXI_U_BDMDXE_$CHAR(30)
End DoDot:1
+19 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)
+20 QUIT
+21 ;
ST(BDMRET,BDMSTR) ;-- return complications status
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMST,BDMI,BDMERR
+3 KILL ^BDMTMP($JOB)
+4 SET BDMRET="^BDMTMP("_$JOB_")"
+5 SET BDMI=0
+6 SET BDMERR=""
+7 SET ^BDMTMP($JOB,BDMI)="T00060STATUS"_$CHAR(30)
+8 SET BDMST=0
FOR
SET BDMST=$ORDER(^ACM(42.3,"B",BDMST))
IF BDMST=""
QUIT
Begin DoDot:1
+9 SET BDMI=BDMI+1
+10 SET ^BDMTMP($JOB,BDMI)=BDMST_$CHAR(30)
End DoDot:1
+11 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)
+12 QUIT
+13 ;
HS(BDMRET) ;-- get all health summary types
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMHS,BDMI,BDMERR,BDMHSE
+3 KILL ^BDMTMP($JOB)
+4 SET BDMRET="^BDMTMP("_$JOB_")"
+5 SET BDMI=0
+6 SET BDMERR=""
+7 SET ^BDMTMP($JOB,BDMI)="T00060HEALTHSUMMARY"_$CHAR(30)
+8 SET BDMHS=0
FOR
SET BDMHS=$ORDER(^APCHSCTL("B",BDMHS))
IF BDMHS=""
QUIT
Begin DoDot:1
+9 SET BDMI=BDMI+1
+10 SET ^BDMTMP($JOB,BDMI)=BDMHS_$CHAR(30)
End DoDot:1
+11 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)
+12 QUIT
+13 ;
FLOW(BDMRET) ;-- get all flow sheet types
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMHS,BDMI,BDMERR,BDMHSE
+3 KILL ^BDMTMP($JOB)
+4 SET BDMRET="^BDMTMP("_$JOB_")"
+5 SET BDMI=0
+6 SET BDMERR=""
+7 SET ^BDMTMP($JOB,BDMI)="T00060FLOWSHEET"_$CHAR(30)
+8 SET BDMHS=0
FOR
SET BDMHS=$ORDER(^APCHSFLC("B",BDMHS))
IF BDMHS=""
QUIT
Begin DoDot:1
+9 SET BDMI=BDMI+1
+10 SET ^BDMTMP($JOB,BDMI)=BDMHS_$CHAR(30)
End DoDot:1
+11 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)
+12 QUIT
+13 ;
LET(BDMRET) ;-- get all letter types
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMHS,BDMI,BDMERR,BDMHSE
+3 KILL ^BDMTMP($JOB)
+4 SET BDMRET="^BDMTMP("_$JOB_")"
+5 SET BDMI=0
+6 SET BDMERR=""
+7 SET ^BDMTMP($JOB,BDMI)="T00007BMXIEN^T00060Letters^T00050Letter Directory^T00030Letter File"_$CHAR(30)
+8 SET BDMHS=0
FOR
SET BDMHS=$ORDER(^BDMLET("B",BDMHS))
IF BDMHS=""
QUIT
Begin DoDot:1
+9 NEW BDMIEN
+10 SET BDMIEN=0
FOR
SET BDMIEN=$ORDER(^BDMLET("B",BDMHS,BDMIEN))
IF 'BDMIEN
QUIT
Begin DoDot:2
+11 NEW BDMDIR,BDMFN,BDMDATA
+12 SET BDMI=BDMI+1
+13 SET BDMDATA=$GET(^BDMLET(BDMIEN,0))
+14 SET BDMDIR=$PIECE(BDMDATA,U,4)
+15 SET BDMFN=$PIECE(BDMDATA,U,5)
+16 ;don't display letters without a word document
IF BDMFN=""
QUIT
+17 SET ^BDMTMP($JOB,BDMI)=BDMIEN_U_BDMHS_U_BDMDIR_U_BDMFN_$CHAR(30)
End DoDot:2
End DoDot:1
+18 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)
+19 QUIT
+20 ;
EDU(BDMRET) ;-- get all education topics
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMEDU,BDMI,BDMERR,BDMIEN
+3 KILL ^BDMTMP($JOB)
+4 SET BDMRET="^BDMTMP("_$JOB_")"
+5 SET BDMI=0
+6 SET BDMERR=""
+7 SET ^BDMTMP($JOB,BDMI)="T00050EDUCATIONTOPICS"_$CHAR(30)
+8 SET BDMEDU=0
FOR
SET BDMEDU=$ORDER(^AUTTEDT("B",BDMEDU))
IF BDMEDU=""
QUIT
Begin DoDot:1
+9 SET BDMIEN=0
FOR
SET BDMIEN=$ORDER(^AUTTEDT("B",BDMEDU,BDMIEN))
IF 'BDMIEN
QUIT
Begin DoDot:2
+10 ;inactive
IF $PIECE($GET(^AUTTEDT(BDMIEN,0)),U,3)
QUIT
+11 SET BDMI=BDMI+1
+12 SET ^BDMTMP($JOB,BDMI)=BDMEDU_$CHAR(30)
End DoDot:2
End DoDot:1
+13 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)
+14 QUIT
+15 ;
DEDU(BDMRET) ;-- get all diabetes education topics
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMEDU,BDMI,BDMERR,BDMIEN
+3 KILL ^BDMTMP($JOB)
+4 SET BDMRET="^BDMTMP("_$JOB_")"
+5 SET BDMI=0
+6 SET BDMERR=""
+7 SET ^BDMTMP($JOB,BDMI)="T00050EDUCATIONTOPICS"_$CHAR(30)
+8 SET BDMEDU=0
FOR
SET BDMEDU=$ORDER(^AUTTEDT("B",BDMEDU))
IF BDMEDU=""
QUIT
Begin DoDot:1
+9 SET BDMIEN=0
FOR
SET BDMIEN=$ORDER(^AUTTEDT("B",BDMEDU,BDMIEN))
IF 'BDMIEN
QUIT
Begin DoDot:2
+10 ;inactive
IF $PIECE($GET(^AUTTEDT(BDMIEN,0)),U,3)
QUIT
+11 ;Q:$E($P($G(^AUTTEDT(BDMIEN,0)),U),1,2)'="DM"
+12 SET BDMI=BDMI+1
+13 SET ^BDMTMP($JOB,BDMI)=BDMEDU_$CHAR(30)
End DoDot:2
End DoDot:1
+14 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)
+15 QUIT
+16 ;
ICD(BDMRET) ;-- get all POV's
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMPOV,BDMI,BDMERR,BDMPOVE,BDMPOVD,BDMPIEN
+3 KILL ^BDMTMP($JOB)
+4 SET BDMRET="^BDMTMP("_$JOB_")"
+5 SET BDMI=0
+6 SET BDMERR=""
+7 SET ^BDMTMP($JOB,BDMI)="T00100POVS"_$CHAR(30)
+8 SET BDMPOV=""
FOR
SET BDMPOV=$ORDER(^ICD9("AB",BDMPOV))
IF BDMPOV=""
QUIT
Begin DoDot:1
+9 SET BDMPIEN=0
FOR
SET BDMPIEN=$ORDER(^ICD9("AB",BDMPOV,BDMPIEN))
IF 'BDMPIEN
QUIT
Begin DoDot:2
+10 IF $EXTRACT(BDMPOV,1,1)="["
QUIT
+11 IF BDMPOV="delete"
QUIT
+12 SET BDMPOVE=$PIECE($GET(^ICD9(BDMPIEN,0)),U)
+13 ;inactive
IF $PIECE($GET(^ICD9(BDMPIEN,0)),U,9)
QUIT
+14 SET BDMI=BDMI+1
+15 SET BDMPOVD=$PIECE($GET(^ICD9(BDMPIEN,0)),U,3)
+16 SET ^BDMTMP($JOB,BDMI)=BDMPOVE_"-"_BDMPOVD_$CHAR(30)
+17 ;S ^BDMTMP($J,BDMI)=BDMPOVE_$C(30)
End DoDot:2
End DoDot:1
+18 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)
+19 QUIT
+20 ;
LAB(BDMRET) ;-- get all lab tests
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMLAB,BDMI,BDMERR
+3 KILL ^BDMTMP($JOB)
+4 SET BDMRET="^BDMTMP("_$JOB_")"
+5 SET BDMI=0
+6 SET BDMERR=""
+7 ;^T00001Panel"_$C(30)
SET ^BDMTMP($JOB,BDMI)="T00080LAB"_$CHAR(30)
+8 SET BDMLAB=0
FOR
SET BDMLAB=$ORDER(^LAB(60,"B",BDMLAB))
IF BDMLAB=""
QUIT
Begin DoDot:1
+9 NEW BDMIEN,BDMPAN
+10 SET BDMPAN=""
+11 SET BDMIEN=0
FOR
SET BDMIEN=$ORDER(^LAB(60,"B",BDMLAB,BDMIEN))
IF 'BDMIEN
QUIT
Begin DoDot:2
+12 IF $GET(^LAB(60,"B",BDMLAB,BDMIEN))
QUIT
+13 IF $ORDER(^LAB(60,BDMIEN,2,0))
SET BDMPAN=1
+14 SET BDMI=BDMI+1
+15 ;_U_BDMPAN_$C(30)
SET ^BDMTMP($JOB,BDMI)=BDMLAB_$CHAR(30)
End DoDot:2
End DoDot:1
+16 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)
+17 QUIT
+18 ;
HF(BDMRET) ;-- health factors table
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMHF,BDMI,BDMERR,BDMDA,BDMTB,BDMIEN
+3 KILL ^BDMTMP($JOB)
+4 SET BDMRET="^BDMTMP("_$JOB_")"
+5 SET BDMI=0
+6 SET BDMERR=""
+7 SET ^BDMTMP($JOB,BDMI)="T00080HF"_$CHAR(30)
+8 SET BDMDA=0
FOR
SET BDMDA=$ORDER(^AUTTHF("B",BDMDA))
IF BDMDA=""
QUIT
Begin DoDot:1
+9 SET BDMIEN=0
FOR
SET BDMIEN=$ORDER(^AUTTHF("B",BDMDA,BDMIEN))
IF 'BDMIEN
QUIT
Begin DoDot:2
+10 IF $PIECE($GET(^AUTTHF(BDMIEN,0)),U,13)
QUIT
+11 IF $PIECE($GET(^AUTTHF(BDMIEN,0)),U,10)'="F"
QUIT
+12 SET BDMHF=$PIECE($GET(^AUTTHF(BDMIEN,0)),U)
+13 SET BDMI=BDMI+1
+14 SET ^BDMTMP($JOB,BDMI)=BDMHF_$CHAR(30)
End DoDot:2
End DoDot:1
+15 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)
+16 QUIT
+17 ;
TB(BDMRET) ;-- tb health factors table
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMHF,BDMI,BDMERR,BDMPIEN,BDMDA,BDMTB
+3 KILL ^BDMTMP($JOB)
+4 SET BDMRET="^BDMTMP("_$JOB_")"
+5 SET BDMI=0
+6 SET BDMERR=""
+7 SET ^BDMTMP($JOB,BDMI)="T00080HF"_$CHAR(30)
+8 SET BDMTB=$ORDER(^AUTTHF("B","TB STATUS",0))
+9 SET BDMDA=0
FOR
SET BDMDA=$ORDER(^AUTTHF("AC",BDMDA))
IF BDMDA=""
QUIT
Begin DoDot:1
+10 SET BDMPIEN=0
FOR
SET BDMPIEN=$ORDER(^AUTTHF("AC",BDMDA,BDMPIEN))
IF 'BDMPIEN
QUIT
Begin DoDot:2
+11 IF $PIECE($GET(^AUTTHF(BDMPIEN,0)),U,13)
QUIT
+12 IF $PIECE($GET(^AUTTHF(BDMPIEN,0)),U,3)'=BDMTB
QUIT
+13 IF $PIECE($GET(^AUTTHF(BDMPIEN,0)),U,10)'="F"
QUIT
+14 SET BDMHF=$PIECE($GET(^AUTTHF(BDMPIEN,0)),U)
+15 SET BDMI=BDMI+1
+16 SET ^BDMTMP($JOB,BDMI)=BDMHF_$CHAR(30)
End DoDot:2
End DoDot:1
+17 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)
+18 QUIT
+19 ;
TU(BDMRET) ;-- tobacco use health factors table
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMHF,BDMI,BDMERR,BDMPIEN,BDMDA,BDMTU,BDMTOB
+3 KILL ^BDMTMP($JOB)
+4 SET BDMRET="^BDMTMP("_$JOB_")"
+5 SET BDMI=0
+6 SET BDMERR=""
+7 SET ^BDMTMP($JOB,BDMI)="T00080HF"_$CHAR(30)
+8 NEW TDA,TIEN
+9 SET TDA=0
FOR
SET TDA=$ORDER(^AUTTHF("B",TDA))
IF TDA=""
QUIT
Begin DoDot:1
+10 IF $EXTRACT(TDA,1,7)'="TOBACCO"
QUIT
+11 SET TIEN=0
FOR
SET TIEN=$ORDER(^AUTTHF("B",TDA,TIEN))
IF 'TIEN
QUIT
Begin DoDot:2
+12 SET BDMTOB(TIEN)=""
End DoDot:2
End DoDot:1
+13 SET BDMDA=0
FOR
SET BDMDA=$ORDER(^AUTTHF("AC",BDMDA))
IF BDMDA=""
QUIT
Begin DoDot:1
+14 SET BDMPIEN=0
FOR
SET BDMPIEN=$ORDER(^AUTTHF("AC",BDMDA,BDMPIEN))
IF 'BDMPIEN
QUIT
Begin DoDot:2
+15 IF $PIECE($GET(^AUTTHF(BDMPIEN,0)),U,13)
QUIT
+16 SET BDMTU=$PIECE($GET(^AUTTHF(BDMPIEN,0)),U,3)
+17 IF '$DATA(BDMTOB(BDMTU))
QUIT
+18 IF $PIECE($GET(^AUTTHF(BDMPIEN,0)),U,10)'="F"
QUIT
+19 SET BDMHF=$PIECE($GET(^AUTTHF(BDMPIEN,0)),U)
+20 SET BDMI=BDMI+1
+21 SET ^BDMTMP($JOB,BDMI)=BDMHF_$CHAR(30)
End DoDot:2
End DoDot:1
+22 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)
+23 QUIT
+24 ;
GLU(BDMRET) ;-- glucose health factors table
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMHF,BDMI,BDMERR,BDMPIEN,BDMDA,BDMGLU
+3 KILL ^BDMTMP($JOB)
+4 SET BDMRET="^BDMTMP("_$JOB_")"
+5 SET BDMI=0
+6 SET BDMERR=""
+7 SET ^BDMTMP($JOB,BDMI)="T00080HF"_$CHAR(30)
+8 SET BDMGLU=$ORDER(^AUTTHF("B","DIABETES SELF MONITORING",0))
+9 SET BDMDA=0
FOR
SET BDMDA=$ORDER(^AUTTHF("AC",BDMDA))
IF BDMDA=""
QUIT
Begin DoDot:1
+10 SET BDMPIEN=0
FOR
SET BDMPIEN=$ORDER(^AUTTHF("AC",BDMDA,BDMPIEN))
IF 'BDMPIEN
QUIT
Begin DoDot:2
+11 IF $PIECE($GET(^AUTTHF(BDMPIEN,0)),U,13)
QUIT
+12 IF $PIECE($GET(^AUTTHF(BDMPIEN,0)),U,3)'=BDMGLU
QUIT
+13 IF $PIECE($GET(^AUTTHF(BDMPIEN,0)),U,10)'="F"
QUIT
+14 SET BDMHF=$PIECE($GET(^AUTTHF(BDMPIEN,0)),U)
+15 SET BDMI=BDMI+1
+16 SET ^BDMTMP($JOB,BDMI)=BDMHF_$CHAR(30)
End DoDot:2
End DoDot:1
+17 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)
+18 QUIT
+19 ;
BAR(BDMRET) ;-- barriers health factors table
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMHF,BDMI,BDMERR,BDMPIEN,BDMDA,BDMBAR
+3 KILL ^BDMTMP($JOB)
+4 SET BDMRET="^BDMTMP("_$JOB_")"
+5 SET BDMI=0
+6 SET BDMERR=""
+7 SET ^BDMTMP($JOB,BDMI)="T00080HF"_$CHAR(30)
+8 SET BDMBAR=$ORDER(^AUTTHF("B","BARRIERS TO LEARNING",0))
+9 SET BDMDA=0
FOR
SET BDMDA=$ORDER(^AUTTHF("AC",BDMDA))
IF BDMDA=""
QUIT
Begin DoDot:1
+10 SET BDMPIEN=0
FOR
SET BDMPIEN=$ORDER(^AUTTHF("AC",BDMDA,BDMPIEN))
IF 'BDMPIEN
QUIT
Begin DoDot:2
+11 IF $PIECE($GET(^AUTTHF(BDMPIEN,0)),U,13)
QUIT
+12 IF $PIECE($GET(^AUTTHF(BDMPIEN,0)),U,3)'=BDMBAR
QUIT
+13 IF $PIECE($GET(^AUTTHF(BDMPIEN,0)),U,10)'="F"
QUIT
+14 SET BDMHF=$PIECE($GET(^AUTTHF(BDMPIEN,0)),U)
+15 SET BDMI=BDMI+1
+16 SET ^BDMTMP($JOB,BDMI)=BDMHF_$CHAR(30)
End DoDot:2
End DoDot:1
+17 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)
+18 QUIT
+19 ;
READ(BDMRET) ;-- readiness use health factors table
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMHF,BDMI,BDMERR,BDMPIEN,BDMDA,BDMR
+3 KILL ^BDMTMP($JOB)
+4 SET BDMRET="^BDMTMP("_$JOB_")"
+5 SET BDMI=0
+6 SET BDMERR=""
+7 SET ^BDMTMP($JOB,BDMI)="T00080HF"_$CHAR(30)
+8 SET BDMR=$ORDER(^AUTTHF("B","READINESS TO LEARN",0))
+9 SET BDMDA=0
FOR
SET BDMDA=$ORDER(^AUTTHF("AC",BDMDA))
IF BDMDA=""
QUIT
Begin DoDot:1
+10 SET BDMPIEN=0
FOR
SET BDMPIEN=$ORDER(^AUTTHF("AC",BDMDA,BDMPIEN))
IF 'BDMPIEN
QUIT
Begin DoDot:2
+11 IF $PIECE($GET(^AUTTHF(BDMPIEN,0)),U,13)
QUIT
+12 IF $PIECE($GET(^AUTTHF(BDMPIEN,0)),U,3)'=BDMR
QUIT
+13 IF $PIECE($GET(^AUTTHF(BDMPIEN,0)),U,10)'="F"
QUIT
+14 SET BDMHF=$PIECE($GET(^AUTTHF(BDMPIEN,0)),U)
+15 SET BDMI=BDMI+1
+16 SET ^BDMTMP($JOB,BDMI)=BDMHF_$CHAR(30)
End DoDot:2
End DoDot:1
+17 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)
+18 QUIT
+19 ;
LRN(BDMRET) ;-- learning health factors table
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMHF,BDMI,BDMERR,BDMPIEN,BDMDA,BDML
+3 KILL ^BDMTMP($JOB)
+4 SET BDMRET="^BDMTMP("_$JOB_")"
+5 SET BDMI=0
+6 SET BDMERR=""
+7 SET ^BDMTMP($JOB,BDMI)="T00080HF"_$CHAR(30)
+8 SET BDML=$ORDER(^AUTTHF("B","LEARNING PREFERENCE",0))
+9 SET BDMDA=0
FOR
SET BDMDA=$ORDER(^AUTTHF("AC",BDMDA))
IF BDMDA=""
QUIT
Begin DoDot:1
+10 SET BDMPIEN=0
FOR
SET BDMPIEN=$ORDER(^AUTTHF("AC",BDMDA,BDMPIEN))
IF 'BDMPIEN
QUIT
Begin DoDot:2
+11 IF $PIECE($GET(^AUTTHF(BDMPIEN,0)),U,13)
QUIT
+12 IF $PIECE($GET(^AUTTHF(BDMPIEN,0)),U,3)'=BDML
QUIT
+13 IF $PIECE($GET(^AUTTHF(BDMPIEN,0)),U,10)'="F"
QUIT
+14 SET BDMHF=$PIECE($GET(^AUTTHF(BDMPIEN,0)),U)
+15 SET BDMI=BDMI+1
+16 SET ^BDMTMP($JOB,BDMI)=BDMHF_$CHAR(30)
End DoDot:2
End DoDot:1
+17 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)
+18 QUIT
+19 ;
MED(BDMRET) ;-- get all drugs
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMMED,BDMI,BDMERR,BDMIEN
+3 KILL ^BDMTMP($JOB)
+4 SET BDMRET="^BDMTMP("_$JOB_")"
+5 SET BDMI=0
+6 SET BDMERR=""
+7 SET ^BDMTMP($JOB,BDMI)="T00080MED"_$CHAR(30)
+8 SET BDMMED=0
FOR
SET BDMMED=$ORDER(^PSDRUG("B",BDMMED))
IF BDMMED=""
QUIT
Begin DoDot:1
+9 SET BDMIEN=0
FOR
SET BDMIEN=$ORDER(^PSDRUG("B",BDMMED,BDMIEN))
IF 'BDMIEN
QUIT
Begin DoDot:2
+10 ;Q:$G(^PSDRUG(BDMIEN,"I"))
+11 SET BDMI=BDMI+1
+12 SET ^BDMTMP($JOB,BDMI)=BDMMED_$CHAR(30)
End DoDot:2
End DoDot:1
+13 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)
+14 QUIT
+15 ;
