BDMDF1J ; IHS/CMI/LAB -IHS -CUMULATIVE REPORT 10 Oct 2014 9:50 AM ;
;;2.0;DIABETES MANAGEMENT SYSTEM;**11**;JUN 14, 2007;Build 30
;
CUML ;EP
;
COMORBID ;USE 400
S:'$D(BDMCUML(400)) BDMCUML(400)="Comorbidities"
S $P(BDMCUML(400),U,2)=$P(BDMCUML(400),U,2)+1 ;TOTAL # of patients
;active depression piece 3
S V=$G(^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,200))
I $E(V)="1" S $P(BDMCUML(400),U,3)=$P(BDMCUML(400),U,3)+1,BDMCOMOR=BDMCOMOR+1
;tobacco use piece 4
S V=$G(^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,27))
I +V=1 S $P(BDMCUML(400),U,4)=$P(BDMCUML(400),U,4)+1,BDMCOMOR=BDMCOMOR+1
;SEVERELY OBESE PIECE 5
I BDMSEVOB S $P(BDMCUML(400),U,5)=$P(BDMCUML(400),U,5)+1,BDMCOMOR=BDMCOMOR+1
;HYPERTENSION DIAGNOSED PIECE 6
S H=$E($G(^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,34)))
I $E(H)=1 S $P(BDMCUML(400),U,6)=$P(BDMCUML(400),U,6)+1,BDMCOMOR=BDMCOMOR+1
;HTN AND MEAN BP <140/<90 PIECE 7
I $E(H)=1,BDMBP140 S $P(BDMCUML(400),U,7)=$P(BDMCUML(400),U,7)+1
;cvd piece 8
S V=$G(^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,116))
I $E(V)=1 S $P(BDMCUML(400),U,8)=$P(BDMCUML(400),U,8)+1,BDMCOMOR=BDMCOMOR+1
;
;CVD & BP <140/<90 PIECE 9
I $E(V)=1,BDMBP140 S $P(BDMCUML(400),U,9)=$P(BDMCUML(400),U,9)+1
;CVD AND NOT A TOBACCO USER PIECE 10
S T=$G(^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,27))
I $E(T)=2,$E(V)=1 S $P(BDMCUML(400),U,10)=$P(BDMCUML(400),U,10)+1
;CVD AND STATIN PRESCRIBED PIECE 11
S T=+$G(^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,300))
I $E(V)=1,T=1 S $P(BDMCUML(400),U,11)=$P(BDMCUML(400),U,11)+1
I $E(V)=1,T'=3 S $P(BDMCUML(400),U,34)=$P(BDMCUML(400),U,34)+1 ;DENOM W/O ALLERGY
;CVD AND ASPIRIN PIECE 12
S T=$G(^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,62))
I $E(V)=1,$E(T)=1 S $P(BDMCUML(400),U,12)=$P(BDMCUML(400),U,12)+1
;
;CKD PIECE 13 & 14
;CKD IS EGFR <60 OR UACR >=30
I $$AGE^AUPNPAT(BDMPD,BDMADAT)<18 G N
S $P(BDMCUML(400),U,13)=$P(BDMCUML(400),U,13)+1 ;over 18 denom
I BDMCKD S $P(BDMCUML(400),U,14)=$P(BDMCUML(400),U,14)+1,BDMCOMOR=BDMCOMOR+1 ;HAS CKD
;CKD AND BP <140/<90 PIECE 15
I BDMCKD,BDMBP140 S $P(BDMCUML(400),U,15)=$P(BDMCUML(400),U,15)+1
;CKD AND ACE PIECE 16
S A=$E($G(^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,60)))
I A=1,BDMCKD S $P(BDMCUML(400),U,16)=$P(BDMCUML(400),U,16)+1
;EGFR AND UACR DONE PIECE 17
S G=0
I BDMEGFRU S $P(BDMCUML(400),U,17)=$P(BDMCUML(400),U,17)+1 D I G G N
.;NORMAL PIECE 18
.I BDMEGFRV>59,BDMUACRV="<30" S $P(BDMCUML(400),U,18)=$P(BDMCUML(400),U,18)+1 S G=1
.;STAGE 1/2 EGFR =>60, UACR =>30
.I BDMEGFRV>59,BDMUACRV=">30" S $P(BDMCUML(400),U,19)=$P(BDMCUML(400),U,19)+1 S G=1
;STAGE 3 EGFR 30-59
I BDMEGFRV]"",BDMEGFRV'<30,BDMEGFRV<60 S $P(BDMCUML(400),U,20)=$P(BDMCUML(400),U,20)+1 G N
;STAGE 4 EGFR 15-20 PIECE 21
I BDMEGFRV]"",BDMEGFRV'<15,BDMEGFRV'>29 S $P(BDMCUML(400),U,21)=$P(BDMCUML(400),U,21)+1 G N
;STAGE 5 EGFR <15
I BDMEGFRV]"",BDMEGFRV<15 S $P(BDMCUML(400),U,22)=$P(BDMCUML(400),U,22)+1 G N
;UACR AND EGFR NOT DONE
S $P(BDMCUML(400),U,23)=$P(BDMCUML(400),U,23)+1
N ;p12 HEP C AND RETINOPATHY
S V=$G(^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,222))
I $E(V)="1" S $P(BDMCUML(400),U,35)=$P(BDMCUML(400),U,35)+1,BDMCOMOR=BDMCOMOR+1 G R
;
S V=$G(^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,223))
I $E(V)="1" S $P(BDMCUML(400),U,37)=$P(BDMCUML(400),U,37)+1
I $E(V)'=3 S $P(BDMCUML(400),U,36)=$P(BDMCUML(400),U,36)+1 ;hep c screen denom
R ;RETINOPATHY
S V=$G(^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,224))
I $E(V)="1" S $P(BDMCUML(400),U,38)=$P(BDMCUML(400),U,38)+1,BDMCOMOR=BDMCOMOR+1
V ;NONE PIECE 25
I BDMCOMOR=0 S $P(BDMCUML(400),U,25)=$P(BDMCUML(400),U,25)+1
I BDMCOMOR=1 S $P(BDMCUML(400),U,26)=$P(BDMCUML(400),U,26)+1
I BDMCOMOR=2 S $P(BDMCUML(400),U,27)=$P(BDMCUML(400),U,27)+1
I BDMCOMOR=3 S $P(BDMCUML(400),U,28)=$P(BDMCUML(400),U,28)+1
I BDMCOMOR=4 S $P(BDMCUML(400),U,29)=$P(BDMCUML(400),U,29)+1
I BDMCOMOR>4 S $P(BDMCUML(400),U,30)=$P(BDMCUML(400),U,30)+1 ;P11
;I BDMCOMOR=6 S $P(BDMCUML(400),U,31)=$P(BDMCUML(400),U,31)+1 ;P11
Q
REC(DFN,BDMRTYP,BDMRBD,BDMRED,BDMED,BDMDMRG,BDMBDAT) ;EP - called to send back a visit record as
NEW BDMX,BDMREC,BDMEPIX,BDMTTT,X,Y,Z
S BDMREC=""
S BDMRTYP("IEN")=$O(^BDMRECD("B",BDMRTYP,0))
I 'BDMRTYP("IEN") Q BDMREC
PROC ;
S BDMEPIX=0
F S BDMEPIX=$O(^BDMRECD(BDMRTYP("IEN"),11,"AC",BDMEPIX)) Q:BDMEPIX'=+BDMEPIX!(BDMREC=-1) S BDMTTT=$O(^BDMRECD(BDMRTYP("IEN"),11,"AC",BDMEPIX,0)) D
.S X="" X:$D(^BDMRECD(BDMRTYP("IEN"),11,BDMTTT,11)) ^BDMRECD(BDMRTYP("IEN"),11,BDMTTT,11)
.;I X="" S X=" "
.S $P(BDMREC,U,$P(^BDMRECD(BDMRTYP("IEN"),11,BDMTTT,0),U,2))=X
Q BDMREC
EPICHK ;create epi info record in ^BDMDATA("BDMEPI",$J,n)
;skip this patient if dodx is greater than the audit date
S X=$$DODX^BDMDF16(BDMPD,BDMDMRG,"I")
I X>BDMADAT Q
;I DUZ=2881,BDMPD'=8932 Q
NEW BDMECNT,BDMEPIR,BDMTHER
S BDMEPIR="",BDMTHER="",BDMECNT=0
S BDMEPIR=$$REC(BDMPD,"DM AUDIT 2018 EXPORT RECORD",BDMRBD,BDMRED,BDMADAT,BDMDMRG,BDMBDAT)
;CHECK ERRORS ON BDMEPIR
S BDMRTYP("IEN")=$O(^BDMRECD("B","DM AUDIT 2018 EXPORT RECORD",0))
S Z=0 F S Z=$O(^BDMRECD(BDMRTYP("IEN"),21,Z)) Q:Z'=+Z D
.X:$D(^BDMRECD(BDMRTYP("IEN"),21,Z,1)) ^BDMRECD(BDMRTYP("IEN"),21,Z,1)
.Q:'$T
.S S=""
.I BDMQSRT="P" S S=$P(^DPT(BDMPD,0),U,1)
.I BDMQSRT="E" S S=$P(^BDMRECD(BDMRTYP("IEN"),21,Z,0),U,1)
.S BDMECNT=BDMECNT+1
.S $P(^XTMP("BDMDM18 ERRORS",BDMJOB,BDMBTH,"PATS",S,BDMPD,BDMECNT),U,1)=$P(^BDMRECD(BDMRTYP("IEN"),21,Z,0),U,1)
.S J=$P(^BDMRECD(BDMRTYP("IEN"),21,Z,0),U,2)
.S $P(^XTMP("BDMDM18 ERRORS",BDMJOB,BDMBTH,"PATS",S,BDMPD,BDMECNT),U,2)=$S(J="P":"POTENTIAL",J="D":"DEFINITE",1:"")
.S $P(^XTMP("BDMDM18 ERRORS",BDMJOB,BDMBTH,"PATS",S,BDMPD,BDMECNT),U,3)=$P($G(^BDMRECD(BDMRTYP("IEN"),21,Z,11)),U,1)
.S P=$P(^BDMRECD(BDMRTYP("IEN"),21,Z,0),U,4)
.S A=""
.I P="" D
..I $P(^BDMRECD(BDMRTYP("IEN"),21,Z,0),U,1)["BMI" S A=$$BMI^BDMDF18(BDMPD,BDMRBD,BDMRED)
..I $P(^BDMRECD(BDMRTYP("IEN"),21,Z,0),U,1)["HEIGHT TOTAL" S A="" I $P(BDMEPIR,U,18)]"" S A=$P(BDMEPIR,U,18)*12,A=A+$P(BDMEPIR,U,19)
..I $P(^BDMRECD(BDMRTYP("IEN"),21,Z,0),U,1)["DURATION" S A=$$DURDM^BDMDF16(BDMPD,BDMDMRG,BDMADAT)
.I P S A=$P(BDMEPIR,U,P)
.S $P(^XTMP("BDMDM18 ERRORS",BDMJOB,BDMBTH,"PATS",S,BDMPD,BDMECNT),U,4)=A
Q
QUALCHK ;EP - addl questions for data quality report
;get sort value
S BDMQSRT=""
S DIR(0)="S^P:PATIENT NAME;E:ERROR FIELD NAME",DIR("A")="How should the report be sorted",DIR("B")="P" KILL DA D ^DIR KILL DIR
I $D(DIRUT) S BDMSTP=1 Q
S BDMQSRT=Y
Q
BDMDF1J ; IHS/CMI/LAB -IHS -CUMULATIVE REPORT 10 Oct 2014 9:50 AM ;
+1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**11**;JUN 14, 2007;Build 30
+2 ;
CUML ;EP
+1 ;
COMORBID ;USE 400
+1 IF '$DATA(BDMCUML(400))
SET BDMCUML(400)="Comorbidities"
+2 ;TOTAL # of patients
SET $PIECE(BDMCUML(400),U,2)=$PIECE(BDMCUML(400),U,2)+1
+3 ;active depression piece 3
+4 SET V=$GET(^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,200))
+5 IF $EXTRACT(V)="1"
SET $PIECE(BDMCUML(400),U,3)=$PIECE(BDMCUML(400),U,3)+1
SET BDMCOMOR=BDMCOMOR+1
+6 ;tobacco use piece 4
+7 SET V=$GET(^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,27))
+8 IF +V=1
SET $PIECE(BDMCUML(400),U,4)=$PIECE(BDMCUML(400),U,4)+1
SET BDMCOMOR=BDMCOMOR+1
+9 ;SEVERELY OBESE PIECE 5
+10 IF BDMSEVOB
SET $PIECE(BDMCUML(400),U,5)=$PIECE(BDMCUML(400),U,5)+1
SET BDMCOMOR=BDMCOMOR+1
+11 ;HYPERTENSION DIAGNOSED PIECE 6
+12 SET H=$EXTRACT($GET(^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,34)))
+13 IF $EXTRACT(H)=1
SET $PIECE(BDMCUML(400),U,6)=$PIECE(BDMCUML(400),U,6)+1
SET BDMCOMOR=BDMCOMOR+1
+14 ;HTN AND MEAN BP <140/<90 PIECE 7
+15 IF $EXTRACT(H)=1
IF BDMBP140
SET $PIECE(BDMCUML(400),U,7)=$PIECE(BDMCUML(400),U,7)+1
+16 ;cvd piece 8
+17 SET V=$GET(^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,116))
+18 IF $EXTRACT(V)=1
SET $PIECE(BDMCUML(400),U,8)=$PIECE(BDMCUML(400),U,8)+1
SET BDMCOMOR=BDMCOMOR+1
+19 ;
+20 ;CVD & BP <140/<90 PIECE 9
+21 IF $EXTRACT(V)=1
IF BDMBP140
SET $PIECE(BDMCUML(400),U,9)=$PIECE(BDMCUML(400),U,9)+1
+22 ;CVD AND NOT A TOBACCO USER PIECE 10
+23 SET T=$GET(^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,27))
+24 IF $EXTRACT(T)=2
IF $EXTRACT(V)=1
SET $PIECE(BDMCUML(400),U,10)=$PIECE(BDMCUML(400),U,10)+1
+25 ;CVD AND STATIN PRESCRIBED PIECE 11
+26 SET T=+$GET(^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,300))
+27 IF $EXTRACT(V)=1
IF T=1
SET $PIECE(BDMCUML(400),U,11)=$PIECE(BDMCUML(400),U,11)+1
+28 ;DENOM W/O ALLERGY
IF $EXTRACT(V)=1
IF T'=3
SET $PIECE(BDMCUML(400),U,34)=$PIECE(BDMCUML(400),U,34)+1
+29 ;CVD AND ASPIRIN PIECE 12
+30 SET T=$GET(^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,62))
+31 IF $EXTRACT(V)=1
IF $EXTRACT(T)=1
SET $PIECE(BDMCUML(400),U,12)=$PIECE(BDMCUML(400),U,12)+1
+32 ;
+33 ;CKD PIECE 13 & 14
+34 ;CKD IS EGFR <60 OR UACR >=30
+35 IF $$AGE^AUPNPAT(BDMPD,BDMADAT)<18
GOTO N
+36 ;over 18 denom
SET $PIECE(BDMCUML(400),U,13)=$PIECE(BDMCUML(400),U,13)+1
+37 ;HAS CKD
IF BDMCKD
SET $PIECE(BDMCUML(400),U,14)=$PIECE(BDMCUML(400),U,14)+1
SET BDMCOMOR=BDMCOMOR+1
+38 ;CKD AND BP <140/<90 PIECE 15
+39 IF BDMCKD
IF BDMBP140
SET $PIECE(BDMCUML(400),U,15)=$PIECE(BDMCUML(400),U,15)+1
+40 ;CKD AND ACE PIECE 16
+41 SET A=$EXTRACT($GET(^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,60)))
+42 IF A=1
IF BDMCKD
SET $PIECE(BDMCUML(400),U,16)=$PIECE(BDMCUML(400),U,16)+1
+43 ;EGFR AND UACR DONE PIECE 17
+44 SET G=0
+45 IF BDMEGFRU
SET $PIECE(BDMCUML(400),U,17)=$PIECE(BDMCUML(400),U,17)+1
Begin DoDot:1
+46 ;NORMAL PIECE 18
+47 IF BDMEGFRV>59
IF BDMUACRV="<30"
SET $PIECE(BDMCUML(400),U,18)=$PIECE(BDMCUML(400),U,18)+1
SET G=1
+48 ;STAGE 1/2 EGFR =>60, UACR =>30
+49 IF BDMEGFRV>59
IF BDMUACRV=">30"
SET $PIECE(BDMCUML(400),U,19)=$PIECE(BDMCUML(400),U,19)+1
SET G=1
End DoDot:1
IF G
GOTO N
+50 ;STAGE 3 EGFR 30-59
+51 IF BDMEGFRV]""
IF BDMEGFRV'<30
IF BDMEGFRV<60
SET $PIECE(BDMCUML(400),U,20)=$PIECE(BDMCUML(400),U,20)+1
GOTO N
+52 ;STAGE 4 EGFR 15-20 PIECE 21
+53 IF BDMEGFRV]""
IF BDMEGFRV'<15
IF BDMEGFRV'>29
SET $PIECE(BDMCUML(400),U,21)=$PIECE(BDMCUML(400),U,21)+1
GOTO N
+54 ;STAGE 5 EGFR <15
+55 IF BDMEGFRV]""
IF BDMEGFRV<15
SET $PIECE(BDMCUML(400),U,22)=$PIECE(BDMCUML(400),U,22)+1
GOTO N
+56 ;UACR AND EGFR NOT DONE
+57 SET $PIECE(BDMCUML(400),U,23)=$PIECE(BDMCUML(400),U,23)+1
N ;p12 HEP C AND RETINOPATHY
+1 SET V=$GET(^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,222))
+2 IF $EXTRACT(V)="1"
SET $PIECE(BDMCUML(400),U,35)=$PIECE(BDMCUML(400),U,35)+1
SET BDMCOMOR=BDMCOMOR+1
GOTO R
+3 ;
+4 SET V=$GET(^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,223))
+5 IF $EXTRACT(V)="1"
SET $PIECE(BDMCUML(400),U,37)=$PIECE(BDMCUML(400),U,37)+1
+6 ;hep c screen denom
IF $EXTRACT(V)'=3
SET $PIECE(BDMCUML(400),U,36)=$PIECE(BDMCUML(400),U,36)+1
R ;RETINOPATHY
+1 SET V=$GET(^XTMP("BDMDM18",BDMJOB,BDMBTH,"AUDIT",BDMPD,224))
+2 IF $EXTRACT(V)="1"
SET $PIECE(BDMCUML(400),U,38)=$PIECE(BDMCUML(400),U,38)+1
SET BDMCOMOR=BDMCOMOR+1
V ;NONE PIECE 25
+1 IF BDMCOMOR=0
SET $PIECE(BDMCUML(400),U,25)=$PIECE(BDMCUML(400),U,25)+1
+2 IF BDMCOMOR=1
SET $PIECE(BDMCUML(400),U,26)=$PIECE(BDMCUML(400),U,26)+1
+3 IF BDMCOMOR=2
SET $PIECE(BDMCUML(400),U,27)=$PIECE(BDMCUML(400),U,27)+1
+4 IF BDMCOMOR=3
SET $PIECE(BDMCUML(400),U,28)=$PIECE(BDMCUML(400),U,28)+1
+5 IF BDMCOMOR=4
SET $PIECE(BDMCUML(400),U,29)=$PIECE(BDMCUML(400),U,29)+1
+6 ;P11
IF BDMCOMOR>4
SET $PIECE(BDMCUML(400),U,30)=$PIECE(BDMCUML(400),U,30)+1
+7 ;I BDMCOMOR=6 S $P(BDMCUML(400),U,31)=$P(BDMCUML(400),U,31)+1 ;P11
+8 QUIT
REC(DFN,BDMRTYP,BDMRBD,BDMRED,BDMED,BDMDMRG,BDMBDAT) ;EP - called to send back a visit record as
+1 NEW BDMX,BDMREC,BDMEPIX,BDMTTT,X,Y,Z
+2 SET BDMREC=""
+3 SET BDMRTYP("IEN")=$ORDER(^BDMRECD("B",BDMRTYP,0))
+4 IF 'BDMRTYP("IEN")
QUIT BDMREC
PROC ;
+1 SET BDMEPIX=0
+2 FOR
SET BDMEPIX=$ORDER(^BDMRECD(BDMRTYP("IEN"),11,"AC",BDMEPIX))
IF BDMEPIX'=+BDMEPIX!(BDMREC=-1)
QUIT
SET BDMTTT=$ORDER(^BDMRECD(BDMRTYP("IEN"),11,"AC",BDMEPIX,0))
Begin DoDot:1
+3 SET X=""
IF $DATA(^BDMRECD(BDMRTYP("IEN"),11,BDMTTT,11))
XECUTE ^BDMRECD(BDMRTYP("IEN"),11,BDMTTT,11)
+4 ;I X="" S X=" "
+5 SET $PIECE(BDMREC,U,$PIECE(^BDMRECD(BDMRTYP("IEN"),11,BDMTTT,0),U,2))=X
End DoDot:1
+6 QUIT BDMREC
EPICHK ;create epi info record in ^BDMDATA("BDMEPI",$J,n)
+1 ;skip this patient if dodx is greater than the audit date
+2 SET X=$$DODX^BDMDF16(BDMPD,BDMDMRG,"I")
+3 IF X>BDMADAT
QUIT
+4 ;I DUZ=2881,BDMPD'=8932 Q
+5 NEW BDMECNT,BDMEPIR,BDMTHER
+6 SET BDMEPIR=""
SET BDMTHER=""
SET BDMECNT=0
+7 SET BDMEPIR=$$REC(BDMPD,"DM AUDIT 2018 EXPORT RECORD",BDMRBD,BDMRED,BDMADAT,BDMDMRG,BDMBDAT)
+8 ;CHECK ERRORS ON BDMEPIR
+9 SET BDMRTYP("IEN")=$ORDER(^BDMRECD("B","DM AUDIT 2018 EXPORT RECORD",0))
+10 SET Z=0
FOR
SET Z=$ORDER(^BDMRECD(BDMRTYP("IEN"),21,Z))
IF Z'=+Z
QUIT
Begin DoDot:1
+11 IF $DATA(^BDMRECD(BDMRTYP("IEN"),21,Z,1))
XECUTE ^BDMRECD(BDMRTYP("IEN"),21,Z,1)
+12 IF '$TEST
QUIT
+13 SET S=""
+14 IF BDMQSRT="P"
SET S=$PIECE(^DPT(BDMPD,0),U,1)
+15 IF BDMQSRT="E"
SET S=$PIECE(^BDMRECD(BDMRTYP("IEN"),21,Z,0),U,1)
+16 SET BDMECNT=BDMECNT+1
+17 SET $PIECE(^XTMP("BDMDM18 ERRORS",BDMJOB,BDMBTH,"PATS",S,BDMPD,BDMECNT),U,1)=$PIECE(^BDMRECD(BDMRTYP("IEN"),21,Z,0),U,1)
+18 SET J=$PIECE(^BDMRECD(BDMRTYP("IEN"),21,Z,0),U,2)
+19 SET $PIECE(^XTMP("BDMDM18 ERRORS",BDMJOB,BDMBTH,"PATS",S,BDMPD,BDMECNT),U,2)=$SELECT(J="P":"POTENTIAL",J="D":"DEFINITE",1:"")
+20 SET $PIECE(^XTMP("BDMDM18 ERRORS",BDMJOB,BDMBTH,"PATS",S,BDMPD,BDMECNT),U,3)=$PIECE($GET(^BDMRECD(BDMRTYP("IEN"),21,Z,11)),U,1)
+21 SET P=$PIECE(^BDMRECD(BDMRTYP("IEN"),21,Z,0),U,4)
+22 SET A=""
+23 IF P=""
Begin DoDot:2
+24 IF $PIECE(^BDMRECD(BDMRTYP("IEN"),21,Z,0),U,1)["BMI"
SET A=$$BMI^BDMDF18(BDMPD,BDMRBD,BDMRED)
+25 IF $PIECE(^BDMRECD(BDMRTYP("IEN"),21,Z,0),U,1)["HEIGHT TOTAL"
SET A=""
IF $PIECE(BDMEPIR,U,18)]""
SET A=$PIECE(BDMEPIR,U,18)*12
SET A=A+$PIECE(BDMEPIR,U,19)
+26 IF $PIECE(^BDMRECD(BDMRTYP("IEN"),21,Z,0),U,1)["DURATION"
SET A=$$DURDM^BDMDF16(BDMPD,BDMDMRG,BDMADAT)
End DoDot:2
+27 IF P
SET A=$PIECE(BDMEPIR,U,P)
+28 SET $PIECE(^XTMP("BDMDM18 ERRORS",BDMJOB,BDMBTH,"PATS",S,BDMPD,BDMECNT),U,4)=A
End DoDot:1
+29 QUIT
QUALCHK ;EP - addl questions for data quality report
+1 ;get sort value
+2 SET BDMQSRT=""
+3 SET DIR(0)="S^P:PATIENT NAME;E:ERROR FIELD NAME"
SET DIR("A")="How should the report be sorted"
SET DIR("B")="P"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
SET BDMSTP=1
QUIT
+5 SET BDMQSRT=Y
+6 QUIT
