BUDBRP7T ; IHS/CMI/LAB - UDS REPORT DRIVER TABLE 6B ;
;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50
;
;
PAUSE ;
K DIR S DIR(0)="E",DIR("A")="PRESS ENTER" KILL DA D ^DIR KILL DIR
Q
GENI ;general introductions
W !,"NOTE: Patient lists may be hundreds of pages long, depending on the size of your"
W !,"patient population. It is recommended that you run these reports at night and"
W !,"print to an electronic file, not directly to a printer.",!
K DIR S DIR(0)="E",DIR("A")="Press Enter to Continue" D ^DIR K DIR
W !!,"This Patient List option documents the individual patients and visits"
W !,"that are counted and summarized on each Table report (main menu"
W !,"option REP). The summary Table report is included at the beginning of each"
W !,"List report."
W !,"UDS searches your database to find all visits and related patients"
W !,"during the time period selected. Based on the UDS definition, to be counted"
W !,"as a patient, the patient must have had at least one visit meeting the "
W !,"following criteria:"
W !?4,"- must be to a location specified in your visit location setup"
W !?4,"- must be to Service Category Ambulatory (A), Hospitalization (H), Day"
W !?6,"Surgery (S), Observation (O), Telemedicine (M), Nursing home visit (R), "
W !?6,"or In-Hospital (I) visit"
W !?4,"- must NOT have an excluded clinic code (see User Manual for a list)"
W !?4,"- must have a primary provider and a coded purpose of visit"
W !?4,"- the patient must NOT have a gender of 'Unknown'"
W !
Q
;
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
USR() ;EP - Return name of current user from ^VA(200.
Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
;----------
;
;
DMR3 ;EP
W:$D(IOF) @IOF
W !,$$CTR($$LOC,80)
W !,$$CTR("UDS 2014",80)
W !!,"All Patients w/DM and A1c >9 by Race and Hispanic or Latino Identity (Table 7)",!
D GENI
D PAUSE
W !!,"This report provides a list by race and Hispanic or Latino Identity of "
W !,"patients age 18 to 75 years old who have had two medical visits during"
W !,"the report period, with a diagnosis of Type I or Type II diabetes anytime"
W !,"through the end of the report period, and without a diagnosis of "
W !,"polycystic ovaries, gestational diabetes, or steroid-induced diabetes"
W !,"and with a most recent hemoglobin A1c greater than 9%, or with an A1c"
W !,"with no result, or with no A1c test during the report period."
W !
Q
DMR3L ;EP
S BUDP=0,BUDQUIT=0,BUDTOT=0
D DMR3H Q:BUDQUIT
I '$D(^XTMP("BUDBRP7",BUDJ,BUDH,"DMR3")) W !!,"No patients to report." Q
D DMR3L1
I $Y>(IOSL-3) D DMR3H G:BUDQUIT DMR3LX
W !!,"TOTAL DIABETES PATIENTS 18-75 W/A1C >9% BY RACE AND HISPANIC ",!,"OR LATINO IDENTITY: ",BUDTOT,!
DMR3LX ;
Q
DMR3L1 ;
I $Y>(IOSL-7) D DMR3H Q:BUDQUIT
S BUDTOT=0
S BUDRACE="" F S BUDRACE=$O(^XTMP("BUDBRP7",BUDJ,BUDH,"DMR3",BUDRACE)) Q:BUDRACE=""!(BUDQUIT) D
.S BUDETH="" F S BUDETH=$O(^XTMP("BUDBRP7",BUDJ,BUDH,"DMR3",BUDRACE,BUDETH)) Q:BUDETH=""!(BUDQUIT) D DMR3L2
Q
DMR3L2 ;
S BUDSTOT=0
S BUDRACEL=$$RACEL^BUDBRP7I(BUDRACE,BUDETH)
W !,BUDRACEL
S BUDCOM="" F S BUDCOM=$O(^XTMP("BUDBRP7",BUDJ,BUDH,"DMR3",BUDRACE,BUDETH,BUDCOM)) Q:BUDCOM=""!(BUDQUIT) D
.S BUDA="" F S BUDA=$O(^XTMP("BUDBRP7",BUDJ,BUDH,"DMR3",BUDRACE,BUDETH,BUDCOM,BUDA)) Q:BUDA=""!(BUDQUIT) D
..S BUDNAME="" F S BUDNAME=$O(^XTMP("BUDBRP7",BUDJ,BUDH,"DMR3",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME)) Q:BUDNAME=""!(BUDQUIT) D
...S DFN=0 F S DFN=$O(^XTMP("BUDBRP7",BUDJ,BUDH,"DMR3",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME,DFN)) Q:DFN'=+DFN!(BUDQUIT) D
....I $Y>(IOSL-3) D DMR3H Q:BUDQUIT W !,BUDRACEL,!
....W !?2,$E($P(^DPT(DFN,0),U,1),1,20),?24,$S($$HRN^AUPNPAT(DFN,BUDSITE)]"":$$HRN^AUPNPAT(DFN,BUDSITE,2),1:$$HRN^AUPNPAT(DFN,DUZ(2),2)),?36,$E(BUDCOM,1,10),?47,$P(^DPT(DFN,0),U,2),?51,BUDA,! ;
....S BUDTOT=BUDTOT+1,BUDSTOT=BUDSTOT+1
....S BUDRACV=$$RACE^BUDBRPTC(DFN)
....W ?2,$E($P(BUDRACV,U,4),1,16)_" ("_$P(BUDRACV,U,3),")" ;,?60,$E($P($$RACE^BUDBRPTC(DFN),U,3)_"-"_$P($$RACE^BUDBRPTC(DFN),U,4),1,19)
....S BUDHISV=$$HISP^BUDBRPTC(DFN)
....W ?24,$P(BUDHISV,U,3)," (",$P(BUDHISV,U,2),")",!
....S BUDALL=^XTMP("BUDBRP7",BUDJ,BUDH,"DMR3",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME,DFN)
....S BUDPPV=$P(BUDALL,"^",1)
....W ?5,$P(BUDALL,"^",2),!
....F BUDX=1:1 S BUDV=$P(BUDPPV,U,BUDX) Q:BUDV=""!(BUDQUIT) D
.....I $Y>(IOSL-3) D DMR3H Q:BUDQUIT W !,BUDRACEL,!
.....I $E(BUDV)="P" W ?5,BUDV,! Q
.....S V=$P(BUDV,"|"),C=$P(BUDV,"|",2)
.....W ?5,$$FMTE^XLFDT($P($P(^AUPNVSIT(V,0),U),".")),?19,C,?35,$$PRIMPROV^APCLV(V,"D"),?45,$P(^AUPNVSIT(V,0),U,7),?53,$$CLINIC^APCLV(V,"C"),?65,$E($$VAL^XBDIQ1(9000010,V,.06),1,15),!
I $Y>(IOSL-4) D DMR3H Q:BUDQUIT W !,BUDRACEL,!
W !,"Sub-Total ",BUDRACEL,": ",BUDSTOT,!
Q
DMR3H ;
G:'BUDGPG DMR3H1
K DIR I $E(IOST)="C",IO=IO(0),'$D(ZTQUEUED) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BUDQUIT=1 Q
DMR3H1 ;
W:$D(IOF) @IOF S BUDGPG=BUDGPG+1
W !,"***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****"
W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BUDGPG,!
W !,$$CTR("*** RPMS Uniform Data System (UDS) ***",80)
W !,$$CTR("Patient List for Table 7, Section C",80)
W !,$$CTR("Diabetes w/o A1c or >9 by Race and Hispanic or Latino Identity ",80),!
W $$CTR($P(^DIC(4,BUDSITE,0),U),80),!
S X="Reporting Period: "_$$FMTE^XLFDT(BUDBD)_" to "_$$FMTE^XLFDT(BUDED) W $$CTR(X,80),!
W $TR($J("",80)," ","-")
I BUDP=0 D
.W !,"List by race and Hispanic or Latino identity of patients age 18 to 75 years "
.W !,"old who have had two medical visits during the report period and were "
.W !,"diagnosed with Type I or Type II diabetes anytime through the end of the "
.W !,"report period and whose most recent hemoglobin A1c is >9%, or did not have "
.W !,"a result, or the patient did not have an A1c test during the report period."
.W !,"Age is calculated as of December 31."
.W !,"* E - denotes the value was obtained from the Ethnicity field."
.W !," R - denotes the value was obtained from the Race field"
.W !," C - denotes the value was obtained from the Classification/Beneficiary field"
.W !
W !?2,"PATIENT NAME",?24,"HRN",?36,"COMMUNITY",?47,"SEX",?51,"AGE"
W !?2,"RACE*",?24,"HISPANIC OR LATINO IDENTITY*"
W !?5,"LAST A1C VALUE OR CD & DATE"
W !?5,"LAST DM DATE",?19,"DX OR SVC CD",?35,"PROV TYPE",?45,"SVC CAT",?53,"CLINIC",?65,"LOCATION"
W !,$TR($J("",80)," ","-"),!
S BUDP=1
Q
;
DMR2 ;EP
W:$D(IOF) @IOF
W !,$$CTR($$LOC,80)
W !,$$CTR("UDS 2014",80)
W !!,"All DM Patients w/A1c >=8 and <=9 by Race & Hisp Identity (Table 7)",!
D GENI
D PAUSE
W !!,"This report provides a list by race and Hispanic or Latino Identity of "
W !,"patients age 18 to 75 years old who have had two medical visits during"
W !,"the report period, with a diagnosis of Type I or Type II diabetes anytime"
W !,"through the end of the report period, and without a diagnosis of "
W !,"polycystic ovaries, gestational diabetes, or steroid-induced diabetes"
W !,"and with a most recent hemoglobin A1c greater than or equal to 8% and "
W !,"less than or equal to 9%."
W !
Q
DMR2L ;EP
S BUDP=0,BUDQUIT=0,BUDTOT=0
D DMR2H Q:BUDQUIT
I '$D(^XTMP("BUDBRP7",BUDJ,BUDH,"DMR2")) W !!,"No patients to report." Q
D DMR2L1
I $Y>(IOSL-3) D DMR2H G:BUDQUIT DMR2LX
W !!,"TOTAL DIABETES PATIENTS 18-75 W/A1C >=8 and <=9% BY RACE AND HISPANIC ",!,"OR LATINO IDENTITY: ",BUDTOT,!
DMR2LX ;
Q
DMR2L1 ;
I $Y>(IOSL-7) D DMR2H Q:BUDQUIT
S BUDTOT=0
S BUDRACE="" F S BUDRACE=$O(^XTMP("BUDBRP7",BUDJ,BUDH,"DMR2",BUDRACE)) Q:BUDRACE=""!(BUDQUIT) D
.S BUDETH="" F S BUDETH=$O(^XTMP("BUDBRP7",BUDJ,BUDH,"DMR2",BUDRACE,BUDETH)) Q:BUDETH=""!(BUDQUIT) D DMR2L2
Q
DMR2L2 ;
S BUDSTOT=0
S BUDRACEL=$$RACEL^BUDBRP7I(BUDRACE,BUDETH)
W !,BUDRACEL
S BUDCOM="" F S BUDCOM=$O(^XTMP("BUDBRP7",BUDJ,BUDH,"DMR2",BUDRACE,BUDETH,BUDCOM)) Q:BUDCOM=""!(BUDQUIT) D
.S BUDA="" F S BUDA=$O(^XTMP("BUDBRP7",BUDJ,BUDH,"DMR2",BUDRACE,BUDETH,BUDCOM,BUDA)) Q:BUDA=""!(BUDQUIT) D
..S BUDNAME="" F S BUDNAME=$O(^XTMP("BUDBRP7",BUDJ,BUDH,"DMR2",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME)) Q:BUDNAME=""!(BUDQUIT) D
...S DFN=0 F S DFN=$O(^XTMP("BUDBRP7",BUDJ,BUDH,"DMR2",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME,DFN)) Q:DFN'=+DFN!(BUDQUIT) D
....I $Y>(IOSL-3) D DMR2H Q:BUDQUIT W !,BUDRACEL,!
....W !?2,$E($P(^DPT(DFN,0),U,1),1,20),?24,$S($$HRN^AUPNPAT(DFN,BUDSITE)]"":$$HRN^AUPNPAT(DFN,BUDSITE,2),1:$$HRN^AUPNPAT(DFN,DUZ(2),2)),?36,$E(BUDCOM,1,10),?47,$P(^DPT(DFN,0),U,2),?51,BUDA,! ;
....S BUDTOT=BUDTOT+1,BUDSTOT=BUDSTOT+1
....S BUDRACV=$$RACE^BUDBRPTC(DFN)
....W ?2,$E($P(BUDRACV,U,4),1,16)_" ("_$P(BUDRACV,U,3),")" ;,?60,$E($P($$RACE^BUDBRPTC(DFN),U,3)_"-"_$P($$RACE^BUDBRPTC(DFN),U,4),1,19)
....S BUDHISV=$$HISP^BUDBRPTC(DFN)
....W ?24,$P(BUDHISV,U,3)," (",$P(BUDHISV,U,2),")",!
....S BUDALL=^XTMP("BUDBRP7",BUDJ,BUDH,"DMR2",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME,DFN)
....S BUDPPV=$P(BUDALL,"^",1)
....W ?5,$P(BUDALL,"^",2),!
....F BUDX=1:1 S BUDV=$P(BUDPPV,U,BUDX) Q:BUDV=""!(BUDQUIT) D
.....I $Y>(IOSL-3) D DMR2H Q:BUDQUIT W !,BUDRACEL,!
.....I $E(BUDV)="P" W ?5,BUDV,! Q
.....S V=$P(BUDV,"|"),C=$P(BUDV,"|",2)
.....W ?5,$$FMTE^XLFDT($P($P(^AUPNVSIT(V,0),U),".")),?19,C,?35,$$PRIMPROV^APCLV(V,"D"),?45,$P(^AUPNVSIT(V,0),U,7),?53,$$CLINIC^APCLV(V,"C"),?65,$E($$VAL^XBDIQ1(9000010,V,.06),1,15),!
I $Y>(IOSL-4) D DMR2H Q:BUDQUIT W !,BUDRACEL,!
W !,"Sub-Total ",BUDRACEL,": ",BUDSTOT,!
Q
DMR2H ;
G:'BUDGPG DMR2H1
K DIR I $E(IOST)="C",IO=IO(0),'$D(ZTQUEUED) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BUDQUIT=1 Q
DMR2H1 ;
W:$D(IOF) @IOF S BUDGPG=BUDGPG+1
W !,"***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****"
W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BUDGPG,!
W !,$$CTR("*** RPMS Uniform Data System (UDS) ***",80)
W !,$$CTR("Patient List for Table 7, Section C",80)
W !,$$CTR("Diabetes w/A1c >=8 and <=9 by Race and Hispanic or Latino Identity",80),!
W $$CTR($P(^DIC(4,BUDSITE,0),U),80),!
S X="Reporting Period: "_$$FMTE^XLFDT(BUDBD)_" to "_$$FMTE^XLFDT(BUDED) W $$CTR(X,80),!
W $TR($J("",80)," ","-")
I BUDP=0 D
.W !,"List by race and Hispanic or Latino identity of patients 18 to 75 years"
.W !,"old who have had two medical visits during the report period"
.W !,"and were diagnosed with Type I or Type II diabetes anytime"
.W !,"through the end of the report period and whose most recent"
.W !,"hemoglobin A1c is >=8% and <=9%."
.W !,"Age is calculated as of December 31."
.W !,"* E - denotes the value was obtained from the Ethnicity field."
.W !," R - denotes the value was obtained from the Race field"
.W !," C - denotes the value was obtained from the Classification/Beneficiary field"
.W !
W !?2,"PATIENT NAME",?24,"HRN",?36,"COMMUNITY",?47,"SEX",?51,"AGE"
W !?2,"RACE*",?24,"HISPANIC OR LATINO IDENTITY*"
W !?5,"LAST A1C VALUE OR CD & DATE"
W !?5,"LAST DM DATE",?19,"DX OR SVC CD",?35,"PROV TYPE",?45,"SVC CAT",?53,"CLINIC",?65,"LOCATION"
W !,$TR($J("",80)," ","-"),!
S BUDP=1
Q
;
BUDBRP7T ; IHS/CMI/LAB - UDS REPORT DRIVER TABLE 6B ;
+1 ;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50
+2 ;
+3 ;
PAUSE ;
+1 KILL DIR
SET DIR(0)="E"
SET DIR("A")="PRESS ENTER"
KILL DA
DO ^DIR
KILL DIR
+2 QUIT
GENI ;general introductions
+1 WRITE !,"NOTE: Patient lists may be hundreds of pages long, depending on the size of your"
+2 WRITE !,"patient population. It is recommended that you run these reports at night and"
+3 WRITE !,"print to an electronic file, not directly to a printer.",!
+4 KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Enter to Continue"
DO ^DIR
KILL DIR
+5 WRITE !!,"This Patient List option documents the individual patients and visits"
+6 WRITE !,"that are counted and summarized on each Table report (main menu"
+7 WRITE !,"option REP). The summary Table report is included at the beginning of each"
+8 WRITE !,"List report."
+9 WRITE !,"UDS searches your database to find all visits and related patients"
+10 WRITE !,"during the time period selected. Based on the UDS definition, to be counted"
+11 WRITE !,"as a patient, the patient must have had at least one visit meeting the "
+12 WRITE !,"following criteria:"
+13 WRITE !?4,"- must be to a location specified in your visit location setup"
+14 WRITE !?4,"- must be to Service Category Ambulatory (A), Hospitalization (H), Day"
+15 WRITE !?6,"Surgery (S), Observation (O), Telemedicine (M), Nursing home visit (R), "
+16 WRITE !?6,"or In-Hospital (I) visit"
+17 WRITE !?4,"- must NOT have an excluded clinic code (see User Manual for a list)"
+18 WRITE !?4,"- must have a primary provider and a coded purpose of visit"
+19 WRITE !?4,"- the patient must NOT have a gender of 'Unknown'"
+20 WRITE !
+21 QUIT
+22 ;
CTR(X,Y) ;EP - Center X in a field Y wide.
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
+2 ;----------
USR() ;EP - Return name of current user from ^VA(200.
+1 QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
+2 ;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
+1 QUIT $SELECT($GET(DUZ(2)):$SELECT($DATA(^DIC(4,DUZ(2),0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
+2 ;----------
+3 ;
+4 ;
DMR3 ;EP
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$$CTR($$LOC,80)
+3 WRITE !,$$CTR("UDS 2014",80)
+4 WRITE !!,"All Patients w/DM and A1c >9 by Race and Hispanic or Latino Identity (Table 7)",!
+5 DO GENI
+6 DO PAUSE
+7 WRITE !!,"This report provides a list by race and Hispanic or Latino Identity of "
+8 WRITE !,"patients age 18 to 75 years old who have had two medical visits during"
+9 WRITE !,"the report period, with a diagnosis of Type I or Type II diabetes anytime"
+10 WRITE !,"through the end of the report period, and without a diagnosis of "
+11 WRITE !,"polycystic ovaries, gestational diabetes, or steroid-induced diabetes"
+12 WRITE !,"and with a most recent hemoglobin A1c greater than 9%, or with an A1c"
+13 WRITE !,"with no result, or with no A1c test during the report period."
+14 WRITE !
+15 QUIT
DMR3L ;EP
+1 SET BUDP=0
SET BUDQUIT=0
SET BUDTOT=0
+2 DO DMR3H
IF BUDQUIT
QUIT
+3 IF '$DATA(^XTMP("BUDBRP7",BUDJ,BUDH,"DMR3"))
WRITE !!,"No patients to report."
QUIT
+4 DO DMR3L1
+5 IF $Y>(IOSL-3)
DO DMR3H
IF BUDQUIT
GOTO DMR3LX
+6 WRITE !!,"TOTAL DIABETES PATIENTS 18-75 W/A1C >9% BY RACE AND HISPANIC ",!,"OR LATINO IDENTITY: ",BUDTOT,!
DMR3LX ;
+1 QUIT
DMR3L1 ;
+1 IF $Y>(IOSL-7)
DO DMR3H
IF BUDQUIT
QUIT
+2 SET BUDTOT=0
+3 SET BUDRACE=""
FOR
SET BUDRACE=$ORDER(^XTMP("BUDBRP7",BUDJ,BUDH,"DMR3",BUDRACE))
IF BUDRACE=""!(BUDQUIT)
QUIT
Begin DoDot:1
+4 SET BUDETH=""
FOR
SET BUDETH=$ORDER(^XTMP("BUDBRP7",BUDJ,BUDH,"DMR3",BUDRACE,BUDETH))
IF BUDETH=""!(BUDQUIT)
QUIT
DO DMR3L2
End DoDot:1
+5 QUIT
DMR3L2 ;
+1 SET BUDSTOT=0
+2 SET BUDRACEL=$$RACEL^BUDBRP7I(BUDRACE,BUDETH)
+3 WRITE !,BUDRACEL
+4 SET BUDCOM=""
FOR
SET BUDCOM=$ORDER(^XTMP("BUDBRP7",BUDJ,BUDH,"DMR3",BUDRACE,BUDETH,BUDCOM))
IF BUDCOM=""!(BUDQUIT)
QUIT
Begin DoDot:1
+5 SET BUDA=""
FOR
SET BUDA=$ORDER(^XTMP("BUDBRP7",BUDJ,BUDH,"DMR3",BUDRACE,BUDETH,BUDCOM,BUDA))
IF BUDA=""!(BUDQUIT)
QUIT
Begin DoDot:2
+6 SET BUDNAME=""
FOR
SET BUDNAME=$ORDER(^XTMP("BUDBRP7",BUDJ,BUDH,"DMR3",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME))
IF BUDNAME=""!(BUDQUIT)
QUIT
Begin DoDot:3
+7 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("BUDBRP7",BUDJ,BUDH,"DMR3",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME,DFN))
IF DFN'=+DFN!(BUDQUIT)
QUIT
Begin DoDot:4
+8 IF $Y>(IOSL-3)
DO DMR3H
IF BUDQUIT
QUIT
WRITE !,BUDRACEL,!
+9 ;
WRITE !?2,$EXTRACT($PIECE(^DPT(DFN,0),U,1),1,20),?24,$SELECT($$HRN^AUPNPAT(DFN,BUDSITE)]"":$$HRN^AUPNPAT(DFN,BUDSITE,2),1:$$HRN^AUPNPAT(DFN,DUZ(2),2)),?36,$EXTRACT(BUDCOM,1,10),?47,$PIECE(^DPT(DFN,0),U,2),?51,BUD
A,!
+10 SET BUDTOT=BUDTOT+1
SET BUDSTOT=BUDSTOT+1
+11 SET BUDRACV=$$RACE^BUDBRPTC(DFN)
+12 ;,?60,$E($P($$RACE^BUDBRPTC(DFN),U,3)_"-"_$P($$RACE^BUDBRPTC(DFN),U,4),1,19)
WRITE ?2,$EXTRACT($PIECE(BUDRACV,U,4),1,16)_" ("_$PIECE(BUDRACV,U,3),")"
+13 SET BUDHISV=$$HISP^BUDBRPTC(DFN)
+14 WRITE ?24,$PIECE(BUDHISV,U,3)," (",$PIECE(BUDHISV,U,2),")",!
+15 SET BUDALL=^XTMP("BUDBRP7",BUDJ,BUDH,"DMR3",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME,DFN)
+16 SET BUDPPV=$PIECE(BUDALL,"^",1)
+17 WRITE ?5,$PIECE(BUDALL,"^",2),!
+18 FOR BUDX=1:1
SET BUDV=$PIECE(BUDPPV,U,BUDX)
IF BUDV=""!(BUDQUIT)
QUIT
Begin DoDot:5
+19 IF $Y>(IOSL-3)
DO DMR3H
IF BUDQUIT
QUIT
WRITE !,BUDRACEL,!
+20 IF $EXTRACT(BUDV)="P"
WRITE ?5,BUDV,!
QUIT
+21 SET V=$PIECE(BUDV,"|")
SET C=$PIECE(BUDV,"|",2)
+22 WRITE ?5,$$FMTE^XLFDT($PIECE($PIECE(^AUPNVSIT(V,0),U),".")),?19,C,?35,$$PRIMPROV^APCLV(V,"D"),?45,$PIECE(^AUPNVSIT(V,0),U,7),?53,$$CLINIC^APCLV(V,"C"),?65,$EXTRACT($$VAL^XBDIQ1(9000010,V,.06),1,15),!
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+23 IF $Y>(IOSL-4)
DO DMR3H
IF BUDQUIT
QUIT
WRITE !,BUDRACEL,!
+24 WRITE !,"Sub-Total ",BUDRACEL,": ",BUDSTOT,!
+25 QUIT
DMR3H ;
+1 IF 'BUDGPG
GOTO DMR3H1
+2 KILL DIR
IF $EXTRACT(IOST)="C"
IF IO=IO(0)
IF '$DATA(ZTQUEUED)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET BUDQUIT=1
QUIT
DMR3H1 ;
+1 IF $DATA(IOF)
WRITE @IOF
SET BUDGPG=BUDGPG+1
+2 WRITE !,"***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****"
+3 WRITE !?3,$PIECE(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BUDGPG,!
+4 WRITE !,$$CTR("*** RPMS Uniform Data System (UDS) ***",80)
+5 WRITE !,$$CTR("Patient List for Table 7, Section C",80)
+6 WRITE !,$$CTR("Diabetes w/o A1c or >9 by Race and Hispanic or Latino Identity ",80),!
+7 WRITE $$CTR($PIECE(^DIC(4,BUDSITE,0),U),80),!
+8 SET X="Reporting Period: "_$$FMTE^XLFDT(BUDBD)_" to "_$$FMTE^XLFDT(BUDED)
WRITE $$CTR(X,80),!
+9 WRITE $TRANSLATE($JUSTIFY("",80)," ","-")
+10 IF BUDP=0
Begin DoDot:1
+11 WRITE !,"List by race and Hispanic or Latino identity of patients age 18 to 75 years "
+12 WRITE !,"old who have had two medical visits during the report period and were "
+13 WRITE !,"diagnosed with Type I or Type II diabetes anytime through the end of the "
+14 WRITE !,"report period and whose most recent hemoglobin A1c is >9%, or did not have "
+15 WRITE !,"a result, or the patient did not have an A1c test during the report period."
+16 WRITE !,"Age is calculated as of December 31."
+17 WRITE !,"* E - denotes the value was obtained from the Ethnicity field."
+18 WRITE !," R - denotes the value was obtained from the Race field"
+19 WRITE !," C - denotes the value was obtained from the Classification/Beneficiary field"
+20 WRITE !
End DoDot:1
+21 WRITE !?2,"PATIENT NAME",?24,"HRN",?36,"COMMUNITY",?47,"SEX",?51,"AGE"
+22 WRITE !?2,"RACE*",?24,"HISPANIC OR LATINO IDENTITY*"
+23 WRITE !?5,"LAST A1C VALUE OR CD & DATE"
+24 WRITE !?5,"LAST DM DATE",?19,"DX OR SVC CD",?35,"PROV TYPE",?45,"SVC CAT",?53,"CLINIC",?65,"LOCATION"
+25 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-"),!
+26 SET BUDP=1
+27 QUIT
+28 ;
DMR2 ;EP
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$$CTR($$LOC,80)
+3 WRITE !,$$CTR("UDS 2014",80)
+4 WRITE !!,"All DM Patients w/A1c >=8 and <=9 by Race & Hisp Identity (Table 7)",!
+5 DO GENI
+6 DO PAUSE
+7 WRITE !!,"This report provides a list by race and Hispanic or Latino Identity of "
+8 WRITE !,"patients age 18 to 75 years old who have had two medical visits during"
+9 WRITE !,"the report period, with a diagnosis of Type I or Type II diabetes anytime"
+10 WRITE !,"through the end of the report period, and without a diagnosis of "
+11 WRITE !,"polycystic ovaries, gestational diabetes, or steroid-induced diabetes"
+12 WRITE !,"and with a most recent hemoglobin A1c greater than or equal to 8% and "
+13 WRITE !,"less than or equal to 9%."
+14 WRITE !
+15 QUIT
DMR2L ;EP
+1 SET BUDP=0
SET BUDQUIT=0
SET BUDTOT=0
+2 DO DMR2H
IF BUDQUIT
QUIT
+3 IF '$DATA(^XTMP("BUDBRP7",BUDJ,BUDH,"DMR2"))
WRITE !!,"No patients to report."
QUIT
+4 DO DMR2L1
+5 IF $Y>(IOSL-3)
DO DMR2H
IF BUDQUIT
GOTO DMR2LX
+6 WRITE !!,"TOTAL DIABETES PATIENTS 18-75 W/A1C >=8 and <=9% BY RACE AND HISPANIC ",!,"OR LATINO IDENTITY: ",BUDTOT,!
DMR2LX ;
+1 QUIT
DMR2L1 ;
+1 IF $Y>(IOSL-7)
DO DMR2H
IF BUDQUIT
QUIT
+2 SET BUDTOT=0
+3 SET BUDRACE=""
FOR
SET BUDRACE=$ORDER(^XTMP("BUDBRP7",BUDJ,BUDH,"DMR2",BUDRACE))
IF BUDRACE=""!(BUDQUIT)
QUIT
Begin DoDot:1
+4 SET BUDETH=""
FOR
SET BUDETH=$ORDER(^XTMP("BUDBRP7",BUDJ,BUDH,"DMR2",BUDRACE,BUDETH))
IF BUDETH=""!(BUDQUIT)
QUIT
DO DMR2L2
End DoDot:1
+5 QUIT
DMR2L2 ;
+1 SET BUDSTOT=0
+2 SET BUDRACEL=$$RACEL^BUDBRP7I(BUDRACE,BUDETH)
+3 WRITE !,BUDRACEL
+4 SET BUDCOM=""
FOR
SET BUDCOM=$ORDER(^XTMP("BUDBRP7",BUDJ,BUDH,"DMR2",BUDRACE,BUDETH,BUDCOM))
IF BUDCOM=""!(BUDQUIT)
QUIT
Begin DoDot:1
+5 SET BUDA=""
FOR
SET BUDA=$ORDER(^XTMP("BUDBRP7",BUDJ,BUDH,"DMR2",BUDRACE,BUDETH,BUDCOM,BUDA))
IF BUDA=""!(BUDQUIT)
QUIT
Begin DoDot:2
+6 SET BUDNAME=""
FOR
SET BUDNAME=$ORDER(^XTMP("BUDBRP7",BUDJ,BUDH,"DMR2",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME))
IF BUDNAME=""!(BUDQUIT)
QUIT
Begin DoDot:3
+7 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("BUDBRP7",BUDJ,BUDH,"DMR2",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME,DFN))
IF DFN'=+DFN!(BUDQUIT)
QUIT
Begin DoDot:4
+8 IF $Y>(IOSL-3)
DO DMR2H
IF BUDQUIT
QUIT
WRITE !,BUDRACEL,!
+9 ;
WRITE !?2,$EXTRACT($PIECE(^DPT(DFN,0),U,1),1,20),?24,$SELECT($$HRN^AUPNPAT(DFN,BUDSITE)]"":$$HRN^AUPNPAT(DFN,BUDSITE,2),1:$$HRN^AUPNPAT(DFN,DUZ(2),2)),?36,$EXTRACT(BUDCOM,1,10),?47,$PIECE(^DPT(DFN,0),U,2),?51,BUD
A,!
+10 SET BUDTOT=BUDTOT+1
SET BUDSTOT=BUDSTOT+1
+11 SET BUDRACV=$$RACE^BUDBRPTC(DFN)
+12 ;,?60,$E($P($$RACE^BUDBRPTC(DFN),U,3)_"-"_$P($$RACE^BUDBRPTC(DFN),U,4),1,19)
WRITE ?2,$EXTRACT($PIECE(BUDRACV,U,4),1,16)_" ("_$PIECE(BUDRACV,U,3),")"
+13 SET BUDHISV=$$HISP^BUDBRPTC(DFN)
+14 WRITE ?24,$PIECE(BUDHISV,U,3)," (",$PIECE(BUDHISV,U,2),")",!
+15 SET BUDALL=^XTMP("BUDBRP7",BUDJ,BUDH,"DMR2",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME,DFN)
+16 SET BUDPPV=$PIECE(BUDALL,"^",1)
+17 WRITE ?5,$PIECE(BUDALL,"^",2),!
+18 FOR BUDX=1:1
SET BUDV=$PIECE(BUDPPV,U,BUDX)
IF BUDV=""!(BUDQUIT)
QUIT
Begin DoDot:5
+19 IF $Y>(IOSL-3)
DO DMR2H
IF BUDQUIT
QUIT
WRITE !,BUDRACEL,!
+20 IF $EXTRACT(BUDV)="P"
WRITE ?5,BUDV,!
QUIT
+21 SET V=$PIECE(BUDV,"|")
SET C=$PIECE(BUDV,"|",2)
+22 WRITE ?5,$$FMTE^XLFDT($PIECE($PIECE(^AUPNVSIT(V,0),U),".")),?19,C,?35,$$PRIMPROV^APCLV(V,"D"),?45,$PIECE(^AUPNVSIT(V,0),U,7),?53,$$CLINIC^APCLV(V,"C"),?65,$EXTRACT($$VAL^XBDIQ1(9000010,V,.06),1,15),!
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+23 IF $Y>(IOSL-4)
DO DMR2H
IF BUDQUIT
QUIT
WRITE !,BUDRACEL,!
+24 WRITE !,"Sub-Total ",BUDRACEL,": ",BUDSTOT,!
+25 QUIT
DMR2H ;
+1 IF 'BUDGPG
GOTO DMR2H1
+2 KILL DIR
IF $EXTRACT(IOST)="C"
IF IO=IO(0)
IF '$DATA(ZTQUEUED)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET BUDQUIT=1
QUIT
DMR2H1 ;
+1 IF $DATA(IOF)
WRITE @IOF
SET BUDGPG=BUDGPG+1
+2 WRITE !,"***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****"
+3 WRITE !?3,$PIECE(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BUDGPG,!
+4 WRITE !,$$CTR("*** RPMS Uniform Data System (UDS) ***",80)
+5 WRITE !,$$CTR("Patient List for Table 7, Section C",80)
+6 WRITE !,$$CTR("Diabetes w/A1c >=8 and <=9 by Race and Hispanic or Latino Identity",80),!
+7 WRITE $$CTR($PIECE(^DIC(4,BUDSITE,0),U),80),!
+8 SET X="Reporting Period: "_$$FMTE^XLFDT(BUDBD)_" to "_$$FMTE^XLFDT(BUDED)
WRITE $$CTR(X,80),!
+9 WRITE $TRANSLATE($JUSTIFY("",80)," ","-")
+10 IF BUDP=0
Begin DoDot:1
+11 WRITE !,"List by race and Hispanic or Latino identity of patients 18 to 75 years"
+12 WRITE !,"old who have had two medical visits during the report period"
+13 WRITE !,"and were diagnosed with Type I or Type II diabetes anytime"
+14 WRITE !,"through the end of the report period and whose most recent"
+15 WRITE !,"hemoglobin A1c is >=8% and <=9%."
+16 WRITE !,"Age is calculated as of December 31."
+17 WRITE !,"* E - denotes the value was obtained from the Ethnicity field."
+18 WRITE !," R - denotes the value was obtained from the Race field"
+19 WRITE !," C - denotes the value was obtained from the Classification/Beneficiary field"
+20 WRITE !
End DoDot:1
+21 WRITE !?2,"PATIENT NAME",?24,"HRN",?36,"COMMUNITY",?47,"SEX",?51,"AGE"
+22 WRITE !?2,"RACE*",?24,"HISPANIC OR LATINO IDENTITY*"
+23 WRITE !?5,"LAST A1C VALUE OR CD & DATE"
+24 WRITE !?5,"LAST DM DATE",?19,"DX OR SVC CD",?35,"PROV TYPE",?45,"SVC CAT",?53,"CLINIC",?65,"LOCATION"
+25 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-"),!
+26 SET BUDP=1
+27 QUIT
+28 ;
