BDMGTB.m

BDMGTB ; cmi/anch/maw - BDM DMS GUI Table Lookup ;

 ;;2.0;BDM DIABETES MANAGEMENT SYSTEM;**1,8,12**;JUN 14, 2007;Build 51

 ;

 ;

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

 ;

CPT(BDMRET) ;-- get all cpts

 S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap

 N BDMCPT,BDMI,BDMERR,BDMIEN,BDMDA,BDMCPTD

 K ^BDMTMP($J)

 S BDMRET="^BDMTMP("_$J_")"

 S BDMI=0

 S BDMERR=""

 S ^BDMTMP($J,BDMI)="T00050CPT"_$C(30)

 S BDMDA=0 F  S BDMDA=$O(^ICPT(BDMDA)) Q:BDMDA=""  D

 . Q:$P($G(^ICPT(BDMDA,0)),U,4)  ;inactive

 . S BDMCPT=$P($G(^ICPT(BDMDA,0)),U)

 . S BDMCPTD=$P($G(^ICPT(BDMDA,0)),U,2)

 . S BDMI=BDMI+1

 . S ^BDMTMP($J,BDMI)=BDMCPT_"-"_BDMCPTD_$C(30)

 S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)

 Q

 ;

ADA(BDMRET) ;-- get all ada

 S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap

 N BDMADA,BDMI,BDMERR,BDMIEN,BDMDA,BDMADAD

 K ^BDMTMP($J)

 S BDMRET="^BDMTMP("_$J_")"

 S BDMI=0

 S BDMERR=""

 S ^BDMTMP($J,BDMI)="T00050ADA"_$C(30)

 S BDMDA=0 F  S BDMDA=$O(^AUTTADA(BDMDA)) Q:BDMDA=""  D

 . Q:$P($G(^AUTTADA(BDMDA,0)),U,8)  ;inactive

 . S BDMADA=$P($G(^AUTTADA(BDMDA,0)),U)

 . S BDMADAD=$P($G(^AUTTADA(BDMDA,0)),U,2)

 . S BDMI=BDMI+1

 . S ^BDMTMP($J,BDMI)=BDMADA_"-"_BDMADAD_$C(30)

 S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)

 Q

 ;

PRV(BDMRET) ;-- get all providers

 S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap

 N BDMPRV,BDMI,BDMERR,BDMIEN,BDMDA

 K ^BDMTMP($J)

 S BDMRET="^BDMTMP("_$J_")"

 S BDMI=0

 S BDMERR=""

 S ^BDMTMP($J,BDMI)="T00007BMXIEN^T00050PRV"_$C(30)

 S BDMDA=0 F  S BDMDA=$O(^VA(200,"B",BDMDA)) Q:BDMDA=""  D

 . S BDMIEN=0 F  S BDMIEN=$O(^VA(200,"B",BDMDA,BDMIEN)) Q:'BDMIEN  D

 .. Q:'$O(^VA(200,"AK.PROVIDER",BDMDA,0))  ;not a provider

 .. S BDMPRV=$P($G(^VA(200,BDMIEN,0)),U)

 .. S BDMI=BDMI+1

 .. S ^BDMTMP($J,BDMI)=BDMIEN_U_BDMPRV_$C(30)

 S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)

 Q

 ;

PRVC(BDMRET) ;-- get all provider classes

 S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap

 N BDMPRVC,BDMI,BDMERR,BDMDA

 K ^BDMTMP($J)

 S BDMRET="^BDMTMP("_$J_")"

 S BDMI=0

 S BDMERR=""

 S ^BDMTMP($J,BDMI)="T00050PRVC"_$C(30)

 S BDMDA=0 F  S BDMDA=$O(^DIC(7,"B",BDMDA)) Q:BDMDA=""  D

 . ;S BDMPRVC=$P($G(^DIC(7,BDMDA,0)),U)

 . S BDMI=BDMI+1

 . S ^BDMTMP($J,BDMI)=BDMDA_$C(30)

 S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)

 Q

 ;

