BDMDE1R ; IHS/CMI/LAB -IHS -CUMULATIVE REPORT 03 Feb 2014 5:38 PM ;
;;2.0;DIABETES MANAGEMENT SYSTEM;**10,11**;JUN 14, 2007;Build 30
;
;
SDPI16 ;EP
K BDMCUML
S BDMCUML(10)="Aspirin or Other Antiplatelet Therapy in Cardiovascular Disease"
S BDMCUML(10,1)="In patients with diagnosed CVD, aspirin "
S BDMCUML(10,2)="or other antiplatelet/anticoagulant "
S BDMCUML(10,3)="therapy prescribed"
;
S BDMCUML(20)="Blood Pressure Control"
S BDMCUML(20,1)="Mean blood prssure <140/<90 mmHg"
S BDMCUML(20,2)="(Mean of last 2, or 3 if available)"
;
S BDMCUML(30)="Chronic Kidney Disease Screening and Monitoring"
S BDMCUML(30,1)="In age 18+, both UACR & eGFR done"
;
S BDMCUML(40)="Dental Exam"
S BDMCUML(40,1)="Dental exam received"
;
S BDMCUML(50)="Depression Screening"
S BDMCUML(50,1)="In patients without active depression,"
S BDMCUML(50,2)="screened for depression"
;
S BDMCUML(60)="Diabetes-related Education"
S BDMCUML(60,1)="Any diabetes topic (nutrition,"
S BDMCUML(60,2)="physical activity, or other)"
;eye exam
S BDMCUML(70)="Eye Exam - Retinopathy Screening"
S BDMCUML(70,1)="Eye exam - dilated or retinal imaging"
;foot exam
S BDMCUML(80)="Foot Exam"
S BDMCUML(80,1)="Foot exam - comprehensive"
;glycemic control
S BDMCUML(90)="Glycemic Control"
S BDMCUML(90,1)="A1C <8.0%"
;HEP B
S BDMCUML(100)="Immunizations: Hepatitis B"
S BDMCUML(100,1)="Hepatitis B 3-dose series complete - ever"
;FLU
S BDMCUML(110)="Immunizations: Influenza"
S BDMCUML(110,1)="Influenza vaccine during report period"
;
;PNEUMO
S BDMCUML(120)="Immunizations: Pneumococcal"
S BDMCUML(120,1)="Pneumococcal vaccine - ever"
;TETANUS
S BDMCUML(130)="Immunizations: Tetanus/Diphtheria"
S BDMCUML(130,1)="Tetanus/diphtheria - past 10 years"
;lipid man
S BDMCUML(140)="Lipid Management in Cardiovascular Disease"
S BDMCUML(140,1)="In patients aged 40-75 and/or with"
S BDMCUML(140,2)="diagnosed CVD, statin prescribed"
;
S BDMCUML(150)="Nutrition Education"
S BDMCUML(150,1)="Nutrition education - by any provider"
;
S BDMCUML(160)="Physical activity education"
S BDMCUML(160,1)="Physical activity education"
;
S BDMCUML(170)="Tobacco Use Screening"
S BDMCUML(170,1)="Screened for tobacco use during "
S BDMCUML(170,2)="report period"
;
S BDMCUML(180)="Tuberculosis Screening"
S BDMCUML(180,1)="TB test done (skin or blood)"
;
PROCESS ;
S BDMNOGO=0
S BDMPD=0 F S BDMPD=$O(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD)) Q:BDMPD'=+BDMPD D CUML1
Q
;
CUML1 ;
ASPIRIN ;
I $$DODX^BDMDE16(BDMPD,BDMDMRG,"I")>BDMADAT S BDMNOGO=BDMNOGO+1 Q
S V=$G(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,116)) ;CVD
I $E(V)=1 S $P(BDMCUML(10,1),U,3)=$P(BDMCUML(10,1),U,3)+1 ;CVD DENOM
;CVD AND ASPIRIN
S A=$G(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,62))
I $E(V)=1,$E(A)=1 S $P(BDMCUML(10,1),U,2)=$P(BDMCUML(10,1),U,2)+1
BPC ;blood pressure control
;take last 3 bp's and get mean systolic and mean diastolic
S $P(BDMCUML(20,1),U,3)=$P(BDMCUML(20,1),U,3)+1
S S=$$SYSMEAN^BDMDE15(BDMPD,BDMRBD,BDMRED)
S D=$$DIAMEAN^BDMDE15(BDMPD,BDMRBD,BDMRED)
D
.I S=""!(D="") Q
.I S<140&(D<90) S $P(BDMCUML(20,1),U,2)=$P(BDMCUML(20,1),U,2)+1 Q
CKD ;
I $$AGE^AUPNPAT(BDMPD,BDMADAT)<18 G DENT
S V=$G(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,79)),V=$$STV^BDMDE18($P(V,U,2),5)
S T=$P($G(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,92)),U,5) ;type of test
S $P(BDMCUML(30,1),U,3)=$P(BDMCUML(30,1),U,3)+1
I V]"",T=1 S $P(BDMCUML(30,1),U,2)=$P(BDMCUML(30,1),U,2)+1
DENT ;
S $P(BDMCUML(40,1),U,3)=$P(BDMCUML(40,1),U,3)+1
S V=$G(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,42))
I $E(V)="1" S $P(BDMCUML(40,1),U,2)=$P(BDMCUML(40,1),U,2)+1
DEP ;
S V=$G(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,200))
I $E(V)'="1" S $P(BDMCUML(50,1),U,3)=$P(BDMCUML(50,1),U,3)+1 D
.S V=$G(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,210))
.I $E(V)="1" S $P(BDMCUML(50,1),U,2)=$P(BDMCUML(50,1),U,2)+1
EDUC ;
S G=0
S $P(BDMCUML(60,1),U,3)=$P(BDMCUML(60,1),U,3)+1
S V=$G(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,44)) ;NUTR
I $E(V)="1"!($E(V)=2)!($E(V)=3) S G=1
S V=$G(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,46))
I $E(V)="1" S G=1
S V=$G(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,48))
I $E(V)="1" S G=1
I G S $P(BDMCUML(60,1),U,2)=$P(BDMCUML(60,1),U,2)+1
EYE ;
S $P(BDMCUML(70,1),U,3)=$P(BDMCUML(70,1),U,3)+1
S V=$G(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,40))
I $E(V)="1" S $P(BDMCUML(70,1),U,2)=$P(BDMCUML(70,1),U,2)+1
S $P(BDMCUML(80,1),U,3)=$P(BDMCUML(80,1),U,3)+1
S V=$G(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,38))
I $E(V)="1" S $P(BDMCUML(80,1),U,2)=$P(BDMCUML(80,1),U,2)+1
GLYCTRL ;
S $P(BDMCUML(90,1),U,3)=$P(BDMCUML(90,1),U,3)+1
S V=$P($G(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,78)),U,2)
S P="",BDMA18=0
I V=""!(V="?") G IMM
I V["<" S P=1
I V[">" S P=2
S V=$$STV^BDMDE18(V,5)
I V="" G IMM
S V=+V
I 'P S P=$S(V="":0,V<8.0:1,V>8.9:2,1:"")
I P=1 S $P(BDMCUML(90,1),U,2)=$P(BDMCUML(90,1),U,2)+1
IMM ;
HEPB ;
S V=$G(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,115))
I $E(V)'=4 S $P(BDMCUML(100,1),U,3)=$P(BDMCUML(100,1),U,3)+1
I $E(V)="1" S $P(BDMCUML(100,1),U,2)=$P(BDMCUML(100,1),U,2)+1
FLU ;
S $P(BDMCUML(110,1),U,3)=$P(BDMCUML(110,1),U,3)+1
S V=$G(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,64))
I $E(V)="1" S $P(BDMCUML(110,1),U,2)=$P(BDMCUML(110,1),U,2)+1
PNEUM ;
S $P(BDMCUML(120,1),U,3)=$P(BDMCUML(120,1),U,3)+1
S V=$G(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,66))
I $E(V)="1" S $P(BDMCUML(120,1),U,2)=$P(BDMCUML(120,1),U,2)+1
TD ;
S $P(BDMCUML(130,1),U,3)=$P(BDMCUML(130,1),U,3)+1
S V=$G(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,68))
I $E(V)="1" S $P(BDMCUML(130,1),U,2)=$P(BDMCUML(130,1),U,2)+1
LIPID ;
S V=$E($G(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,300))) ;STATIN
S C=0
S A=$$AGE^AUPNPAT(BDMPD,BDMADAT)
I $E($G(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,116)))=1 S C=1 ;CVD
I C=1!(A>39&(A<76)) D
.I V'=3 S $P(BDMCUML(140,1),U,3)=$P(BDMCUML(140,1),U,3)+1 ;DENOM
.I V=1 S $P(BDMCUML(140,1),U,2)=$P(BDMCUML(140,1),U,2)+1 ;NUM
NUTR ;
S $P(BDMCUML(150,1),U,3)=$P(BDMCUML(150,1),U,3)+1
S G=0,V=$G(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,44))
I $E(V)="1"!($E(V)=2)!($E(V)=3) S $P(BDMCUML(150,1),U,2)=$P(BDMCUML(150,1),U,2)+1
PHY ;
S $P(BDMCUML(160,1),U,3)=$P(BDMCUML(160,1),U,3)+1
S V=$G(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,46))
I $E(V)="1" S $P(BDMCUML(160,1),U,2)=$P(BDMCUML(160,1),U,2)+1
TOB ;
S $P(BDMCUML(170,1),U,3)=$P(BDMCUML(170,1),U,3)+1
S V=$G(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,215))
I +V=1!(+V=2) S $P(BDMCUML(170,1),U,2)=$P(BDMCUML(170,1),U,2)+1
TB ;
S $P(BDMCUML(180,1),U,3)=$P(BDMCUML(180,1),U,3)+1
S V=$G(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,70))
I $E(V)=1!($E(V)=2) S $P(BDMCUML(180,1),U,2)=$P(BDMCUML(180,1),U,2)+1
Q
BDMDE1R ; IHS/CMI/LAB -IHS -CUMULATIVE REPORT 03 Feb 2014 5:38 PM ;
+1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**10,11**;JUN 14, 2007;Build 30
+2 ;
+3 ;
SDPI16 ;EP
+1 KILL BDMCUML
+2 SET BDMCUML(10)="Aspirin or Other Antiplatelet Therapy in Cardiovascular Disease"
+3 SET BDMCUML(10,1)="In patients with diagnosed CVD, aspirin "
+4 SET BDMCUML(10,2)="or other antiplatelet/anticoagulant "
+5 SET BDMCUML(10,3)="therapy prescribed"
+6 ;
+7 SET BDMCUML(20)="Blood Pressure Control"
+8 SET BDMCUML(20,1)="Mean blood prssure <140/<90 mmHg"
+9 SET BDMCUML(20,2)="(Mean of last 2, or 3 if available)"
+10 ;
+11 SET BDMCUML(30)="Chronic Kidney Disease Screening and Monitoring"
+12 SET BDMCUML(30,1)="In age 18+, both UACR & eGFR done"
+13 ;
+14 SET BDMCUML(40)="Dental Exam"
+15 SET BDMCUML(40,1)="Dental exam received"
+16 ;
+17 SET BDMCUML(50)="Depression Screening"
+18 SET BDMCUML(50,1)="In patients without active depression,"
+19 SET BDMCUML(50,2)="screened for depression"
+20 ;
+21 SET BDMCUML(60)="Diabetes-related Education"
+22 SET BDMCUML(60,1)="Any diabetes topic (nutrition,"
+23 SET BDMCUML(60,2)="physical activity, or other)"
+24 ;eye exam
+25 SET BDMCUML(70)="Eye Exam - Retinopathy Screening"
+26 SET BDMCUML(70,1)="Eye exam - dilated or retinal imaging"
+27 ;foot exam
+28 SET BDMCUML(80)="Foot Exam"
+29 SET BDMCUML(80,1)="Foot exam - comprehensive"
+30 ;glycemic control
+31 SET BDMCUML(90)="Glycemic Control"
+32 SET BDMCUML(90,1)="A1C <8.0%"
+33 ;HEP B
+34 SET BDMCUML(100)="Immunizations: Hepatitis B"
+35 SET BDMCUML(100,1)="Hepatitis B 3-dose series complete - ever"
+36 ;FLU
+37 SET BDMCUML(110)="Immunizations: Influenza"
+38 SET BDMCUML(110,1)="Influenza vaccine during report period"
+39 ;
+40 ;PNEUMO
+41 SET BDMCUML(120)="Immunizations: Pneumococcal"
+42 SET BDMCUML(120,1)="Pneumococcal vaccine - ever"
+43 ;TETANUS
+44 SET BDMCUML(130)="Immunizations: Tetanus/Diphtheria"
+45 SET BDMCUML(130,1)="Tetanus/diphtheria - past 10 years"
+46 ;lipid man
+47 SET BDMCUML(140)="Lipid Management in Cardiovascular Disease"
+48 SET BDMCUML(140,1)="In patients aged 40-75 and/or with"
+49 SET BDMCUML(140,2)="diagnosed CVD, statin prescribed"
+50 ;
+51 SET BDMCUML(150)="Nutrition Education"
+52 SET BDMCUML(150,1)="Nutrition education - by any provider"
+53 ;
+54 SET BDMCUML(160)="Physical activity education"
+55 SET BDMCUML(160,1)="Physical activity education"
+56 ;
+57 SET BDMCUML(170)="Tobacco Use Screening"
+58 SET BDMCUML(170,1)="Screened for tobacco use during "
+59 SET BDMCUML(170,2)="report period"
+60 ;
+61 SET BDMCUML(180)="Tuberculosis Screening"
+62 SET BDMCUML(180,1)="TB test done (skin or blood)"
+63 ;
PROCESS ;
+1 SET BDMNOGO=0
+2 SET BDMPD=0
FOR
SET BDMPD=$ORDER(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD))
IF BDMPD'=+BDMPD
QUIT
DO CUML1
+3 QUIT
+4 ;
CUML1 ;
ASPIRIN ;
+1 IF $$DODX^BDMDE16(BDMPD,BDMDMRG,"I")>BDMADAT
SET BDMNOGO=BDMNOGO+1
QUIT
+2 ;CVD
SET V=$GET(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,116))
+3 ;CVD DENOM
IF $EXTRACT(V)=1
SET $PIECE(BDMCUML(10,1),U,3)=$PIECE(BDMCUML(10,1),U,3)+1
+4 ;CVD AND ASPIRIN
+5 SET A=$GET(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,62))
+6 IF $EXTRACT(V)=1
IF $EXTRACT(A)=1
SET $PIECE(BDMCUML(10,1),U,2)=$PIECE(BDMCUML(10,1),U,2)+1
BPC ;blood pressure control
+1 ;take last 3 bp's and get mean systolic and mean diastolic
+2 SET $PIECE(BDMCUML(20,1),U,3)=$PIECE(BDMCUML(20,1),U,3)+1
+3 SET S=$$SYSMEAN^BDMDE15(BDMPD,BDMRBD,BDMRED)
+4 SET D=$$DIAMEAN^BDMDE15(BDMPD,BDMRBD,BDMRED)
+5 Begin DoDot:1
+6 IF S=""!(D="")
QUIT
+7 IF S<140&(D<90)
SET $PIECE(BDMCUML(20,1),U,2)=$PIECE(BDMCUML(20,1),U,2)+1
QUIT
End DoDot:1
CKD ;
+1 IF $$AGE^AUPNPAT(BDMPD,BDMADAT)<18
GOTO DENT
+2 SET V=$GET(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,79))
SET V=$$STV^BDMDE18($PIECE(V,U,2),5)
+3 ;type of test
SET T=$PIECE($GET(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,92)),U,5)
+4 SET $PIECE(BDMCUML(30,1),U,3)=$PIECE(BDMCUML(30,1),U,3)+1
+5 IF V]""
IF T=1
SET $PIECE(BDMCUML(30,1),U,2)=$PIECE(BDMCUML(30,1),U,2)+1
DENT ;
+1 SET $PIECE(BDMCUML(40,1),U,3)=$PIECE(BDMCUML(40,1),U,3)+1
+2 SET V=$GET(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,42))
+3 IF $EXTRACT(V)="1"
SET $PIECE(BDMCUML(40,1),U,2)=$PIECE(BDMCUML(40,1),U,2)+1
DEP ;
+1 SET V=$GET(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,200))
+2 IF $EXTRACT(V)'="1"
SET $PIECE(BDMCUML(50,1),U,3)=$PIECE(BDMCUML(50,1),U,3)+1
Begin DoDot:1
+3 SET V=$GET(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,210))
+4 IF $EXTRACT(V)="1"
SET $PIECE(BDMCUML(50,1),U,2)=$PIECE(BDMCUML(50,1),U,2)+1
End DoDot:1
EDUC ;
+1 SET G=0
+2 SET $PIECE(BDMCUML(60,1),U,3)=$PIECE(BDMCUML(60,1),U,3)+1
+3 ;NUTR
SET V=$GET(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,44))
+4 IF $EXTRACT(V)="1"!($EXTRACT(V)=2)!($EXTRACT(V)=3)
SET G=1
+5 SET V=$GET(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,46))
+6 IF $EXTRACT(V)="1"
SET G=1
+7 SET V=$GET(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,48))
+8 IF $EXTRACT(V)="1"
SET G=1
+9 IF G
SET $PIECE(BDMCUML(60,1),U,2)=$PIECE(BDMCUML(60,1),U,2)+1
EYE ;
+1 SET $PIECE(BDMCUML(70,1),U,3)=$PIECE(BDMCUML(70,1),U,3)+1
+2 SET V=$GET(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,40))
+3 IF $EXTRACT(V)="1"
SET $PIECE(BDMCUML(70,1),U,2)=$PIECE(BDMCUML(70,1),U,2)+1
+1 SET $PIECE(BDMCUML(80,1),U,3)=$PIECE(BDMCUML(80,1),U,3)+1
+2 SET V=$GET(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,38))
+3 IF $EXTRACT(V)="1"
SET $PIECE(BDMCUML(80,1),U,2)=$PIECE(BDMCUML(80,1),U,2)+1
GLYCTRL ;
+1 SET $PIECE(BDMCUML(90,1),U,3)=$PIECE(BDMCUML(90,1),U,3)+1
+2 SET V=$PIECE($GET(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,78)),U,2)
+3 SET P=""
SET BDMA18=0
+4 IF V=""!(V="?")
GOTO IMM
+5 IF V["<"
SET P=1
+6 IF V[">"
SET P=2
+7 SET V=$$STV^BDMDE18(V,5)
+8 IF V=""
GOTO IMM
+9 SET V=+V
+10 IF 'P
SET P=$SELECT(V="":0,V<8.0:1,V>8.9:2,1:"")
+11 IF P=1
SET $PIECE(BDMCUML(90,1),U,2)=$PIECE(BDMCUML(90,1),U,2)+1
IMM ;
HEPB ;
+1 SET V=$GET(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,115))
+2 IF $EXTRACT(V)'=4
SET $PIECE(BDMCUML(100,1),U,3)=$PIECE(BDMCUML(100,1),U,3)+1
+3 IF $EXTRACT(V)="1"
SET $PIECE(BDMCUML(100,1),U,2)=$PIECE(BDMCUML(100,1),U,2)+1
FLU ;
+1 SET $PIECE(BDMCUML(110,1),U,3)=$PIECE(BDMCUML(110,1),U,3)+1
+2 SET V=$GET(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,64))
+3 IF $EXTRACT(V)="1"
SET $PIECE(BDMCUML(110,1),U,2)=$PIECE(BDMCUML(110,1),U,2)+1
PNEUM ;
+1 SET $PIECE(BDMCUML(120,1),U,3)=$PIECE(BDMCUML(120,1),U,3)+1
+2 SET V=$GET(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,66))
+3 IF $EXTRACT(V)="1"
SET $PIECE(BDMCUML(120,1),U,2)=$PIECE(BDMCUML(120,1),U,2)+1
TD ;
+1 SET $PIECE(BDMCUML(130,1),U,3)=$PIECE(BDMCUML(130,1),U,3)+1
+2 SET V=$GET(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,68))
+3 IF $EXTRACT(V)="1"
SET $PIECE(BDMCUML(130,1),U,2)=$PIECE(BDMCUML(130,1),U,2)+1
LIPID ;
+1 ;STATIN
SET V=$EXTRACT($GET(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,300)))
+2 SET C=0
+3 SET A=$$AGE^AUPNPAT(BDMPD,BDMADAT)
+4 ;CVD
IF $EXTRACT($GET(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,116)))=1
SET C=1
+5 IF C=1!(A>39&(A<76))
Begin DoDot:1
+6 ;DENOM
IF V'=3
SET $PIECE(BDMCUML(140,1),U,3)=$PIECE(BDMCUML(140,1),U,3)+1
+7 ;NUM
IF V=1
SET $PIECE(BDMCUML(140,1),U,2)=$PIECE(BDMCUML(140,1),U,2)+1
End DoDot:1
NUTR ;
+1 SET $PIECE(BDMCUML(150,1),U,3)=$PIECE(BDMCUML(150,1),U,3)+1
+2 SET G=0
SET V=$GET(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,44))
+3 IF $EXTRACT(V)="1"!($EXTRACT(V)=2)!($EXTRACT(V)=3)
SET $PIECE(BDMCUML(150,1),U,2)=$PIECE(BDMCUML(150,1),U,2)+1
PHY ;
+1 SET $PIECE(BDMCUML(160,1),U,3)=$PIECE(BDMCUML(160,1),U,3)+1
+2 SET V=$GET(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,46))
+3 IF $EXTRACT(V)="1"
SET $PIECE(BDMCUML(160,1),U,2)=$PIECE(BDMCUML(160,1),U,2)+1
TOB ;
+1 SET $PIECE(BDMCUML(170,1),U,3)=$PIECE(BDMCUML(170,1),U,3)+1
+2 SET V=$GET(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,215))
+3 IF +V=1!(+V=2)
SET $PIECE(BDMCUML(170,1),U,2)=$PIECE(BDMCUML(170,1),U,2)+1
TB ;
+1 SET $PIECE(BDMCUML(180,1),U,3)=$PIECE(BDMCUML(180,1),U,3)+1
+2 SET V=$GET(^XTMP("BDMDM17",BDMJOB,BDMBTH,"AUDIT",BDMPD,70))
+3 IF $EXTRACT(V)=1!($EXTRACT(V)=2)
SET $PIECE(BDMCUML(180,1),U,2)=$PIECE(BDMCUML(180,1),U,2)+1
+4 QUIT
