BDMGTC ; cmi/anch/maw - BDM DMS GUI Table Lookup ;
;;2.0;BDM DIABETES MANAGEMENT SYSTEM;**9,10,12**;JUN 14, 2007;Build 51
;
;
TAXPRT(RETVAL,BDMSTR) ;EP -- return Taxonomy list
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMI,BDMYR,BDMX,BDMY,BDMYRI,P
S P="|"
S BDMYRI=$P(BDMSTR,P)
K ^BDMTMP($J)
S RETVAL="^BDMTMP("_$J_")"
S BDMI=0
S ^BDMTMP($J,BDMI)="T00080Taxonomies"_$C(30)
S BDMYR=$O(^BDMTAXS("B",BDMYRI,0))
S BDMX=0,J=0 F S BDMX=$O(^BDMTAXS(BDMYR,11,"B",BDMX)) Q:BDMX="" D
. S BDMY=$O(^BDMTAXS(BDMYR,11,"B",BDMX,0))
. S BDMI=BDMI+1
. S ^BDMTMP($J,BDMI)=BDMX_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)
Q
;
SNOPRT(RETVAL,BDMSTR) ;-- return SNOMED Lists
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMI,BDMYR,BDMX,BDMY,BDMYRI,P
S P="|"
S BDMYRI=$P(BDMSTR,P)
K ^BDMTMP($J)
S RETVAL="^BDMTMP("_$J_")"
S BDMI=0
S ^BDMTMP($J,BDMI)="T00080SNOMED"_$C(30)
S BDMYR=$O(^BDMSNME("B",BDMYRI,0))
S BDMX=0,J=0 F S BDMX=$O(^BDMSNME(BDMYR,11,"B",BDMX)) Q:BDMX="" D
. S BDMI=BDMI+1
. S ^BDMTMP($J,BDMI)=BDMX_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)
Q
;
TAXPRTS(RETVAL,BDMSTR) ;EP -- return Taxonomy items
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMI,BDMYR,BDMX,BDMY,P,BDMTAX
K ^BDMTMP($J)
S RETVAL="^BDMTMP("_$J_")"
S BDMI=0,P="|"
S BDMTAX=$P(BDMSTR,P)
S BDMTAXI=$O(^ATXAX("B",BDMTAX,0))
I BDMTAXI S BDMTAXT="T"
I 'BDMTAXI S BDMTAXI=$O(^ATXLAB("B",BDMTAX,0)),BDMTAXT="L"
D GUIR^XBLM("PRINT^BDMDDTV","^XTMP(""BDMTAX"",$J)")
S ^BDMTMP($J,BDMI)="T00250Data"_$C(30)
I '$D(^XTMP("BDMTAX",$J)) D Q
. S BDMI=BDMI+1
. S ^BDMTMP($J,BDMI)="NO DATA"_$C(30)
. S ^BDMTMP($J,BDMI+1)=$C(31)
S BDMDA=.5 F S BDMDA=$O(^XTMP("BDMTAX",$J,BDMDA)) Q:'BDMDA D
. N BDMDATA
. S BDMI=BDMI+1
. S BDMDATA=$G(^XTMP("BDMTAX",$J,BDMDA))
. S ^BDMTMP($J,BDMI)=BDMDATA_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)
K ^XTMP("BDMTAX",$J),BDMTAXI
Q
;
SNOPRTS(RETVAL,BDMSTR) ;-- return SNOMED ITEMS
S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap
N BDMI,BDMYR,BDMX,BDMY,P,BDMTAX,BDMYRI
K ^BDMTMP($J)
S RETVAL="^BDMTMP("_$J_")"
S BDMI=0,P="|"
S BDMTAX=$P(BDMSTR,P)
S BDMYRI=$P(BDMSTR,P,2)
S ^BDMTMP($J,BDMI)="T00250Data"_$C(30)
S BDMYR=$O(^BDMSNME("B",BDMYRI,0))
S BDMTAXT=$O(^BDMSNME(BDMYR,11,"B",BDMTAX,0))
S BDMTAXI=BDMYR
S BDMTAXN=$P(^BDMSNME(BDMYR,11,BDMTAXT,0),U,1)
S BDMX=0
D GUIR^XBLM("PRINT^BDMDDTSN","^XTMP(""BDMSNO"",$J)")
I '$D(^XTMP("BDMSNO",$J)) D Q
. S BDMI=BDMI+1
. S ^BDMTMP($J,BDMI)="NO DATA"_$C(30)
. S ^BDMTMP($J,BDMI+1)=$C(31)
S BDMDA=.5 F S BDMDA=$O(^XTMP("BDMSNO",$J,BDMDA)) Q:'BDMDA D
. N BDMDATA
. S BDMI=BDMI+1
. S BDMDATA=$G(^XTMP("BDMSNO",$J,BDMDA))
. S ^BDMTMP($J,BDMI)=BDMDATA_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)
K ^XTMP("BDMSNO",$J),BDMTAXI,BDMTAXN,BDMTAXT,BDMX
Q
;
TUENDS(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,10)'="ELECTRONIC"
. 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
;
BDMGTC ; cmi/anch/maw - BDM DMS GUI Table Lookup ;
+1 ;;2.0;BDM DIABETES MANAGEMENT SYSTEM;**9,10,12**;JUN 14, 2007;Build 51
+2 ;
+3 ;
TAXPRT(RETVAL,BDMSTR) ;EP -- return Taxonomy list
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMI,BDMYR,BDMX,BDMY,BDMYRI,P
+3 SET P="|"
+4 SET BDMYRI=$PIECE(BDMSTR,P)
+5 KILL ^BDMTMP($JOB)
+6 SET RETVAL="^BDMTMP("_$JOB_")"
+7 SET BDMI=0
+8 SET ^BDMTMP($JOB,BDMI)="T00080Taxonomies"_$CHAR(30)
+9 SET BDMYR=$ORDER(^BDMTAXS("B",BDMYRI,0))
+10 SET BDMX=0
SET J=0
FOR
SET BDMX=$ORDER(^BDMTAXS(BDMYR,11,"B",BDMX))
IF BDMX=""
QUIT
Begin DoDot:1
+11 SET BDMY=$ORDER(^BDMTAXS(BDMYR,11,"B",BDMX,0))
+12 SET BDMI=BDMI+1
+13 SET ^BDMTMP($JOB,BDMI)=BDMX_$CHAR(30)
End DoDot:1
+14 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)
+15 QUIT
+16 ;
SNOPRT(RETVAL,BDMSTR) ;-- return SNOMED Lists
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMI,BDMYR,BDMX,BDMY,BDMYRI,P
+3 SET P="|"
+4 SET BDMYRI=$PIECE(BDMSTR,P)
+5 KILL ^BDMTMP($JOB)
+6 SET RETVAL="^BDMTMP("_$JOB_")"
+7 SET BDMI=0
+8 SET ^BDMTMP($JOB,BDMI)="T00080SNOMED"_$CHAR(30)
+9 SET BDMYR=$ORDER(^BDMSNME("B",BDMYRI,0))
+10 SET BDMX=0
SET J=0
FOR
SET BDMX=$ORDER(^BDMSNME(BDMYR,11,"B",BDMX))
IF BDMX=""
QUIT
Begin DoDot:1
+11 SET BDMI=BDMI+1
+12 SET ^BDMTMP($JOB,BDMI)=BDMX_$CHAR(30)
End DoDot:1
+13 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)
+14 QUIT
+15 ;
TAXPRTS(RETVAL,BDMSTR) ;EP -- return Taxonomy items
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMI,BDMYR,BDMX,BDMY,P,BDMTAX
+3 KILL ^BDMTMP($JOB)
+4 SET RETVAL="^BDMTMP("_$JOB_")"
+5 SET BDMI=0
SET P="|"
+6 SET BDMTAX=$PIECE(BDMSTR,P)
+7 SET BDMTAXI=$ORDER(^ATXAX("B",BDMTAX,0))
+8 IF BDMTAXI
SET BDMTAXT="T"
+9 IF 'BDMTAXI
SET BDMTAXI=$ORDER(^ATXLAB("B",BDMTAX,0))
SET BDMTAXT="L"
+10 DO GUIR^XBLM("PRINT^BDMDDTV","^XTMP(""BDMTAX"",$J)")
+11 SET ^BDMTMP($JOB,BDMI)="T00250Data"_$CHAR(30)
+12 IF '$DATA(^XTMP("BDMTAX",$JOB))
Begin DoDot:1
+13 SET BDMI=BDMI+1
+14 SET ^BDMTMP($JOB,BDMI)="NO DATA"_$CHAR(30)
+15 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)
End DoDot:1
QUIT
+16 SET BDMDA=.5
FOR
SET BDMDA=$ORDER(^XTMP("BDMTAX",$JOB,BDMDA))
IF 'BDMDA
QUIT
Begin DoDot:1
+17 NEW BDMDATA
+18 SET BDMI=BDMI+1
+19 SET BDMDATA=$GET(^XTMP("BDMTAX",$JOB,BDMDA))
+20 SET ^BDMTMP($JOB,BDMI)=BDMDATA_$CHAR(30)
End DoDot:1
+21 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)
+22 KILL ^XTMP("BDMTAX",$JOB),BDMTAXI
+23 QUIT
+24 ;
SNOPRTS(RETVAL,BDMSTR) ;-- return SNOMED ITEMS
+1 ; m error trap
SET X="MERR^BDMGU"
SET @^%ZOSF("TRAP")
+2 NEW BDMI,BDMYR,BDMX,BDMY,P,BDMTAX,BDMYRI
+3 KILL ^BDMTMP($JOB)
+4 SET RETVAL="^BDMTMP("_$JOB_")"
+5 SET BDMI=0
SET P="|"
+6 SET BDMTAX=$PIECE(BDMSTR,P)
+7 SET BDMYRI=$PIECE(BDMSTR,P,2)
+8 SET ^BDMTMP($JOB,BDMI)="T00250Data"_$CHAR(30)
+9 SET BDMYR=$ORDER(^BDMSNME("B",BDMYRI,0))
+10 SET BDMTAXT=$ORDER(^BDMSNME(BDMYR,11,"B",BDMTAX,0))
+11 SET BDMTAXI=BDMYR
+12 SET BDMTAXN=$PIECE(^BDMSNME(BDMYR,11,BDMTAXT,0),U,1)
+13 SET BDMX=0
+14 DO GUIR^XBLM("PRINT^BDMDDTSN","^XTMP(""BDMSNO"",$J)")
+15 IF '$DATA(^XTMP("BDMSNO",$JOB))
Begin DoDot:1
+16 SET BDMI=BDMI+1
+17 SET ^BDMTMP($JOB,BDMI)="NO DATA"_$CHAR(30)
+18 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)
End DoDot:1
QUIT
+19 SET BDMDA=.5
FOR
SET BDMDA=$ORDER(^XTMP("BDMSNO",$JOB,BDMDA))
IF 'BDMDA
QUIT
Begin DoDot:1
+20 NEW BDMDATA
+21 SET BDMI=BDMI+1
+22 SET BDMDATA=$GET(^XTMP("BDMSNO",$JOB,BDMDA))
+23 SET ^BDMTMP($JOB,BDMI)=BDMDATA_$CHAR(30)
End DoDot:1
+24 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)
+25 KILL ^XTMP("BDMSNO",$JOB),BDMTAXI,BDMTAXN,BDMTAXT,BDMX
+26 QUIT
+27 ;
TUENDS(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,10)'="ELECTRONIC"
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 ;