LABL(BDMRET) ;-- get all lab loinc codes

 S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap

 N BDMLABL,BDMI,BDMERR,BDMIEN,BDMDA,BDMLABD

 K ^BDMTMP($J)

 S BDMRET="^BDMTMP("_$J_")"

 S BDMI=0

 S BDMERR=""

 S ^BDMTMP($J,BDMI)="T00050LABL"_$C(30)

 S BDMDA=0 F  S BDMDA=$O(^LAB(95.3,"B",BDMDA)) Q:BDMDA=""  D

 . S BDMIEN=0 F  S BDMIEN=$O(^LAB(95.3,"B",BDMDA,BDMIEN)) Q:'BDMIEN  D

 .. S BDMLABL=$P($G(^LAB(95.3,BDMDA,0)),U)

 .. S BDMLABD=$G(^LAB(95.3,BDMIEN,80))

 .. S BDMI=BDMI+1

 .. S ^BDMTMP($J,BDMI)=BDMLABL_"-"_BDMLABD_$C(30)

 S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)

 Q

 ;

DENO(BDMRET) ;-- get all dental op site codes

 S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap

 N BDMDENO,BDMI,BDMERR,BDMIEN,BDMDA

 K ^BDMTMP($J)

 S BDMRET="^BDMTMP("_$J_")"

 S BDMI=0

 S BDMERR=""

 S ^BDMTMP($J,BDMI)="T00050DENO^T00007IEN"_$C(30)

 S BDMDA=0 F  S BDMDA=$O(^ADEOPS("B",BDMDA)) Q:BDMDA=""  D

 . S BDMIEN=0 F  S BDMIEN=$O(^ADEOPS("B",BDMDA,BDMIEN)) Q:'BDMIEN  D

 .. S BDMDENO=$P($G(^ADEOPS(BDMIEN,0)),U)

 .. S BDMI=BDMI+1

 .. S ^BDMTMP($J,BDMI)=BDMDENO_U_BDMIEN_$C(30)

 S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)

 Q

 ;

CLN(BDMRET) ;-- get all clinic stop codes

 S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap

 N BDMCLN,BDMI,BDMERR,BDMIEN,BDMDA

 K ^BDMTMP($J)

 S BDMRET="^BDMTMP("_$J_")"

 S BDMI=0

 S BDMERR=""

 S ^BDMTMP($J,BDMI)="T00050CLN"_$C(30)

 S BDMDA=0 F  S BDMDA=$O(^DIC(40.7,"B",BDMDA)) Q:BDMDA=""  D

 . ;S BDMLABL=$P($G(^LAB(95.3,BDMDA,0)),U)

 . S BDMI=BDMI+1

 . S ^BDMTMP($J,BDMI)=BDMDA_$C(30)

 S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)

 Q

 ;

ICDO(BDMRET) ;-- get all icd operation and procedure codes

 S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap

 N BDMICDO,BDMICDD,BDMI,BDMERR,BDMIEN,BDMDA

 K ^BDMTMP($J)

 S BDMRET="^BDMTMP("_$J_")"

 S BDMI=0

 S BDMERR=""

 S ^BDMTMP($J,BDMI)="T00050ICDO^T00007IEN"_$C(30)

 S BDMDA=0 F  S BDMDA=$O(^ICD0(BDMDA)) Q:'BDMDA  D

 . S BDMICD0=$P($G(^ICD0(BDMDA,0)),U)

 . S BDMICDD=$P($G(^ICD0(BDMDA,0)),U,4)

 . S BDMI=BDMI+1

 . S ^BDMTMP($J,BDMI)=BDMICD0_"-"_BDMICDD_U_BDMDA_$C(30)

 S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)

 Q

 ;

