BDMGT.m

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      ;