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