COM(BDMRET) ;-- get all communities

 S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap

 N BDMCOM,BDMCOMS,BDMI,BDMERR,BDMIEN,BDMDA

 K ^BDMTMP($J)

 S BDMRET="^BDMTMP("_$J_")"

 S BDMI=0

 S BDMERR=""

 S ^BDMTMP($J,BDMI)="T00050CLN^T00007IEN"_$C(30)

 S BDMDA=0 F  S BDMDA=$O(^AUTTCOM("B",BDMDA)) Q:BDMDA=""  D

 . S BDMIEN=0 F  S BDMIEN=$O(^AUTTCOM("B",BDMDA,BDMIEN)) Q:'BDMIEN  D

 .. S BDMCOM=$P($G(^AUTTCOM(BDMIEN,0)),U)

 .. S BDMCOMS=$S($P($G(^AUTTCOM(BDMIEN,0)),U,3):$P($G(^DIC(5,$P($G(^AUTTCOM(BDMIEN,0)),U,3),0)),U,2),1:"")

 .. S BDMI=BDMI+1

 .. S ^BDMTMP($J,BDMI)=BDMCOM_"-"_BDMCOMS_U_BDMIEN_$C(30)

 S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)

 Q

 ;

FILES(BDMRET) ;-- get all RPMS Files

 S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap

 N BDMFLS,BDMI,BDMERR,BDMIEN,BDMDA

 K ^BDMTMP($J)

 S BDMRET="^BDMTMP("_$J_")"

 S BDMI=0

 S BDMERR=""

 S ^BDMTMP($J,BDMI)="T00050FILENUMBER^T00050FILENAME"_$C(30)

 S BDMDA=0 F  S BDMDA=$O(^DIC(BDMDA)) Q:'BDMDA  D

 . S BDMFLS=$P($G(^DIC(BDMDA,0)),U)

 . S BDMI=BDMI+1

 . S ^BDMTMP($J,BDMI)=BDMDA_U_BDMFLS_$C(30)

 S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)

 Q

 ;

GETTABLE(BDMRET,BDMSTR) ;-- get a table based upon file number and flds passed in

 S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap

 N BDMFLS,BDMI,BDMERR,BDMIEN,BDMDA,P,R

 S P="|",R="~"

 S BDMFN=$P(BDMSTR,P)

 S BDFLDN=$P(BDMSTR,P,2)

 S BDMXRF=$P(BDMSTR,P,3)

 K ^BDMTMP($J)

 S BDMRET="^BDMTMP("_$J_")"

 S BDMI=0

 S BDMERR=""

 S ^BDMTMP($J,BDMI)="T00050FILENUMBER^T00050FILENAME"_$C(30)

 S BDMDA=0 F  S BDMDA=$O(^DIC(BDMDA)) Q:'BDMDA  D

 . S BDMFLS=$P($G(^DIC(BDMDA,0)),U)

 . S BDMI=BDMI+1

 . S ^BDMTMP($J,BDMI)=BDMDA_U_BDMFLS_$C(30)

 S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)

 Q

 ;

STMP(BDMRET) ;-- return the search template screen

 S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap

 N BDMFLS,BDMI,BDMERR,BDMIEN,BDMDA,P,R

 K ^BDMTMP($J)

 S BDMRET="^BDMTMP("_$J_")"

 S BDMI=0

 S BDMERR=""

 S ^BDMTMP($J,BDMI)="T00050SEARCHTEMPLATE"_$C(30)

 N BDMDA

 S BDMDA=0 F  S BDMDA=$O(^DIBT("B",BDMDA)) Q:BDMDA=""  D

 . N BDMIEN

 . S BDMIEN=0 F  S BDMIEN=$O(^DIBT("B",BDMDA,BDMIEN)) Q:'BDMIEN  D

 .. Q:'$D(^DIBT(BDMIEN,1))

 .. S BDMI=BDMI+1

 .. S ^BDMTMP($J,BDMI)=BDMDA_$C(30)

 S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)

 Q

 ;

