BDMGTA ; cmi/anch/maw - BDM DMS GUI Table Lookup ;
;;2.0;BDM DIABETES MANAGEMENT SYSTEM;**1,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
;
MSR(BDMRET) ;-- measurement type
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMMST,BDMMSA,BDMMS,BDMMSTE,BDMI,BDMERR,BDMIEN
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S BDMI=0
S BDMERR=""
S ^BDMTMP($J,BDMI)="T00080MSR"_$C(30)
S BDMMST=0 F S BDMMST=$O(^AUTTMSR(BDMMST)) Q:'BDMMST D
. S BDMI=BDMI+1
. S BDMMSA=$P($G(^AUTTMSR(BDMMST,0)),U)
. S BDMMS=$P($G(^AUTTMSR(BDMMST,0)),U,2)
. S ^BDMTMP($J,BDMI)=BDMMS_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)
Q
;
IMM(BDMRET) ;-- immunization table
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMIMM,BDMI,BDMERR,BDMIEN
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S BDMI=0
S BDMERR=""
S ^BDMTMP($J,BDMI)="T00080IMM"_$C(30)
S BDMIMM=0 F S BDMIMM=$O(^AUTTIMM("D",BDMIMM)) Q:BDMIMM="" D
. S BDMIEN=0 F S BDMIEN=$O(^AUTTIMM("D",BDMIMM,BDMIEN)) Q:'BDMIEN D
.. Q:$P($G(^AUTTIMM(BDMIEN,0)),U,7)
.. S BDMI=BDMI+1
.. S ^BDMTMP($J,BDMI)=BDMIMM_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)
Q
;
FLU(BDMRET) ;-- flu immunization table
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMIMM,BDMI,BDMERR,BDMIEN
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S BDMI=0
S BDMERR=""
S ^BDMTMP($J,BDMI)="T00080IMM"_$C(30)
S BDMI=1
S BDMIMM=0 F S BDMIMM=$O(^AUTTIMM("D",BDMIMM)) Q:BDMIMM="" D
. S BDMIEN=0 F S BDMIEN=$O(^AUTTIMM("D",BDMIMM,BDMIEN)) Q:'BDMIEN D
.. ;Q:$P($G(^AUTTIMM(BDMIEN,0)),U,7)
.. I $P($G(^AUTTIMM(BDMIEN,0)),U,3)=15 S ^BDMTMP($J,BDMI)=BDMIMM_$C(30),BDMI=BDMI+1
.. I $P($G(^AUTTIMM(BDMIEN,0)),U,3)=16 S ^BDMTMP($J,BDMI)=BDMIMM_$C(30),BDMI=BDMI+1
.. I $P($G(^AUTTIMM(BDMIEN,0)),U,3)=88 S ^BDMTMP($J,BDMI)=BDMIMM_$C(30),BDMI=BDMI+1
.. I $P($G(^AUTTIMM(BDMIEN,0)),U,3)=111 S ^BDMTMP($J,BDMI)=BDMIMM_$C(30),BDMI=BDMI+1
.. I $P($G(^AUTTIMM(BDMIEN,0)),U,3)=135 S ^BDMTMP($J,BDMI)=BDMIMM_$C(30),BDMI=BDMI+1
.. I $P($G(^AUTTIMM(BDMIEN,0)),U,3)=140 S ^BDMTMP($J,BDMI)=BDMIMM_$C(30),BDMI=BDMI+1
.. I $P($G(^AUTTIMM(BDMIEN,0)),U,3)=141 S ^BDMTMP($J,BDMI)=BDMIMM_$C(30),BDMI=BDMI+1
S ^BDMTMP($J,BDMI)=$C(31)_$G(BDMERR)
Q
;
PNU(BDMRET) ;-- pneumovax immunization table
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMIMM,BDMI,BDMERR,BDMIEN
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S BDMI=0
S BDMERR=""
S ^BDMTMP($J,BDMI)="T00080IMM"_$C(30)
S BDMI=1
S BDMIMM=0 F S BDMIMM=$O(^AUTTIMM("D",BDMIMM)) Q:BDMIMM="" D
. S BDMIEN=0 F S BDMIEN=$O(^AUTTIMM("D",BDMIMM,BDMIEN)) Q:'BDMIEN D
.. ;Q:$P($G(^AUTTIMM(BDMIEN,0)),U,7)
.. I $P($G(^AUTTIMM(BDMIEN,0)),U,3)=33 S ^BDMTMP($J,BDMI)=BDMIMM_$C(30),BDMI=BDMI+1
.. I $P($G(^AUTTIMM(BDMIEN,0)),U,3)=100 S ^BDMTMP($J,BDMI)=BDMIMM_$C(30),BDMI=BDMI+1
.. I $P($G(^AUTTIMM(BDMIEN,0)),U,3)=109 S ^BDMTMP($J,BDMI)=BDMIMM_$C(30),BDMI=BDMI+1
.. I $P($G(^AUTTIMM(BDMIEN,0)),U,3)=133 S ^BDMTMP($J,BDMI)=BDMIMM_$C(30),BDMI=BDMI+1
S ^BDMTMP($J,BDMI)=$C(31)_$G(BDMERR)
Q
;
HEP(BDMRET) ;-- hepb immunization table
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMIMM,BDMI,BDMERR,BDMIEN
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S BDMI=0
S BDMERR=""
S ^BDMTMP($J,BDMI)="T00080IMM"_$C(30)
S BDMI=1
S BDMIMM=0 F S BDMIMM=$O(^AUTTIMM("D",BDMIMM)) Q:BDMIMM="" D
. S BDMIEN=0 F S BDMIEN=$O(^AUTTIMM("D",BDMIMM,BDMIEN)) Q:'BDMIEN D
.. ;Q:$P($G(^AUTTIMM(BDMIEN,0)),U,7)
.. I $P($G(^AUTTIMM(BDMIEN,0)),U,3)=8 S ^BDMTMP($J,BDMI)=BDMIMM_$C(30),BDMI=BDMI+1
.. I $P($G(^AUTTIMM(BDMIEN,0)),U,3)=42 S ^BDMTMP($J,BDMI)=BDMIMM_$C(30),BDMI=BDMI+1
.. I $P($G(^AUTTIMM(BDMIEN,0)),U,3)=43 S ^BDMTMP($J,BDMI)=BDMIMM_$C(30),BDMI=BDMI+1
.. I $P($G(^AUTTIMM(BDMIEN,0)),U,3)=44 S ^BDMTMP($J,BDMI)=BDMIMM_$C(30),BDMI=BDMI+1
.. I $P($G(^AUTTIMM(BDMIEN,0)),U,3)=45 S ^BDMTMP($J,BDMI)=BDMIMM_$C(30),BDMI=BDMI+1
.. I $P($G(^AUTTIMM(BDMIEN,0)),U,3)=51 S ^BDMTMP($J,BDMI)=BDMIMM_$C(30),BDMI=BDMI+1
.. I $P($G(^AUTTIMM(BDMIEN,0)),U,3)=52 S ^BDMTMP($J,BDMI)=BDMIMM_$C(30),BDMI=BDMI+1
.. I $P($G(^AUTTIMM(BDMIEN,0)),U,3)=102 S ^BDMTMP($J,BDMI)=BDMIMM_$C(30),BDMI=BDMI+1
.. I $P($G(^AUTTIMM(BDMIEN,0)),U,3)=104 S ^BDMTMP($J,BDMI)=BDMIMM_$C(30),BDMI=BDMI+1
S ^BDMTMP($J,BDMI)=$C(31)_$G(BDMERR)
Q
;
TD(BDMRET) ;-- td immunization table
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMIMM,BDMI,BDMERR,BDMIEN
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S BDMI=0
S BDMERR=""
S ^BDMTMP($J,BDMI)="T00080IMM"_$C(30)
S BDMI=1
S BDMIMM=0 F S BDMIMM=$O(^AUTTIMM("D",BDMIMM)) Q:BDMIMM="" D
. S BDMIEN=0 F S BDMIEN=$O(^AUTTIMM("D",BDMIMM,BDMIEN)) Q:'BDMIEN D
.. ;Q:$P($G(^AUTTIMM(BDMIEN,0)),U,7)
.. I $P($G(^AUTTIMM(BDMIEN,0)),U,3)=1 S ^BDMTMP($J,BDMI)=BDMIMM_$C(30),BDMI=BDMI+1
.. I $P($G(^AUTTIMM(BDMIEN,0)),U,3)=9 S ^BDMTMP($J,BDMI)=BDMIMM_$C(30),BDMI=BDMI+1
.. I $P($G(^AUTTIMM(BDMIEN,0)),U,3)=20 S ^BDMTMP($J,BDMI)=BDMIMM_$C(30),BDMI=BDMI+1
.. I $P($G(^AUTTIMM(BDMIEN,0)),U,3)=22 S ^BDMTMP($J,BDMI)=BDMIMM_$C(30),BDMI=BDMI+1
.. I $P($G(^AUTTIMM(BDMIEN,0)),U,3)=28 S ^BDMTMP($J,BDMI)=BDMIMM_$C(30),BDMI=BDMI+1
.. I $P($G(^AUTTIMM(BDMIEN,0)),U,3)=35 S ^BDMTMP($J,BDMI)=BDMIMM_$C(30),BDMI=BDMI+1
.. I $P($G(^AUTTIMM(BDMIEN,0)),U,3)=50 S ^BDMTMP($J,BDMI)=BDMIMM_$C(30),BDMI=BDMI+1
.. I $P($G(^AUTTIMM(BDMIEN,0)),U,3)=106 S ^BDMTMP($J,BDMI)=BDMIMM_$C(30),BDMI=BDMI+1
.. I $P($G(^AUTTIMM(BDMIEN,0)),U,3)=107 S ^BDMTMP($J,BDMI)=BDMIMM_$C(30),BDMI=BDMI+1
.. I $P($G(^AUTTIMM(BDMIEN,0)),U,3)=110 S ^BDMTMP($J,BDMI)=BDMIMM_$C(30),BDMI=BDMI+1
.. I $P($G(^AUTTIMM(BDMIEN,0)),U,3)=113 S ^BDMTMP($J,BDMI)=BDMIMM_$C(30),BDMI=BDMI+1
.. I $P($G(^AUTTIMM(BDMIEN,0)),U,3)=115 S ^BDMTMP($J,BDMI)=BDMIMM_$C(30),BDMI=BDMI+1
.. I $P($G(^AUTTIMM(BDMIEN,0)),U,3)=120 S ^BDMTMP($J,BDMI)=BDMIMM_$C(30),BDMI=BDMI+1
.. I $P($G(^AUTTIMM(BDMIEN,0)),U,3)=130 S ^BDMTMP($J,BDMI)=BDMIMM_$C(30),BDMI=BDMI+1
.. I $P($G(^AUTTIMM(BDMIEN,0)),U,3)=132 S ^BDMTMP($J,BDMI)=BDMIMM_$C(30),BDMI=BDMI+1
.. I $P($G(^AUTTIMM(BDMIEN,0)),U,3)=138 S ^BDMTMP($J,BDMI)=BDMIMM_$C(30),BDMI=BDMI+1
.. I $P($G(^AUTTIMM(BDMIEN,0)),U,3)=139 S ^BDMTMP($J,BDMI)=BDMIMM_$C(30),BDMI=BDMI+1
S ^BDMTMP($J,BDMI)=$C(31)_$G(BDMERR)
Q
;
SKT(BDMRET) ;-- skin test table
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMSKT,BDMI,BDMERR,BDMIEN
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S BDMI=0
S BDMERR=""
S ^BDMTMP($J,BDMI)="T00080SKT"_$C(30)
S BDMSKT=0 F S BDMSKT=$O(^AUTTSK("B",BDMSKT)) Q:BDMSKT="" D
. S BDMIEN=0 F S BDMIEN=$O(^AUTTSK("B",BDMSKT,BDMIEN)) Q:'BDMIEN D
.. S BDMI=BDMI+1
.. S ^BDMTMP($J,BDMI)=BDMSKT_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)
Q
;
DXP(BDMRET) ;-- diagnostic procedure result
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMDXP,BDMI,BDMERR,BDMIEN
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S BDMI=0
S BDMERR=""
S ^BDMTMP($J,BDMI)="T00080DXP"_$C(30)
S BDMDXP=0 F S BDMDXP=$O(^AUTTDXPR("B",BDMDXP)) Q:BDMDXP="" D
. S BDMIEN=0 F S BDMIEN=$O(^AUTTDXPR("B",BDMDXP,BDMIEN)) Q:'BDMIEN D
.. S BDMI=BDMI+1
.. S ^BDMTMP($J,BDMI)=BDMDXP_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)
Q
;
XAM(BDMRET) ;-- exam table
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMXAM,BDMI,BDMERR,BDMIEN
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S BDMI=0
S BDMERR=""
S ^BDMTMP($J,BDMI)="T00080XAM"_$C(30)
S BDMXAM=0 F S BDMXAM=$O(^AUTTEXAM("B",BDMXAM)) Q:BDMXAM="" D
. S BDMIEN=0 F S BDMIEN=$O(^AUTTEXAM("B",BDMXAM,BDMIEN)) Q:'BDMIEN D
.. S BDMI=BDMI+1
.. S ^BDMTMP($J,BDMI)=BDMXAM_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)
Q
;
RAD(BDMRET) ;-- rad table
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMRAD,BDMI,BDMERR,BDMIEN
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S BDMI=0
S BDMERR=""
S ^BDMTMP($J,BDMI)="T00080RAD"_$C(30)
S BDMRAD=0 F S BDMRAD=$O(^RAMIS(71,"B",BDMRAD)) Q:BDMRAD="" D
. S BDMIEN=0 F S BDMIEN=$O(^RAMIS(71,"B",BDMRAD,BDMIEN)) Q:'BDMIEN D
.. S BDMI=BDMI+1
.. S ^BDMTMP($J,BDMI)=BDMRAD_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)
Q
;
RFL(BDMRET) ;-- refusal types
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMRFL,BDMI,BDMERR,BDMIEN
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S BDMI=0
S BDMERR=""
S ^BDMTMP($J,BDMI)="T00080REFUSAL"_$C(30)
S BDMRFL=0 F S BDMRFL=$O(^AUTTREFT("B",BDMRFL)) Q:BDMRFL="" D
. S BDMIEN=0 F S BDMIEN=$O(^AUTTREFT("B",BDMRFL,BDMIEN)) Q:'BDMIEN D
.. S BDMI=BDMI+1
.. S ^BDMTMP($J,BDMI)=BDMRFL_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)
Q
;
TAX(BDMRET,BDMSTR) ;-- generic taxonomy table
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N P,BDMRFL,BDMI,BDMERR,BDMIEN,BDMTAXE,BDMTAX,BDMDA,BDMNONC,BDMXRF
N BDMGL,BDMGRF,BDMP
S P="|"
I $P(BDMSTR,P)="Lab" D LABTAX(.BDMRET,.BDMSTR) Q
I $P(BDMSTR,P)="LAB" D LTAX(.BDMRET) Q
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S BDMI=0
S BDMERR=""
S ^BDMTMP($J,BDMI)="T00080TAXONOMY"_$C(30)
I $P(BDMSTR,P)="MED" D MEDBLD
F BDMP=3:1 S BDMTAXE=$P(BDMSTR,P,BDMP) Q:$G(BDMTAXE)="" D
. Q:$G(BDMTAXE)=""
. ;S BDMTAXE=$P(BDMSTR,P)
. S BDMTAX=$O(^ATXAX("B",BDMTAXE,0))
. Q:'$G(BDMTAX)
. S BDMNONC=$P($G(^ATXAX(BDMTAX,0)),U,13)
. S BDMXRF=$P($G(^ATXAX(BDMTAX,0)),U,14)
. S BDMFL=$P($G(^ATXAX(BDMTAX,0)),U,15)
. ;I $G(BDMXRF)="" S BDMXRF="B"
. I BDMFL=80 S BDMXRF="BA" ;icd diagnosis x ref
. I BDMFL=80.1 S BDMXRF="BA" ;icd op and proc xref
. ;I $G(BDMXRF)="" S BDMXRF="B"
. S BDMGL=$G(^DIC(BDMFL,0,"GL"))
. S BDMDA=0 F S BDMDA=$O(^ATXAX(BDMTAX,21,BDMDA)) Q:'BDMDA D
.. N BDML,BDMH
.. S BDMI=BDMI+1
.. S BDML=$P($G(^ATXAX(BDMTAX,21,BDMDA,0)),U)
.. S BDMH=$P($G(^ATXAX(BDMTAX,21,BDMDA,0)),U,2)
.. I (BDML=BDMH)!($G(BDMH)="") D Q
... I $G(BDMXRF)="" D Q
.... S BDMGRF=BDMGL_""""_BDML_""""_")"
.... S ^BDMTMP($J,BDMI)=$P($G(@BDMGRF@(0)),U)_$C(30)
... S ^BDMTMP($J,BDMI)=BDML_$C(30)
.. S BDMGRF=BDMGL_""""_BDMXRF_""")"
.. N BDMIEN
.. S BDMIEN=$O(@BDMGRF@(BDML),-1)
.. F S BDMIEN=$O(@BDMGRF@(BDMIEN)) Q:BDMIEN>BDMH D
... S BDMI=BDMI+1
... S ^BDMTMP($J,BDMI)=BDMIEN_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)
Q
;
LABTAX(BDMRET,BDMSTR) ;-- return the lab taxonomy
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N P,BDMRFL,BDMI,BDMERR,BDMIEN,BDMTAXE,BDMTAX,BDMDA,BDMNONC,BDMXRF
N BDMGL,BDMGRF,BDMP
S P="|"
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S BDMI=0
S BDMERR=""
S ^BDMTMP($J,BDMI)="T00080LABTAXONOMY"_$C(30)
F BDMP=3:1 S BDMTAXE=$P(BDMSTR,P,BDMP) Q:$G(BDMTAXE)="" D
. Q:$G(BDMTAXE)=""
. ;S BDMTAXE=$P(BDMSTR,P)
. S BDMTAX=$O(^ATXLAB("B",BDMTAXE,0))
. Q:'$G(BDMTAX)
. S BDMNONC=$P($G(^ATXLAB(BDMTAX,0)),U,13)
. S BDMXRF=$P($G(^ATXLAB(BDMTAX,0)),U,14)
. S BDMFL=60
. S BDMGL=$G(^DIC(BDMFL,0,"GL"))
. S BDMDA=0 F S BDMDA=$O(^ATXLAB(BDMTAX,21,BDMDA)) Q:'BDMDA D
.. N BDML,BDMH
.. S BDMI=BDMI+1
.. S BDML=$P($G(^ATXLAB(BDMTAX,21,BDMDA,0)),U)
.. S BDMH=$P($G(^ATXLAB(BDMTAX,21,BDMDA,0)),U,2)
.. I (BDML=BDMH)!($G(BDMH)="") D Q
... I $G(BDMXRF)="" D Q
.... S BDMGRF=BDMGL_""""_BDML_""""_")"
.... S ^BDMTMP($J,BDMI)=$P($G(@BDMGRF@(0)),U)_$C(30)
... S ^BDMTMP($J,BDMI)=BDML_$C(30)
.. S BDMGRF=BDMGL_""""_BDMXRF_""")"
.. N BDMIEN
.. S BDMIEN=$O(@BDMGRF@(BDML),-1)
.. F S BDMIEN=$O(@BDMGRF@(BDMIEN)) Q:BDMIEN>BDMH D
... S BDMI=BDMI+1
... S ^BDMTMP($J,BDMI)=BDMIEN_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)
Q
;
LTAX(BDMRET) ;-- generic lab taxonomy table
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N P,BDMRFL,BDMI,BDMERR,BDMIEN,BDMTAXE,BDMTAX,BDMDA,BDMNONC,BDMXRF
N BDMGL,BDMGRF,BDMP,BDMPKG,BDMTDA,BDMPKGI
S P="|"
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S BDMI=0
S BDMERR=""
S BDMPKG=$P(BDMSTR,P,2)
S BDMPKGI=$O(^DIC(9.4,"C",BDMPKG,0))
S ^BDMTMP($J,BDMI)="T00080LABTAXONOMY"_$C(30)
S BDMTAX=0 F S BDMTAX=$O(^ATXLAB("APKG",BDMPKGI,BDMTAX)) Q:'BDMTAX D
. ;S BDMTAX=0 F S BDMTAX=$O(^ATXLAB(BDMTAX)) Q:'BDMTAX D
. ;S BDMTAX=$P($G(^ATXLAB(BDMP,0)),U)
. ;Q:$E($P($G(^ATXLAB(BDMTAX,0)),U),1,2)'="DM"
. ;S BDMTAXE=$P(BDMSTR,P)
. ;S BDMTAX=$O(^ATXLAB("B",BDMTAXE,0))
. ;Q:'$G(BDMTAX)
. S BDMXRF=$P($G(^ATXLAB(BDMTAX,0)),U,8)
. I $G(BDMXRF)="" S BDMXRF="B"
. S BDMFL=$P($G(^ATXLAB(BDMTAX,0)),U,9)
. S BDMGL=$G(^DIC(BDMFL,0,"GL"))
. S BDMDA=0 F S BDMDA=$O(^ATXLAB(BDMTAX,21,BDMDA)) Q:'BDMDA D
.. N BDML,BDMH
.. S BDMI=BDMI+1
.. S BDML=$P($G(^ATXLAB(BDMTAX,21,BDMDA,0)),U)
.. S BDMGRF=BDMGL_""""_BDML_""""_")"
.. N BDMIEN
.. S BDMI=BDMI+1
.. S ^BDMTMP($J,BDMI)=$P($G(@BDMGRF@(0)),U)_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)
Q
;
MEDBLD ;-- setup BDMSTR for medication taxonomy
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMTDA,BDMI,BDMPKG,BDMPKGI
S BDMI=1
S BDMPKG=$P(BDMSTR,P,2)
S BDMPKGI=$O(^DIC(9.4,"C",BDMPKG,0))
S BDMTDA=0 F S BDMTDA=$O(^ATXAX(BDMTDA)) Q:'BDMTDA D
. ;S BDMTDA=0 F S BDMTDA=$O(^ATXAX(BDMTDA)) Q:'BDMTDA D
. ;Q:$E($P($G(^ATXAX(BDMTDA,0)),U),1,2)'="DM"
. Q:$P($G(^ATXAX(BDMTDA,0)),U,15)'=50
. S BDMI=BDMI+1
. S $P(BDMSTR,P,BDMI)=$P($G(^ATXAX(BDMTDA,0)),U)
Q
;
GETTAX(BDMRET,BDMSTR) ;-- get taxonomies based on user selection
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMDA,BDMI,P,BDMPKG,BDMPKGI,BDMI
S P="|"
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S BDMI=0
S BDMERR=""
S BDMPKG=$P(BDMSTR,P)
S BDMPKGI=$O(^DIC(9.4,"C",BDMPKG,0))
S ^BDMTMP($J,BDMI)="T00080TAXONOMIES"_$C(30)
S BDMDA=0 F S BDMDA=$O(^ATXAX("APKG",BDMPKGI,BDMDA)) Q:'BDMDA D
. N BDMTAX,BDMRO,BDMFL
. S BDMTAX=$P($G(^ATXAX(BDMDA,0)),U)
. S BDMRO=$S($P($G(^ATXAX(BDMDA,0)),U,22):"Read Only",1:"Editable")
. S BDMFL=$P($G(^ATXAX(BDMDA,0)),U,15)
. S ^BDMTMP("TAX",$J,BDMFL,BDMTAX)=BDMRO_U_$S(BDMFL=50:"Med",1:"Tax")
S BDMDA=0 F S BDMDA=$O(^ATXLAB("APKG",BDMPKGI,BDMDA)) Q:'BDMDA D
. N BDMTAX,BDMRO,BDMFL
. S BDMTAX=$P($G(^ATXLAB(BDMDA,0)),U)
. S BDMRO=$S($P($G(^ATXLAB(BDMDA,0)),U,22):"Read Only",1:"Editable")
. S BDMFL=$P($G(^ATXLAB(BDMDA,0)),U,9)
. S ^BDMTMP("TAX",$J,BDMFL,BDMTAX)=BDMRO_U_"Lab"
S BDMDA=0 F S BDMDA=$O(^BDMTMP("TAX",$J,BDMDA)) Q:BDMDA="" D
. N BDMIEN
. S BDMIEN=0 F S BDMIEN=$O(^BDMTMP("TAX",$J,BDMDA,BDMIEN)) Q:BDMIEN="" D
.. S BDMI=BDMI+1
.. S BDMRO=$G(^BDMTMP("TAX",$J,BDMDA,BDMIEN))
.. S ^BDMTMP($J,BDMI)=BDMIEN_"("_$P(BDMRO,U)_"/"_$P(BDMRO,U,2)_"/"_BDMDA_")"_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)
K ^BDMTMP("TAX",$J)
Q
;
BDMGTA ; cmi/anch/maw - BDM DMS GUI Table Lookup ;
+1 ;;2.0;BDM DIABETES MANAGEMENT SYSTEM;**1,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 ;
MSR(BDMRET) ;-- measurement type
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMMST,BDMMSA,BDMMS,BDMMSTE,BDMI,BDMERR,BDMIEN
+3 KILL ^BDMTMP($JOB)
+4 SET BDMRET="^BDMTMP("_$JOB_")"
+5 SET BDMI=0
+6 SET BDMERR=""
+7 SET ^BDMTMP($JOB,BDMI)="T00080MSR"_$CHAR(30)
+8 SET BDMMST=0
FOR
SET BDMMST=$ORDER(^AUTTMSR(BDMMST))
IF 'BDMMST
QUIT
Begin DoDot:1
+9 SET BDMI=BDMI+1
+10 SET BDMMSA=$PIECE($GET(^AUTTMSR(BDMMST,0)),U)
+11 SET BDMMS=$PIECE($GET(^AUTTMSR(BDMMST,0)),U,2)
+12 SET ^BDMTMP($JOB,BDMI)=BDMMS_$CHAR(30)
End DoDot:1
+13 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)
+14 QUIT
+15 ;
IMM(BDMRET) ;-- immunization table
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMIMM,BDMI,BDMERR,BDMIEN
+3 KILL ^BDMTMP($JOB)
+4 SET BDMRET="^BDMTMP("_$JOB_")"
+5 SET BDMI=0
+6 SET BDMERR=""
+7 SET ^BDMTMP($JOB,BDMI)="T00080IMM"_$CHAR(30)
+8 SET BDMIMM=0
FOR
SET BDMIMM=$ORDER(^AUTTIMM("D",BDMIMM))
IF BDMIMM=""
QUIT
Begin DoDot:1
+9 SET BDMIEN=0
FOR
SET BDMIEN=$ORDER(^AUTTIMM("D",BDMIMM,BDMIEN))
IF 'BDMIEN
QUIT
Begin DoDot:2
+10 IF $PIECE($GET(^AUTTIMM(BDMIEN,0)),U,7)
QUIT
+11 SET BDMI=BDMI+1
+12 SET ^BDMTMP($JOB,BDMI)=BDMIMM_$CHAR(30)
End DoDot:2
End DoDot:1
+13 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)
+14 QUIT
+15 ;
FLU(BDMRET) ;-- flu immunization table
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMIMM,BDMI,BDMERR,BDMIEN
+3 KILL ^BDMTMP($JOB)
+4 SET BDMRET="^BDMTMP("_$JOB_")"
+5 SET BDMI=0
+6 SET BDMERR=""
+7 SET ^BDMTMP($JOB,BDMI)="T00080IMM"_$CHAR(30)
+8 SET BDMI=1
+9 SET BDMIMM=0
FOR
SET BDMIMM=$ORDER(^AUTTIMM("D",BDMIMM))
IF BDMIMM=""
QUIT
Begin DoDot:1
+10 SET BDMIEN=0
FOR
SET BDMIEN=$ORDER(^AUTTIMM("D",BDMIMM,BDMIEN))
IF 'BDMIEN
QUIT
Begin DoDot:2
+11 ;Q:$P($G(^AUTTIMM(BDMIEN,0)),U,7)
+12 IF $PIECE($GET(^AUTTIMM(BDMIEN,0)),U,3)=15
SET ^BDMTMP($JOB,BDMI)=BDMIMM_$CHAR(30)
SET BDMI=BDMI+1
+13 IF $PIECE($GET(^AUTTIMM(BDMIEN,0)),U,3)=16
SET ^BDMTMP($JOB,BDMI)=BDMIMM_$CHAR(30)
SET BDMI=BDMI+1
+14 IF $PIECE($GET(^AUTTIMM(BDMIEN,0)),U,3)=88
SET ^BDMTMP($JOB,BDMI)=BDMIMM_$CHAR(30)
SET BDMI=BDMI+1
+15 IF $PIECE($GET(^AUTTIMM(BDMIEN,0)),U,3)=111
SET ^BDMTMP($JOB,BDMI)=BDMIMM_$CHAR(30)
SET BDMI=BDMI+1
+16 IF $PIECE($GET(^AUTTIMM(BDMIEN,0)),U,3)=135
SET ^BDMTMP($JOB,BDMI)=BDMIMM_$CHAR(30)
SET BDMI=BDMI+1
+17 IF $PIECE($GET(^AUTTIMM(BDMIEN,0)),U,3)=140
SET ^BDMTMP($JOB,BDMI)=BDMIMM_$CHAR(30)
SET BDMI=BDMI+1
+18 IF $PIECE($GET(^AUTTIMM(BDMIEN,0)),U,3)=141
SET ^BDMTMP($JOB,BDMI)=BDMIMM_$CHAR(30)
SET BDMI=BDMI+1
End DoDot:2
End DoDot:1
+19 SET ^BDMTMP($JOB,BDMI)=$CHAR(31)_$GET(BDMERR)
+20 QUIT
+21 ;
PNU(BDMRET) ;-- pneumovax immunization table
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMIMM,BDMI,BDMERR,BDMIEN
+3 KILL ^BDMTMP($JOB)
+4 SET BDMRET="^BDMTMP("_$JOB_")"
+5 SET BDMI=0
+6 SET BDMERR=""
+7 SET ^BDMTMP($JOB,BDMI)="T00080IMM"_$CHAR(30)
+8 SET BDMI=1
+9 SET BDMIMM=0
FOR
SET BDMIMM=$ORDER(^AUTTIMM("D",BDMIMM))
IF BDMIMM=""
QUIT
Begin DoDot:1
+10 SET BDMIEN=0
FOR
SET BDMIEN=$ORDER(^AUTTIMM("D",BDMIMM,BDMIEN))
IF 'BDMIEN
QUIT
Begin DoDot:2
+11 ;Q:$P($G(^AUTTIMM(BDMIEN,0)),U,7)
+12 IF $PIECE($GET(^AUTTIMM(BDMIEN,0)),U,3)=33
SET ^BDMTMP($JOB,BDMI)=BDMIMM_$CHAR(30)
SET BDMI=BDMI+1
+13 IF $PIECE($GET(^AUTTIMM(BDMIEN,0)),U,3)=100
SET ^BDMTMP($JOB,BDMI)=BDMIMM_$CHAR(30)
SET BDMI=BDMI+1
+14 IF $PIECE($GET(^AUTTIMM(BDMIEN,0)),U,3)=109
SET ^BDMTMP($JOB,BDMI)=BDMIMM_$CHAR(30)
SET BDMI=BDMI+1
+15 IF $PIECE($GET(^AUTTIMM(BDMIEN,0)),U,3)=133
SET ^BDMTMP($JOB,BDMI)=BDMIMM_$CHAR(30)
SET BDMI=BDMI+1
End DoDot:2
End DoDot:1
+16 SET ^BDMTMP($JOB,BDMI)=$CHAR(31)_$GET(BDMERR)
+17 QUIT
+18 ;
HEP(BDMRET) ;-- hepb immunization table
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMIMM,BDMI,BDMERR,BDMIEN
+3 KILL ^BDMTMP($JOB)
+4 SET BDMRET="^BDMTMP("_$JOB_")"
+5 SET BDMI=0
+6 SET BDMERR=""
+7 SET ^BDMTMP($JOB,BDMI)="T00080IMM"_$CHAR(30)
+8 SET BDMI=1
+9 SET BDMIMM=0
FOR
SET BDMIMM=$ORDER(^AUTTIMM("D",BDMIMM))
IF BDMIMM=""
QUIT
Begin DoDot:1
+10 SET BDMIEN=0
FOR
SET BDMIEN=$ORDER(^AUTTIMM("D",BDMIMM,BDMIEN))
IF 'BDMIEN
QUIT
Begin DoDot:2
+11 ;Q:$P($G(^AUTTIMM(BDMIEN,0)),U,7)
+12 IF $PIECE($GET(^AUTTIMM(BDMIEN,0)),U,3)=8
SET ^BDMTMP($JOB,BDMI)=BDMIMM_$CHAR(30)
SET BDMI=BDMI+1
+13 IF $PIECE($GET(^AUTTIMM(BDMIEN,0)),U,3)=42
SET ^BDMTMP($JOB,BDMI)=BDMIMM_$CHAR(30)
SET BDMI=BDMI+1
+14 IF $PIECE($GET(^AUTTIMM(BDMIEN,0)),U,3)=43
SET ^BDMTMP($JOB,BDMI)=BDMIMM_$CHAR(30)
SET BDMI=BDMI+1
+15 IF $PIECE($GET(^AUTTIMM(BDMIEN,0)),U,3)=44
SET ^BDMTMP($JOB,BDMI)=BDMIMM_$CHAR(30)
SET BDMI=BDMI+1
+16 IF $PIECE($GET(^AUTTIMM(BDMIEN,0)),U,3)=45
SET ^BDMTMP($JOB,BDMI)=BDMIMM_$CHAR(30)
SET BDMI=BDMI+1
+17 IF $PIECE($GET(^AUTTIMM(BDMIEN,0)),U,3)=51
SET ^BDMTMP($JOB,BDMI)=BDMIMM_$CHAR(30)
SET BDMI=BDMI+1
+18 IF $PIECE($GET(^AUTTIMM(BDMIEN,0)),U,3)=52
SET ^BDMTMP($JOB,BDMI)=BDMIMM_$CHAR(30)
SET BDMI=BDMI+1
+19 IF $PIECE($GET(^AUTTIMM(BDMIEN,0)),U,3)=102
SET ^BDMTMP($JOB,BDMI)=BDMIMM_$CHAR(30)
SET BDMI=BDMI+1
+20 IF $PIECE($GET(^AUTTIMM(BDMIEN,0)),U,3)=104
SET ^BDMTMP($JOB,BDMI)=BDMIMM_$CHAR(30)
SET BDMI=BDMI+1
End DoDot:2
End DoDot:1
+21 SET ^BDMTMP($JOB,BDMI)=$CHAR(31)_$GET(BDMERR)
+22 QUIT
+23 ;
TD(BDMRET) ;-- td immunization table
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMIMM,BDMI,BDMERR,BDMIEN
+3 KILL ^BDMTMP($JOB)
+4 SET BDMRET="^BDMTMP("_$JOB_")"
+5 SET BDMI=0
+6 SET BDMERR=""
+7 SET ^BDMTMP($JOB,BDMI)="T00080IMM"_$CHAR(30)
+8 SET BDMI=1
+9 SET BDMIMM=0
FOR
SET BDMIMM=$ORDER(^AUTTIMM("D",BDMIMM))
IF BDMIMM=""
QUIT
Begin DoDot:1
+10 SET BDMIEN=0
FOR
SET BDMIEN=$ORDER(^AUTTIMM("D",BDMIMM,BDMIEN))
IF 'BDMIEN
QUIT
Begin DoDot:2
+11 ;Q:$P($G(^AUTTIMM(BDMIEN,0)),U,7)
+12 IF $PIECE($GET(^AUTTIMM(BDMIEN,0)),U,3)=1
SET ^BDMTMP($JOB,BDMI)=BDMIMM_$CHAR(30)
SET BDMI=BDMI+1
+13 IF $PIECE($GET(^AUTTIMM(BDMIEN,0)),U,3)=9
SET ^BDMTMP($JOB,BDMI)=BDMIMM_$CHAR(30)
SET BDMI=BDMI+1
+14 IF $PIECE($GET(^AUTTIMM(BDMIEN,0)),U,3)=20
SET ^BDMTMP($JOB,BDMI)=BDMIMM_$CHAR(30)
SET BDMI=BDMI+1
+15 IF $PIECE($GET(^AUTTIMM(BDMIEN,0)),U,3)=22
SET ^BDMTMP($JOB,BDMI)=BDMIMM_$CHAR(30)
SET BDMI=BDMI+1
+16 IF $PIECE($GET(^AUTTIMM(BDMIEN,0)),U,3)=28
SET ^BDMTMP($JOB,BDMI)=BDMIMM_$CHAR(30)
SET BDMI=BDMI+1
+17 IF $PIECE($GET(^AUTTIMM(BDMIEN,0)),U,3)=35
SET ^BDMTMP($JOB,BDMI)=BDMIMM_$CHAR(30)
SET BDMI=BDMI+1
+18 IF $PIECE($GET(^AUTTIMM(BDMIEN,0)),U,3)=50
SET ^BDMTMP($JOB,BDMI)=BDMIMM_$CHAR(30)
SET BDMI=BDMI+1
+19 IF $PIECE($GET(^AUTTIMM(BDMIEN,0)),U,3)=106
SET ^BDMTMP($JOB,BDMI)=BDMIMM_$CHAR(30)
SET BDMI=BDMI+1
+20 IF $PIECE($GET(^AUTTIMM(BDMIEN,0)),U,3)=107
SET ^BDMTMP($JOB,BDMI)=BDMIMM_$CHAR(30)
SET BDMI=BDMI+1
+21 IF $PIECE($GET(^AUTTIMM(BDMIEN,0)),U,3)=110
SET ^BDMTMP($JOB,BDMI)=BDMIMM_$CHAR(30)
SET BDMI=BDMI+1
+22 IF $PIECE($GET(^AUTTIMM(BDMIEN,0)),U,3)=113
SET ^BDMTMP($JOB,BDMI)=BDMIMM_$CHAR(30)
SET BDMI=BDMI+1
+23 IF $PIECE($GET(^AUTTIMM(BDMIEN,0)),U,3)=115
SET ^BDMTMP($JOB,BDMI)=BDMIMM_$CHAR(30)
SET BDMI=BDMI+1
+24 IF $PIECE($GET(^AUTTIMM(BDMIEN,0)),U,3)=120
SET ^BDMTMP($JOB,BDMI)=BDMIMM_$CHAR(30)
SET BDMI=BDMI+1
+25 IF $PIECE($GET(^AUTTIMM(BDMIEN,0)),U,3)=130
SET ^BDMTMP($JOB,BDMI)=BDMIMM_$CHAR(30)
SET BDMI=BDMI+1
+26 IF $PIECE($GET(^AUTTIMM(BDMIEN,0)),U,3)=132
SET ^BDMTMP($JOB,BDMI)=BDMIMM_$CHAR(30)
SET BDMI=BDMI+1
+27 IF $PIECE($GET(^AUTTIMM(BDMIEN,0)),U,3)=138
SET ^BDMTMP($JOB,BDMI)=BDMIMM_$CHAR(30)
SET BDMI=BDMI+1
+28 IF $PIECE($GET(^AUTTIMM(BDMIEN,0)),U,3)=139
SET ^BDMTMP($JOB,BDMI)=BDMIMM_$CHAR(30)
SET BDMI=BDMI+1
End DoDot:2
End DoDot:1
+29 SET ^BDMTMP($JOB,BDMI)=$CHAR(31)_$GET(BDMERR)
+30 QUIT
+31 ;
SKT(BDMRET) ;-- skin test table
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMSKT,BDMI,BDMERR,BDMIEN
+3 KILL ^BDMTMP($JOB)
+4 SET BDMRET="^BDMTMP("_$JOB_")"
+5 SET BDMI=0
+6 SET BDMERR=""
+7 SET ^BDMTMP($JOB,BDMI)="T00080SKT"_$CHAR(30)
+8 SET BDMSKT=0
FOR
SET BDMSKT=$ORDER(^AUTTSK("B",BDMSKT))
IF BDMSKT=""
QUIT
Begin DoDot:1
+9 SET BDMIEN=0
FOR
SET BDMIEN=$ORDER(^AUTTSK("B",BDMSKT,BDMIEN))
IF 'BDMIEN
QUIT
Begin DoDot:2
+10 SET BDMI=BDMI+1
+11 SET ^BDMTMP($JOB,BDMI)=BDMSKT_$CHAR(30)
End DoDot:2
End DoDot:1
+12 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)
+13 QUIT
+14 ;
DXP(BDMRET) ;-- diagnostic procedure result
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMDXP,BDMI,BDMERR,BDMIEN
+3 KILL ^BDMTMP($JOB)
+4 SET BDMRET="^BDMTMP("_$JOB_")"
+5 SET BDMI=0
+6 SET BDMERR=""
+7 SET ^BDMTMP($JOB,BDMI)="T00080DXP"_$CHAR(30)
+8 SET BDMDXP=0
FOR
SET BDMDXP=$ORDER(^AUTTDXPR("B",BDMDXP))
IF BDMDXP=""
QUIT
Begin DoDot:1
+9 SET BDMIEN=0
FOR
SET BDMIEN=$ORDER(^AUTTDXPR("B",BDMDXP,BDMIEN))
IF 'BDMIEN
QUIT
Begin DoDot:2
+10 SET BDMI=BDMI+1
+11 SET ^BDMTMP($JOB,BDMI)=BDMDXP_$CHAR(30)
End DoDot:2
End DoDot:1
+12 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)
+13 QUIT
+14 ;
XAM(BDMRET) ;-- exam table
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMXAM,BDMI,BDMERR,BDMIEN
+3 KILL ^BDMTMP($JOB)
+4 SET BDMRET="^BDMTMP("_$JOB_")"
+5 SET BDMI=0
+6 SET BDMERR=""
+7 SET ^BDMTMP($JOB,BDMI)="T00080XAM"_$CHAR(30)
+8 SET BDMXAM=0
FOR
SET BDMXAM=$ORDER(^AUTTEXAM("B",BDMXAM))
IF BDMXAM=""
QUIT
Begin DoDot:1
+9 SET BDMIEN=0
FOR
SET BDMIEN=$ORDER(^AUTTEXAM("B",BDMXAM,BDMIEN))
IF 'BDMIEN
QUIT
Begin DoDot:2
+10 SET BDMI=BDMI+1
+11 SET ^BDMTMP($JOB,BDMI)=BDMXAM_$CHAR(30)
End DoDot:2
End DoDot:1
+12 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)
+13 QUIT
+14 ;
RAD(BDMRET) ;-- rad table
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMRAD,BDMI,BDMERR,BDMIEN
+3 KILL ^BDMTMP($JOB)
+4 SET BDMRET="^BDMTMP("_$JOB_")"
+5 SET BDMI=0
+6 SET BDMERR=""
+7 SET ^BDMTMP($JOB,BDMI)="T00080RAD"_$CHAR(30)
+8 SET BDMRAD=0
FOR
SET BDMRAD=$ORDER(^RAMIS(71,"B",BDMRAD))
IF BDMRAD=""
QUIT
Begin DoDot:1
+9 SET BDMIEN=0
FOR
SET BDMIEN=$ORDER(^RAMIS(71,"B",BDMRAD,BDMIEN))
IF 'BDMIEN
QUIT
Begin DoDot:2
+10 SET BDMI=BDMI+1
+11 SET ^BDMTMP($JOB,BDMI)=BDMRAD_$CHAR(30)
End DoDot:2
End DoDot:1
+12 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)
+13 QUIT
+14 ;
RFL(BDMRET) ;-- refusal types
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMRFL,BDMI,BDMERR,BDMIEN
+3 KILL ^BDMTMP($JOB)
+4 SET BDMRET="^BDMTMP("_$JOB_")"
+5 SET BDMI=0
+6 SET BDMERR=""
+7 SET ^BDMTMP($JOB,BDMI)="T00080REFUSAL"_$CHAR(30)
+8 SET BDMRFL=0
FOR
SET BDMRFL=$ORDER(^AUTTREFT("B",BDMRFL))
IF BDMRFL=""
QUIT
Begin DoDot:1
+9 SET BDMIEN=0
FOR
SET BDMIEN=$ORDER(^AUTTREFT("B",BDMRFL,BDMIEN))
IF 'BDMIEN
QUIT
Begin DoDot:2
+10 SET BDMI=BDMI+1
+11 SET ^BDMTMP($JOB,BDMI)=BDMRFL_$CHAR(30)
End DoDot:2
End DoDot:1
+12 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)
+13 QUIT
+14 ;
TAX(BDMRET,BDMSTR) ;-- generic taxonomy table
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW P,BDMRFL,BDMI,BDMERR,BDMIEN,BDMTAXE,BDMTAX,BDMDA,BDMNONC,BDMXRF
+3 NEW BDMGL,BDMGRF,BDMP
+4 SET P="|"
+5 IF $PIECE(BDMSTR,P)="Lab"
DO LABTAX(.BDMRET,.BDMSTR)
QUIT
+6 IF $PIECE(BDMSTR,P)="LAB"
DO LTAX(.BDMRET)
QUIT
+7 KILL ^BDMTMP($JOB)
+8 SET BDMRET="^BDMTMP("_$JOB_")"
+9 SET BDMI=0
+10 SET BDMERR=""
+11 SET ^BDMTMP($JOB,BDMI)="T00080TAXONOMY"_$CHAR(30)
+12 IF $PIECE(BDMSTR,P)="MED"
DO MEDBLD
+13 FOR BDMP=3:1
SET BDMTAXE=$PIECE(BDMSTR,P,BDMP)
IF $GET(BDMTAXE)=""
QUIT
Begin DoDot:1
+14 IF $GET(BDMTAXE)=""
QUIT
+15 ;S BDMTAXE=$P(BDMSTR,P)
+16 SET BDMTAX=$ORDER(^ATXAX("B",BDMTAXE,0))
+17 IF '$GET(BDMTAX)
QUIT
+18 SET BDMNONC=$PIECE($GET(^ATXAX(BDMTAX,0)),U,13)
+19 SET BDMXRF=$PIECE($GET(^ATXAX(BDMTAX,0)),U,14)
+20 SET BDMFL=$PIECE($GET(^ATXAX(BDMTAX,0)),U,15)
+21 ;I $G(BDMXRF)="" S BDMXRF="B"
+22 ;icd diagnosis x ref
IF BDMFL=80
SET BDMXRF="BA"
+23 ;icd op and proc xref
IF BDMFL=80.1
SET BDMXRF="BA"
+24 ;I $G(BDMXRF)="" S BDMXRF="B"
+25 SET BDMGL=$GET(^DIC(BDMFL,0,"GL"))
+26 SET BDMDA=0
FOR
SET BDMDA=$ORDER(^ATXAX(BDMTAX,21,BDMDA))
IF 'BDMDA
QUIT
Begin DoDot:2
+27 NEW BDML,BDMH
+28 SET BDMI=BDMI+1
+29 SET BDML=$PIECE($GET(^ATXAX(BDMTAX,21,BDMDA,0)),U)
+30 SET BDMH=$PIECE($GET(^ATXAX(BDMTAX,21,BDMDA,0)),U,2)
+31 IF (BDML=BDMH)!($GET(BDMH)="")
Begin DoDot:3
+32 IF $GET(BDMXRF)=""
Begin DoDot:4
+33 SET BDMGRF=BDMGL_""""_BDML_""""_")"
+34 SET ^BDMTMP($JOB,BDMI)=$PIECE($GET(@BDMGRF@(0)),U)_$CHAR(30)
End DoDot:4
QUIT
+35 SET ^BDMTMP($JOB,BDMI)=BDML_$CHAR(30)
End DoDot:3
QUIT
+36 SET BDMGRF=BDMGL_""""_BDMXRF_""")"
+37 NEW BDMIEN
+38 SET BDMIEN=$ORDER(@BDMGRF@(BDML),-1)
+39 FOR
SET BDMIEN=$ORDER(@BDMGRF@(BDMIEN))
IF BDMIEN>BDMH
QUIT
Begin DoDot:3
+40 SET BDMI=BDMI+1
+41 SET ^BDMTMP($JOB,BDMI)=BDMIEN_$CHAR(30)
End DoDot:3
End DoDot:2
End DoDot:1
+42 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)
+43 QUIT
+44 ;
LABTAX(BDMRET,BDMSTR) ;-- return the lab taxonomy
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW P,BDMRFL,BDMI,BDMERR,BDMIEN,BDMTAXE,BDMTAX,BDMDA,BDMNONC,BDMXRF
+3 NEW BDMGL,BDMGRF,BDMP
+4 SET P="|"
+5 KILL ^BDMTMP($JOB)
+6 SET BDMRET="^BDMTMP("_$JOB_")"
+7 SET BDMI=0
+8 SET BDMERR=""
+9 SET ^BDMTMP($JOB,BDMI)="T00080LABTAXONOMY"_$CHAR(30)
+10 FOR BDMP=3:1
SET BDMTAXE=$PIECE(BDMSTR,P,BDMP)
IF $GET(BDMTAXE)=""
QUIT
Begin DoDot:1
+11 IF $GET(BDMTAXE)=""
QUIT
+12 ;S BDMTAXE=$P(BDMSTR,P)
+13 SET BDMTAX=$ORDER(^ATXLAB("B",BDMTAXE,0))
+14 IF '$GET(BDMTAX)
QUIT
+15 SET BDMNONC=$PIECE($GET(^ATXLAB(BDMTAX,0)),U,13)
+16 SET BDMXRF=$PIECE($GET(^ATXLAB(BDMTAX,0)),U,14)
+17 SET BDMFL=60
+18 SET BDMGL=$GET(^DIC(BDMFL,0,"GL"))
+19 SET BDMDA=0
FOR
SET BDMDA=$ORDER(^ATXLAB(BDMTAX,21,BDMDA))
IF 'BDMDA
QUIT
Begin DoDot:2
+20 NEW BDML,BDMH
+21 SET BDMI=BDMI+1
+22 SET BDML=$PIECE($GET(^ATXLAB(BDMTAX,21,BDMDA,0)),U)
+23 SET BDMH=$PIECE($GET(^ATXLAB(BDMTAX,21,BDMDA,0)),U,2)
+24 IF (BDML=BDMH)!($GET(BDMH)="")
Begin DoDot:3
+25 IF $GET(BDMXRF)=""
Begin DoDot:4
+26 SET BDMGRF=BDMGL_""""_BDML_""""_")"
+27 SET ^BDMTMP($JOB,BDMI)=$PIECE($GET(@BDMGRF@(0)),U)_$CHAR(30)
End DoDot:4
QUIT
+28 SET ^BDMTMP($JOB,BDMI)=BDML_$CHAR(30)
End DoDot:3
QUIT
+29 SET BDMGRF=BDMGL_""""_BDMXRF_""")"
+30 NEW BDMIEN
+31 SET BDMIEN=$ORDER(@BDMGRF@(BDML),-1)
+32 FOR
SET BDMIEN=$ORDER(@BDMGRF@(BDMIEN))
IF BDMIEN>BDMH
QUIT
Begin DoDot:3
+33 SET BDMI=BDMI+1
+34 SET ^BDMTMP($JOB,BDMI)=BDMIEN_$CHAR(30)
End DoDot:3
End DoDot:2
End DoDot:1
+35 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)
+36 QUIT
+37 ;
LTAX(BDMRET) ;-- generic lab taxonomy table
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW P,BDMRFL,BDMI,BDMERR,BDMIEN,BDMTAXE,BDMTAX,BDMDA,BDMNONC,BDMXRF
+3 NEW BDMGL,BDMGRF,BDMP,BDMPKG,BDMTDA,BDMPKGI
+4 SET P="|"
+5 KILL ^BDMTMP($JOB)
+6 SET BDMRET="^BDMTMP("_$JOB_")"
+7 SET BDMI=0
+8 SET BDMERR=""
+9 SET BDMPKG=$PIECE(BDMSTR,P,2)
+10 SET BDMPKGI=$ORDER(^DIC(9.4,"C",BDMPKG,0))
+11 SET ^BDMTMP($JOB,BDMI)="T00080LABTAXONOMY"_$CHAR(30)
+12 SET BDMTAX=0
FOR
SET BDMTAX=$ORDER(^ATXLAB("APKG",BDMPKGI,BDMTAX))
IF 'BDMTAX
QUIT
Begin DoDot:1
+13 ;S BDMTAX=0 F S BDMTAX=$O(^ATXLAB(BDMTAX)) Q:'BDMTAX D
+14 ;S BDMTAX=$P($G(^ATXLAB(BDMP,0)),U)
+15 ;Q:$E($P($G(^ATXLAB(BDMTAX,0)),U),1,2)'="DM"
+16 ;S BDMTAXE=$P(BDMSTR,P)
+17 ;S BDMTAX=$O(^ATXLAB("B",BDMTAXE,0))
+18 ;Q:'$G(BDMTAX)
+19 SET BDMXRF=$PIECE($GET(^ATXLAB(BDMTAX,0)),U,8)
+20 IF $GET(BDMXRF)=""
SET BDMXRF="B"
+21 SET BDMFL=$PIECE($GET(^ATXLAB(BDMTAX,0)),U,9)
+22 SET BDMGL=$GET(^DIC(BDMFL,0,"GL"))
+23 SET BDMDA=0
FOR
SET BDMDA=$ORDER(^ATXLAB(BDMTAX,21,BDMDA))
IF 'BDMDA
QUIT
Begin DoDot:2
+24 NEW BDML,BDMH
+25 SET BDMI=BDMI+1
+26 SET BDML=$PIECE($GET(^ATXLAB(BDMTAX,21,BDMDA,0)),U)
+27 SET BDMGRF=BDMGL_""""_BDML_""""_")"
+28 NEW BDMIEN
+29 SET BDMI=BDMI+1
+30 SET ^BDMTMP($JOB,BDMI)=$PIECE($GET(@BDMGRF@(0)),U)_$CHAR(30)
End DoDot:2
End DoDot:1
+31 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)
+32 QUIT
+33 ;
MEDBLD ;-- setup BDMSTR for medication taxonomy
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMTDA,BDMI,BDMPKG,BDMPKGI
+3 SET BDMI=1
+4 SET BDMPKG=$PIECE(BDMSTR,P,2)
+5 SET BDMPKGI=$ORDER(^DIC(9.4,"C",BDMPKG,0))
+6 SET BDMTDA=0
FOR
SET BDMTDA=$ORDER(^ATXAX(BDMTDA))
IF 'BDMTDA
QUIT
Begin DoDot:1
+7 ;S BDMTDA=0 F S BDMTDA=$O(^ATXAX(BDMTDA)) Q:'BDMTDA D
+8 ;Q:$E($P($G(^ATXAX(BDMTDA,0)),U),1,2)'="DM"
+9 IF $PIECE($GET(^ATXAX(BDMTDA,0)),U,15)'=50
QUIT
+10 SET BDMI=BDMI+1
+11 SET $PIECE(BDMSTR,P,BDMI)=$PIECE($GET(^ATXAX(BDMTDA,0)),U)
End DoDot:1
+12 QUIT
+13 ;
GETTAX(BDMRET,BDMSTR) ;-- get taxonomies based on user selection
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMDA,BDMI,P,BDMPKG,BDMPKGI,BDMI
+3 SET P="|"
+4 KILL ^BDMTMP($JOB)
+5 SET BDMRET="^BDMTMP("_$JOB_")"
+6 SET BDMI=0
+7 SET BDMERR=""
+8 SET BDMPKG=$PIECE(BDMSTR,P)
+9 SET BDMPKGI=$ORDER(^DIC(9.4,"C",BDMPKG,0))
+10 SET ^BDMTMP($JOB,BDMI)="T00080TAXONOMIES"_$CHAR(30)
+11 SET BDMDA=0
FOR
SET BDMDA=$ORDER(^ATXAX("APKG",BDMPKGI,BDMDA))
IF 'BDMDA
QUIT
Begin DoDot:1
+12 NEW BDMTAX,BDMRO,BDMFL
+13 SET BDMTAX=$PIECE($GET(^ATXAX(BDMDA,0)),U)
+14 SET BDMRO=$SELECT($PIECE($GET(^ATXAX(BDMDA,0)),U,22):"Read Only",1:"Editable")
+15 SET BDMFL=$PIECE($GET(^ATXAX(BDMDA,0)),U,15)
+16 SET ^BDMTMP("TAX",$JOB,BDMFL,BDMTAX)=BDMRO_U_$SELECT(BDMFL=50:"Med",1:"Tax")
End DoDot:1
+17 SET BDMDA=0
FOR
SET BDMDA=$ORDER(^ATXLAB("APKG",BDMPKGI,BDMDA))
IF 'BDMDA
QUIT
Begin DoDot:1
+18 NEW BDMTAX,BDMRO,BDMFL
+19 SET BDMTAX=$PIECE($GET(^ATXLAB(BDMDA,0)),U)
+20 SET BDMRO=$SELECT($PIECE($GET(^ATXLAB(BDMDA,0)),U,22):"Read Only",1:"Editable")
+21 SET BDMFL=$PIECE($GET(^ATXLAB(BDMDA,0)),U,9)
+22 SET ^BDMTMP("TAX",$JOB,BDMFL,BDMTAX)=BDMRO_U_"Lab"
End DoDot:1
+23 SET BDMDA=0
FOR
SET BDMDA=$ORDER(^BDMTMP("TAX",$JOB,BDMDA))
IF BDMDA=""
QUIT
Begin DoDot:1
+24 NEW BDMIEN
+25 SET BDMIEN=0
FOR
SET BDMIEN=$ORDER(^BDMTMP("TAX",$JOB,BDMDA,BDMIEN))
IF BDMIEN=""
QUIT
Begin DoDot:2
+26 SET BDMI=BDMI+1
+27 SET BDMRO=$GET(^BDMTMP("TAX",$JOB,BDMDA,BDMIEN))
+28 SET ^BDMTMP($JOB,BDMI)=BDMIEN_"("_$PIECE(BDMRO,U)_"/"_$PIECE(BDMRO,U,2)_"/"_BDMDA_")"_$CHAR(30)
End DoDot:2
End DoDot:1
+29 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)
+30 KILL ^BDMTMP("TAX",$JOB)
+31 QUIT
+32 ;
