- 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 ;