REGADO(BDMRET) ;-- return register to work with

 S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap

 N BDMDA,BDMC,BDMREG

 S BDMC=0

 K ^BDMTMP($J)

 S BDMRET="^BDMTMP("_$J_")"

 S ^BDMTMP($J,BDMC)="T00030REGISTERNAME"_$C(30)

 S BDMDA=0 F  S BDMDA=$O(^ACM(41.1,"B",BDMDA)) Q:BDMDA=""  D

 . Q:BDMDA'["DIAB"

 . S BDMRIEN=$O(^ACM(41.1,"B",BDMDA,0))

 . ;Q:'$D(^ACM(41.1,BDMRIEN,"AU","B",DUZ))

 . S BDMC=BDMC+1

 . S ^BDMTMP($J,BDMC)=BDMDA_$C(30)

 S ^BDMTMP($J,BDMC+1)=$C(31)_$G(BDMERR)

 Q

 ;

REGADOAU(BDMRET) ;-- return register to work with

 S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap

 N BDMDA,BDMC,BDMREG

 S BDMC=0

 K ^BDMTMP($J)

 S BDMRET="^BDMTMP("_$J_")"

 S ^BDMTMP($J,BDMC)="T00007BMXIEN^T00030REGISTER NAME"_$C(30)

 S BDMDA=0 F  S BDMDA=$O(^ACM(41.1,"B",BDMDA)) Q:BDMDA=""  D

 . Q:BDMDA'["DIAB"

 . S BDMRIEN=$O(^ACM(41.1,"B",BDMDA,0))

 . Q:'$D(^ACM(41.1,BDMRIEN,"AU","B",DUZ))

 . S BDMC=BDMC+1

 . S ^BDMTMP($J,BDMC)=BDMRIEN_U_BDMDA_$C(30)

 S ^BDMTMP($J,BDMC+1)=$C(31)_$G(BDMERR)

 Q

 ;

AU(BDMRET,BDMSTR) ;-- returns a list of Authorized Users

 N P,BDMDA,BDMREGE,BDMREG,BDMMKEY,BDMMGR,BDMI

 S P="|"

 S BDMI=0

 K ^BDMTMP($J)

 S BDMRET="^BDMTMP("_$J_")"

 S ^BDMTMP($J,BDMI)="T00010BMXIEN^T00050User^T00001Manager Authority"_$C(30)

 S BDMREGE=$P(BDMSTR,P)

 S BDMREG=$O(^ACM(41.1,"B",BDMREGE,0))

 S BDMMKEY=$O(^DIC(19.1,"B","BDMZ REGISTER MAINTENANCE",0))

 S BDMDA=0 F  S BDMDA=$O(^ACM(41.1,BDMREG,"AU",BDMDA)) Q:'BDMDA  D

 . S BDMMGR=0

 . S BDMI=BDMI+1

 . I $D(^VA(200,BDMDA,51,"B",BDMMKEY)) S BDMMGR=1

 . S ^BDMTMP($J,BDMI)=BDMDA_U_$P($G(^VA(200,BDMDA,0)),U)_U_$S(BDMMGR:"Y",1:"N")_$C(30)

 S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)

 Q

 ;

STMPS(BDMRET) ;-- return search template with screen

 S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap

 N BDMFLS,BDMI,BDMERR,BDMIEN,BDMDA,P,R

 K ^BDMTMP($J)

 S BDMRET="^BDMTMP("_$J_")"

 S BDMI=0

 S BDMERR=""

 S ^BDMTMP($J,BDMI)="T00050Search Template"_$C(30)

 N BDMDA

 S BDMDA=0 F  S BDMDA=$O(^DIBT("B",BDMDA)) Q:BDMDA=""  D

 . N BDMIEN

 . S BDMIEN=0 F  S BDMIEN=$O(^DIBT("B",BDMDA,BDMIEN)) Q:'BDMIEN  D

 .. N BDMOK

 .. S BDMOK=0

 .. I $P($G(^DIBT(BDMIEN,0)),U,4)=2 S BDMOK=1

 .. I $P($G(^DIBT(BDMIEN,0)),U,4)=9000001 S BDMOK=1

 .. Q:'BDMOK

 .. Q:'$D(^DIBT(BDMIEN,1))

 .. S BDMI=BDMI+1

 .. S ^BDMTMP($J,BDMI)=BDMDA_$C(30)

 S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)

 Q

 ;

CMPI(BDMRET,BDMSTR) ;-- return complications with IEN

 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)="T00010BMXIEN^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)=BDMCMP_U_BDMCMPE_$C(30)

 S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)

 Q

 ;

DX(RETVAL,BDMSTR)  ;-- get DX based on Search string

 S X="MERR^BDMGU",@^%ZOSF("TRAP") ; m error trap

 N P,BDMI,BDMS,BDMTGT,BDMIDX

 K ^BDMTMP($J)

 S RETVAL="^BDMTMP("_$J_")"

 S BDMI=0

 S @RETVAL@(BDMI)="T00010BMXIEN^T00010DX^T00250Description"_$C(30)

 S P="|"

 K ^BDMTMPD($J)

 S BDMTGT="^BDMTMPD("_$J_")"  ;target for find^dic lookup

 S BDMIDX=$P(BDMSTR,P,2)

 I BDMIDX]"" S BDMIDX=$TR(BDMIDX,"*","^")

 S BDMS=$P(BDMSTR,P)

 I BDMS="" D

 . D LIST^DIC(80,"",.01,"","","",BDMS,BDMIDX,"","",BDMTGT,"BDMERRR(1)")

 I BDMS]"" D

 . S X=BDMS X ^%ZOSF("UPPERCASE") S BDMS=Y  ;cmi/maw 03/05/2014 p4 change all to uppercase

 . D FIND^DIC(80,"",.01,"",BDMS,"",BDMIDX,"","",BDMTGT,"BDMERRR(1)")

 S BDMDA=0  F  S BDMDA=$O(@BDMTGT@("DILIST","ID",BDMDA)) Q:'BDMDA  D

 . N BDMIEN,BDMBMX,BDMDESC,BDMDX

 . S BDMIEN=0 F  S BDMIEN=$O(@BDMTGT@("DILIST","ID",BDMDA,BDMIEN)) Q:'BDMIEN  D

 .. S BDMBMX=$G(@BDMTGT@("DILIST",2,BDMDA))

 .. S BDMDX=$G(@BDMTGT@("DILIST","ID",BDMDA,BDMIEN))

 .. I $D(^ICDS(0)) S BDMDX=$$ICDDX^ICDEX(BDMDX,DT)

 .. I '$D(^ICDS(0)) S BDMDX=$$ICDDX^ICDCODE(BDMDX,DT)

 .. S BDMDESC=""

 .. Q:'$G(BDMBMX)

 .. S BDMI=BDMI+1

 .. S @RETVAL@(BDMI)=BDMBMX_U_$P(BDMDX,U,2)_U_$P(BDMDX,U,4)_$C(30)

 S @RETVAL@(BDMI+1)=$C(31)

 Q

 Q

 ;

BDMGTB    ; cmi/anch/maw - BDM DMS GUI Table Lookup ;

 +1       ;;2.0;BDM DIABETES MANAGEMENT SYSTEM;**1,8,12**;JUN 14, 2007;Build 51

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

CPT(BDMRET) ;-- get all cpts

 +1       ; m error trap

           SET X="MERR^BDMGU"

           SET @^%ZOSF("TRAP")

 +2        NEW BDMCPT,BDMI,BDMERR,BDMIEN,BDMDA,BDMCPTD

 +3        KILL ^BDMTMP($JOB)

 +4        SET BDMRET="^BDMTMP("_$JOB_")"

 +5        SET BDMI=0

 +6        SET BDMERR=""

 +7        SET ^BDMTMP($JOB,BDMI)="T00050CPT"_$CHAR(30)

 +8        SET BDMDA=0

           FOR 

               SET BDMDA=$ORDER(^ICPT(BDMDA))

               IF BDMDA=""

                   QUIT 

               Begin DoDot:1

 +9       ;inactive

                   IF $PIECE($GET(^ICPT(BDMDA,0)),U,4)

                       QUIT 

 +10               SET BDMCPT=$PIECE($GET(^ICPT(BDMDA,0)),U)

 +11               SET BDMCPTD=$PIECE($GET(^ICPT(BDMDA,0)),U,2)

 +12               SET BDMI=BDMI+1

 +13               SET ^BDMTMP($JOB,BDMI)=BDMCPT_"-"_BDMCPTD_$CHAR(30)

               End DoDot:1

 +14       SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)

 +15       QUIT 

 +16      ;

ADA(BDMRET) ;-- get all ada

 +1       ; m error trap

           SET X="MERR^BDMGU"

           SET @^%ZOSF("TRAP")

 +2        NEW BDMADA,BDMI,BDMERR,BDMIEN,BDMDA,BDMADAD

 +3        KILL ^BDMTMP($JOB)

 +4        SET BDMRET="^BDMTMP("_$JOB_")"

 +5        SET BDMI=0

 +6        SET BDMERR=""

 +7        SET ^BDMTMP($JOB,BDMI)="T00050ADA"_$CHAR(30)

 +8        SET BDMDA=0

           FOR 

               SET BDMDA=$ORDER(^AUTTADA(BDMDA))

               IF BDMDA=""

                   QUIT 

               Begin DoDot:1

 +9       ;inactive

                   IF $PIECE($GET(^AUTTADA(BDMDA,0)),U,8)

                       QUIT 

 +10               SET BDMADA=$PIECE($GET(^AUTTADA(BDMDA,0)),U)

 +11               SET BDMADAD=$PIECE($GET(^AUTTADA(BDMDA,0)),U,2)

 +12               SET BDMI=BDMI+1

 +13               SET ^BDMTMP($JOB,BDMI)=BDMADA_"-"_BDMADAD_$CHAR(30)

               End DoDot:1

 +14       SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)

 +15       QUIT 

 +16      ;

PRV(BDMRET) ;-- get all providers

 +1       ; m error trap

           SET X="MERR^BDMGU"

           SET @^%ZOSF("TRAP")

 +2        NEW BDMPRV,BDMI,BDMERR,BDMIEN,BDMDA

 +3        KILL ^BDMTMP($JOB)

 +4        SET BDMRET="^BDMTMP("_$JOB_")"

 +5        SET BDMI=0

 +6        SET BDMERR=""

 +7        SET ^BDMTMP($JOB,BDMI)="T00007BMXIEN^T00050PRV"_$CHAR(30)

 +8        SET BDMDA=0

           FOR 

               SET BDMDA=$ORDER(^VA(200,"B",BDMDA))

               IF BDMDA=""

                   QUIT 

               Begin DoDot:1

 +9                SET BDMIEN=0

                   FOR 

                       SET BDMIEN=$ORDER(^VA(200,"B",BDMDA,BDMIEN))

                       IF 'BDMIEN

                           QUIT 

                       Begin DoDot:2

 +10      ;not a provider

                           IF '$ORDER(^VA(200,"AK.PROVIDER",BDMDA,0))

                               QUIT 

 +11                       SET BDMPRV=$PIECE($GET(^VA(200,BDMIEN,0)),U)

 +12                       SET BDMI=BDMI+1

 +13                       SET ^BDMTMP($JOB,BDMI)=BDMIEN_U_BDMPRV_$CHAR(30)

                       End DoDot:2

               End DoDot:1

 +14       SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)

 +15       QUIT 

 +16      ;

PRVC(BDMRET) ;-- get all provider classes

 +1       ; m error trap

           SET X="MERR^BDMGU"

           SET @^%ZOSF("TRAP")

 +2        NEW BDMPRVC,BDMI,BDMERR,BDMDA

 +3        KILL ^BDMTMP($JOB)

 +4        SET BDMRET="^BDMTMP("_$JOB_")"

 +5        SET BDMI=0

 +6        SET BDMERR=""

 +7        SET ^BDMTMP($JOB,BDMI)="T00050PRVC"_$CHAR(30)

 +8        SET BDMDA=0

           FOR 

               SET BDMDA=$ORDER(^DIC(7,"B",BDMDA))

               IF BDMDA=""

                   QUIT 

               Begin DoDot:1

 +9       ;S BDMPRVC=$P($G(^DIC(7,BDMDA,0)),U)

 +10               SET BDMI=BDMI+1

 +11               SET ^BDMTMP($JOB,BDMI)=BDMDA_$CHAR(30)

               End DoDot:1

 +12       SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)

 +13       QUIT 

 +14      ;

LABL(BDMRET) ;-- get all lab loinc codes

 +1       ; m error trap

           SET X="MERR^BDMGU"

           SET @^%ZOSF("TRAP")

 +2        NEW BDMLABL,BDMI,BDMERR,BDMIEN,BDMDA,BDMLABD

 +3        KILL ^BDMTMP($JOB)

 +4        SET BDMRET="^BDMTMP("_$JOB_")"

 +5        SET BDMI=0

 +6        SET BDMERR=""

 +7        SET ^BDMTMP($JOB,BDMI)="T00050LABL"_$CHAR(30)

 +8        SET BDMDA=0

           FOR 

               SET BDMDA=$ORDER(^LAB(95.3,"B",BDMDA))

               IF BDMDA=""

                   QUIT 

               Begin DoDot:1

 +9                SET BDMIEN=0

                   FOR 

                       SET BDMIEN=$ORDER(^LAB(95.3,"B",BDMDA,BDMIEN))

                       IF 'BDMIEN

                           QUIT 

                       Begin DoDot:2

 +10                       SET BDMLABL=$PIECE($GET(^LAB(95.3,BDMDA,0)),U)

 +11                       SET BDMLABD=$GET(^LAB(95.3,BDMIEN,80))

 +12                       SET BDMI=BDMI+1

 +13                       SET ^BDMTMP($JOB,BDMI)=BDMLABL_"-"_BDMLABD_$CHAR(30)

                       End DoDot:2

               End DoDot:1

 +14       SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)

 +15       QUIT 

 +16      ;

DENO(BDMRET) ;-- get all dental op site codes

 +1       ; m error trap

           SET X="MERR^BDMGU"

           SET @^%ZOSF("TRAP")

 +2        NEW BDMDENO,BDMI,BDMERR,BDMIEN,BDMDA

 +3        KILL ^BDMTMP($JOB)

 +4        SET BDMRET="^BDMTMP("_$JOB_")"

 +5        SET BDMI=0

 +6        SET BDMERR=""

 +7        SET ^BDMTMP($JOB,BDMI)="T00050DENO^T00007IEN"_$CHAR(30)

 +8        SET BDMDA=0

           FOR 

               SET BDMDA=$ORDER(^ADEOPS("B",BDMDA))

               IF BDMDA=""

                   QUIT 

               Begin DoDot:1

 +9                SET BDMIEN=0

                   FOR 

                       SET BDMIEN=$ORDER(^ADEOPS("B",BDMDA,BDMIEN))

                       IF 'BDMIEN

                           QUIT 

                       Begin DoDot:2

 +10                       SET BDMDENO=$PIECE($GET(^ADEOPS(BDMIEN,0)),U)

 +11                       SET BDMI=BDMI+1

 +12                       SET ^BDMTMP($JOB,BDMI)=BDMDENO_U_BDMIEN_$CHAR(30)

                       End DoDot:2

               End DoDot:1

 +13       SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)

 +14       QUIT 

 +15      ;

CLN(BDMRET) ;-- get all clinic stop codes

 +1       ; m error trap

           SET X="MERR^BDMGU"

           SET @^%ZOSF("TRAP")

 +2        NEW BDMCLN,BDMI,BDMERR,BDMIEN,BDMDA

 +3        KILL ^BDMTMP($JOB)

 +4        SET BDMRET="^BDMTMP("_$JOB_")"

 +5        SET BDMI=0

 +6        SET BDMERR=""

 +7        SET ^BDMTMP($JOB,BDMI)="T00050CLN"_$CHAR(30)

 +8        SET BDMDA=0

           FOR 

               SET BDMDA=$ORDER(^DIC(40.7,"B",BDMDA))

               IF BDMDA=""

                   QUIT 

               Begin DoDot:1

 +9       ;S BDMLABL=$P($G(^LAB(95.3,BDMDA,0)),U)

 +10               SET BDMI=BDMI+1

 +11               SET ^BDMTMP($JOB,BDMI)=BDMDA_$CHAR(30)

               End DoDot:1

 +12       SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)

 +13       QUIT 

 +14      ;

ICDO(BDMRET) ;-- get all icd operation and procedure codes

 +1       ; m error trap

           SET X="MERR^BDMGU"

           SET @^%ZOSF("TRAP")

 +2        NEW BDMICDO,BDMICDD,BDMI,BDMERR,BDMIEN,BDMDA

 +3        KILL ^BDMTMP($JOB)

 +4        SET BDMRET="^BDMTMP("_$JOB_")"

 +5        SET BDMI=0

 +6        SET BDMERR=""

 +7        SET ^BDMTMP($JOB,BDMI)="T00050ICDO^T00007IEN"_$CHAR(30)

 +8        SET BDMDA=0

           FOR 

               SET BDMDA=$ORDER(^ICD0(BDMDA))

               IF 'BDMDA

                   QUIT 

               Begin DoDot:1

 +9                SET BDMICD0=$PIECE($GET(^ICD0(BDMDA,0)),U)

 +10               SET BDMICDD=$PIECE($GET(^ICD0(BDMDA,0)),U,4)

 +11               SET BDMI=BDMI+1

 +12               SET ^BDMTMP($JOB,BDMI)=BDMICD0_"-"_BDMICDD_U_BDMDA_$CHAR(30)

               End DoDot:1

 +13       SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)

 +14       QUIT 

 +15      ;

COM(BDMRET) ;-- get all communities

 +1       ; m error trap

           SET X="MERR^BDMGU"

           SET @^%ZOSF("TRAP")

 +2        NEW BDMCOM,BDMCOMS,BDMI,BDMERR,BDMIEN,BDMDA

 +3        KILL ^BDMTMP($JOB)

 +4        SET BDMRET="^BDMTMP("_$JOB_")"

 +5        SET BDMI=0

 +6        SET BDMERR=""

 +7        SET ^BDMTMP($JOB,BDMI)="T00050CLN^T00007IEN"_$CHAR(30)

 +8        SET BDMDA=0

           FOR 

               SET BDMDA=$ORDER(^AUTTCOM("B",BDMDA))

               IF BDMDA=""

                   QUIT 

               Begin DoDot:1

 +9                SET BDMIEN=0

                   FOR 

                       SET BDMIEN=$ORDER(^AUTTCOM("B",BDMDA,BDMIEN))

                       IF 'BDMIEN

                           QUIT 

                       Begin DoDot:2

 +10                       SET BDMCOM=$PIECE($GET(^AUTTCOM(BDMIEN,0)),U)

 +11                       SET BDMCOMS=$SELECT($PIECE($GET(^AUTTCOM(BDMIEN,0)),U,3):$PIECE($GET(^DIC(5,$PIECE($GET(^AUTTCOM(BDMIEN,0)),U,3),0)),U,2),1:"")

 +12                       SET BDMI=BDMI+1

 +13                       SET ^BDMTMP($JOB,BDMI)=BDMCOM_"-"_BDMCOMS_U_BDMIEN_$CHAR(30)

                       End DoDot:2

               End DoDot:1

 +14       SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)

 +15       QUIT 

 +16      ;

FILES(BDMRET) ;-- get all RPMS Files

 +1       ; m error trap

           SET X="MERR^BDMGU"

           SET @^%ZOSF("TRAP")

 +2        NEW BDMFLS,BDMI,BDMERR,BDMIEN,BDMDA

 +3        KILL ^BDMTMP($JOB)

 +4        SET BDMRET="^BDMTMP("_$JOB_")"

 +5        SET BDMI=0

 +6        SET BDMERR=""

 +7        SET ^BDMTMP($JOB,BDMI)="T00050FILENUMBER^T00050FILENAME"_$CHAR(30)

 +8        SET BDMDA=0

           FOR