- BUDARP7L ; 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
- D GENI^BUDARP7I
- 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")
- ;----------
- ;
- DMR ;EP
- W:$D(IOF) @IOF
- W !,$$CTR($$LOC,80)
- W !,$$CTR("UDS 2013",80)
- W !!,"All Patients w/DM by Race and Hispanic or Latino Identity (Table 7)",!
- D GENI
- D PAUSE
- W !!,"This report provides a list by race of patients age 18 to 75 years old who"
- W !,"have had two medical visits during the report period, with a diagnosis"
- W !,"of Type I or Type II diabetes anytime through the end of the report"
- W !,"period, and without a diagnosis of polycystic ovaries, gestational"
- W !,"diabetes, or steroid-induced diabetes."
- W !
- Q
- DMRL ;EP
- S BUDP=0,BUDQUIT=0,BUDTOT=0
- D DMRH Q:BUDQUIT
- I '$D(^XTMP("BUDARP7",BUDJ,BUDH,"DMR")) W !!,"No patients to report." Q
- D DMRL1
- I $Y>(IOSL-3) D DMRH G:BUDQUIT DMRLX
- W !!," TOTAL DIABETES PATIENTS 18-75 BY RACE AND HISPANIC OR LATINO IDENTITY: ",BUDTOT,!
- DMRLX ;
- Q
- DMRL1 ;
- I $Y>(IOSL-7) D DMRH Q:BUDQUIT
- S BUDTOT=0
- S BUDRACE="" F S BUDRACE=$O(^XTMP("BUDARP7",BUDJ,BUDH,"DMR",BUDRACE)) Q:BUDRACE=""!(BUDQUIT) D
- .S BUDETH="" F S BUDETH=$O(^XTMP("BUDARP7",BUDJ,BUDH,"DMR",BUDRACE,BUDETH)) Q:BUDETH=""!(BUDQUIT) D DMRL2
- Q
- DMRL2 ;
- S BUDSTOT=0
- S BUDRACEL=$$RACEL^BUDARP7I(BUDRACE,BUDETH)
- W !,BUDRACEL
- S BUDCOM="" F S BUDCOM=$O(^XTMP("BUDARP7",BUDJ,BUDH,"DMR",BUDRACE,BUDETH,BUDCOM)) Q:BUDCOM=""!(BUDQUIT) D
- .S BUDA="" F S BUDA=$O(^XTMP("BUDARP7",BUDJ,BUDH,"DMR",BUDRACE,BUDETH,BUDCOM,BUDA)) Q:BUDA=""!(BUDQUIT) D
- ..S BUDNAME="" F S BUDNAME=$O(^XTMP("BUDARP7",BUDJ,BUDH,"DMR",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME)) Q:BUDNAME=""!(BUDQUIT) D
- ...S DFN=0 F S DFN=$O(^XTMP("BUDARP7",BUDJ,BUDH,"DMR",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME,DFN)) Q:DFN'=+DFN!(BUDQUIT) D
- ....I $Y>(IOSL-3) D DMRH 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^BUDARPTC(DFN)
- ....W ?2,$E($P(BUDRACV,U,4),1,16)_" ("_$P(BUDRACV,U,3),")" ;,?60,$E($P($$RACE^BUDARPTC(DFN),U,3)_"-"_$P($$RACE^BUDARPTC(DFN),U,4),1,19)
- ....S BUDHISV=$$HISP^BUDARPTC(DFN)
- ....W ?24,$P(BUDHISV,U,3)," (",$P(BUDHISV,U,2),")",!
- ....S BUDALL=^XTMP("BUDARP7",BUDJ,BUDH,"DMR",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 DMRH 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 DMRH Q:BUDQUIT W !,BUDRACEL,!
- W !,"Sub-Total ",BUDRACEL,": ",BUDSTOT,!
- Q
- DMRH ;
- G:'BUDGPG DMRH1
- 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
- DMRH1 ;
- 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 Patients by Race and Hispanic or Latino Identity",80),! ;, DM Patients 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 all patients 18 to 75 years "
- .W !,"old who have had two medical visits during the report period and were diagnosed"
- .W !,"with Type I or Type II diabetes anytime through the end of 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 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
- ;
- DMR1 ;EP
- W:$D(IOF) @IOF
- W !,$$CTR($$LOC,80)
- W !,$$CTR("UDS 2013",80)
- W !!,"All Patients w/DM and A1c <7 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"
- W !,"of patients age 18 to 75 years old who have had two"
- W !,"medical visits during the report period, with a diagnosis"
- W !,"of Type I or Type II diabetes anytime through the end of the report"
- W !,"period, and without a diagnosis of polycystic ovaries, gestational diabetes,"
- W !,"or steroid-induced diabetes and with a most recent hemoglobin A1c of less"
- W !,"than 7%."
- W !
- Q
- DMR1L ;EP
- S BUDP=0,BUDQUIT=0,BUDTOT=0
- D DMR1H Q:BUDQUIT
- I '$D(^XTMP("BUDARP7",BUDJ,BUDH,"DMR1")) W !!,"No patients to report." Q
- D DMR1L1
- I $Y>(IOSL-3) D DMR1H G:BUDQUIT DMR1LX
- W !!,"TOTAL DIABETES PTS 18-75 W/A1C <7% BY RACE & HISPANIC OR LATINO IDENTITY: ",BUDTOT,!
- DMR1LX ;
- Q
- DMR1L1 ;
- I $Y>(IOSL-7) D DMR1H Q:BUDQUIT
- S BUDTOT=0
- S BUDRACE="" F S BUDRACE=$O(^XTMP("BUDARP7",BUDJ,BUDH,"DMR1",BUDRACE)) Q:BUDRACE=""!(BUDQUIT) D
- .S BUDETH="" F S BUDETH=$O(^XTMP("BUDARP7",BUDJ,BUDH,"DMR1",BUDRACE,BUDETH)) Q:BUDETH=""!(BUDQUIT) D DMR1L2
- Q
- DMR1L2 ;
- S BUDSTOT=0
- S BUDRACEL=$$RACEL^BUDARP7I(BUDRACE,BUDETH)
- W !,BUDRACEL
- S BUDCOM="" F S BUDCOM=$O(^XTMP("BUDARP7",BUDJ,BUDH,"DMR1",BUDRACE,BUDETH,BUDCOM)) Q:BUDCOM=""!(BUDQUIT) D
- .S BUDA="" F S BUDA=$O(^XTMP("BUDARP7",BUDJ,BUDH,"DMR1",BUDRACE,BUDETH,BUDCOM,BUDA)) Q:BUDA=""!(BUDQUIT) D
- ..S BUDNAME="" F S BUDNAME=$O(^XTMP("BUDARP7",BUDJ,BUDH,"DMR1",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME)) Q:BUDNAME=""!(BUDQUIT) D
- ...S DFN=0 F S DFN=$O(^XTMP("BUDARP7",BUDJ,BUDH,"DMR1",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME,DFN)) Q:DFN'=+DFN!(BUDQUIT) D
- ....I $Y>(IOSL-3) D DMR1H 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^BUDARPTC(DFN)
- ....W ?2,$E($P(BUDRACV,U,4),1,16)_" ("_$P(BUDRACV,U,3),")" ;,?60,$E($P($$RACE^BUDARPTC(DFN),U,3)_"-"_$P($$RACE^BUDARPTC(DFN),U,4),1,19)
- ....S BUDHISV=$$HISP^BUDARPTC(DFN)
- ....W ?24,$P(BUDHISV,U,3)," (",$P(BUDHISV,U,2),")",!
- ....S BUDALL=^XTMP("BUDARP7",BUDJ,BUDH,"DMR1",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 DMR1H 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 DMR1H Q:BUDQUIT W !,BUDRACEL,!
- W !,"Sub-Total ",BUDRACEL,": ",BUDSTOT,!
- Q
- DMR1H ;
- G:'BUDGPG DMR1H1
- 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
- DMR1H1 ;
- 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 <7 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 all patients 18 to 75 years"
- .W !,"old who have had two medical visits during the report period and were diagnosed"
- .W !,"with Type I or Type II diabetes anytime through the end of the report period "
- .W !,"and whose most recent hemoglobin A1c is <7%."
- .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 2013",80)
- W !!,"All Patients w/DM and A1c >=7 and <8 by Race and Hispanic/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"
- W !,"visits during the report period, with a diagnosis"
- W !,"of Type I or Type II diabetes anytime through the end of the report"
- W !,"period, and without a diagnosis of polycystic ovaries, gestational diabetes,"
- W !,"or steroid-induced diabetes and with a most recent hemoglobin A1c greater"
- W !,"than or equal to 7% and less than 8%."
- W !
- Q
- DMR2L ;EP
- S BUDP=0,BUDQUIT=0,BUDTOT=0
- D DMR2H Q:BUDQUIT
- I '$D(^XTMP("BUDARP7",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 >=7% AND <8% 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("BUDARP7",BUDJ,BUDH,"DMR2",BUDRACE)) Q:BUDRACE=""!(BUDQUIT) D
- .S BUDETH="" F S BUDETH=$O(^XTMP("BUDARP7",BUDJ,BUDH,"DMR2",BUDRACE,BUDETH)) Q:BUDETH=""!(BUDQUIT) D DMR2L2
- Q
- DMR2L2 ;
- S BUDSTOT=0
- S BUDRACEL=$$RACEL^BUDARP7I(BUDRACE,BUDETH)
- W !,BUDRACEL
- S BUDCOM="" F S BUDCOM=$O(^XTMP("BUDARP7",BUDJ,BUDH,"DMR2",BUDRACE,BUDETH,BUDCOM)) Q:BUDCOM=""!(BUDQUIT) D
- .S BUDA="" F S BUDA=$O(^XTMP("BUDARP7",BUDJ,BUDH,"DMR2",BUDRACE,BUDETH,BUDCOM,BUDA)) Q:BUDA=""!(BUDQUIT) D
- ..S BUDNAME="" F S BUDNAME=$O(^XTMP("BUDARP7",BUDJ,BUDH,"DMR2",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME)) Q:BUDNAME=""!(BUDQUIT) D
- ...S DFN=0 F S DFN=$O(^XTMP("BUDARP7",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^BUDARPTC(DFN)
- ....W ?2,$E($P(BUDRACV,U,4),1,16)_" ("_$P(BUDRACV,U,3),")" ;,?60,$E($P($$RACE^BUDARPTC(DFN),U,3)_"-"_$P($$RACE^BUDARPTC(DFN),U,4),1,19)
- ....S BUDHISV=$$HISP^BUDARPTC(DFN)
- ....W ?24,$P(BUDHISV,U,3)," (",$P(BUDHISV,U,2),")",!
- ....S BUDALL=^XTMP("BUDARP7",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 >=7 and <8 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 >=7% and <8%."
- .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
- ;
- BUDARP7L ; 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 DO GENI^BUDARP7I
- +2 QUIT
- +3 ;
- 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 ;
- DMR ;EP
- +1 IF $DATA(IOF)
- WRITE @IOF
- +2 WRITE !,$$CTR($$LOC,80)
- +3 WRITE !,$$CTR("UDS 2013",80)
- +4 WRITE !!,"All Patients w/DM by Race and Hispanic or Latino Identity (Table 7)",!
- +5 DO GENI
- +6 DO PAUSE
- +7 WRITE !!,"This report provides a list by race of patients age 18 to 75 years old who"
- +8 WRITE !,"have had two medical visits during the report period, with a diagnosis"
- +9 WRITE !,"of Type I or Type II diabetes anytime through the end of the report"
- +10 WRITE !,"period, and without a diagnosis of polycystic ovaries, gestational"
- +11 WRITE !,"diabetes, or steroid-induced diabetes."
- +12 WRITE !
- +13 QUIT
- DMRL ;EP
- +1 SET BUDP=0
- SET BUDQUIT=0
- SET BUDTOT=0
- +2 DO DMRH
- IF BUDQUIT
- QUIT
- +3 IF '$DATA(^XTMP("BUDARP7",BUDJ,BUDH,"DMR"))
- WRITE !!,"No patients to report."
- QUIT
- +4 DO DMRL1
- +5 IF $Y>(IOSL-3)
- DO DMRH
- IF BUDQUIT
- GOTO DMRLX
- +6 WRITE !!," TOTAL DIABETES PATIENTS 18-75 BY RACE AND HISPANIC OR LATINO IDENTITY: ",BUDTOT,!
- DMRLX ;
- +1 QUIT
- DMRL1 ;
- +1 IF $Y>(IOSL-7)
- DO DMRH
- IF BUDQUIT
- QUIT
- +2 SET BUDTOT=0
- +3 SET BUDRACE=""
- FOR
- SET BUDRACE=$ORDER(^XTMP("BUDARP7",BUDJ,BUDH,"DMR",BUDRACE))
- IF BUDRACE=""!(BUDQUIT)
- QUIT
- Begin DoDot:1
- +4 SET BUDETH=""
- FOR
- SET BUDETH=$ORDER(^XTMP("BUDARP7",BUDJ,BUDH,"DMR",BUDRACE,BUDETH))
- IF BUDETH=""!(BUDQUIT)
- QUIT
- DO DMRL2
- End DoDot:1
- +5 QUIT
- DMRL2 ;
- +1 SET BUDSTOT=0
- +2 SET BUDRACEL=$$RACEL^BUDARP7I(BUDRACE,BUDETH)
- +3 WRITE !,BUDRACEL
- +4 SET BUDCOM=""
- FOR
- SET BUDCOM=$ORDER(^XTMP("BUDARP7",BUDJ,BUDH,"DMR",BUDRACE,BUDETH,BUDCOM))
- IF BUDCOM=""!(BUDQUIT)
- QUIT
- Begin DoDot:1
- +5 SET BUDA=""
- FOR
- SET BUDA=$ORDER(^XTMP("BUDARP7",BUDJ,BUDH,"DMR",BUDRACE,BUDETH,BUDCOM,BUDA))
- IF BUDA=""!(BUDQUIT)
- QUIT
- Begin DoDot:2
- +6 SET BUDNAME=""
- FOR
- SET BUDNAME=$ORDER(^XTMP("BUDARP7",BUDJ,BUDH,"DMR",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME))
- IF BUDNAME=""!(BUDQUIT)
- QUIT
- Begin DoDot:3
- +7 SET DFN=0
- FOR
- SET DFN=$ORDER(^XTMP("BUDARP7",BUDJ,BUDH,"DMR",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME,DFN))
- IF DFN'=+DFN!(BUDQUIT)
- QUIT
- Begin DoDot:4
- +8 IF $Y>(IOSL-3)
- DO DMRH
- 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^BUDARPTC(DFN)
- +12 ;,?60,$E($P($$RACE^BUDARPTC(DFN),U,3)_"-"_$P($$RACE^BUDARPTC(DFN),U,4),1,19)
- WRITE ?2,$EXTRACT($PIECE(BUDRACV,U,4),1,16)_" ("_$PIECE(BUDRACV,U,3),")"
- +13 SET BUDHISV=$$HISP^BUDARPTC(DFN)
- +14 WRITE ?24,$PIECE(BUDHISV,U,3)," (",$PIECE(BUDHISV,U,2),")",!
- +15 SET BUDALL=^XTMP("BUDARP7",BUDJ,BUDH,"DMR",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME,DFN)
- +16 SET BUDPPV=$PIECE(BUDALL,"^",1)
- +17 ;W ?5,$P(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 DMRH
- 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 DMRH
- IF BUDQUIT
- QUIT
- WRITE !,BUDRACEL,!
- +24 WRITE !,"Sub-Total ",BUDRACEL,": ",BUDSTOT,!
- +25 QUIT
- DMRH ;
- +1 IF 'BUDGPG
- GOTO DMRH1
- +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
- DMRH1 ;
- +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 ;, DM Patients by Race and Hispanic or Latino Identity",80),!
- WRITE !,$$CTR("Diabetes Patients 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 all patients 18 to 75 years "
- +12 WRITE !,"old who have had two medical visits during the report period and were diagnosed"
- +13 WRITE !,"with Type I or Type II diabetes anytime through the end of the report period."
- +14 WRITE !,"Age is calculated as of December 31."
- +15 WRITE !,"* E - denotes the value was obtained from the Ethnicity field."
- +16 WRITE !," R - denotes the value was obtained from the Race field"
- +17 WRITE !," C - denotes the value was obtained from the Classification/Beneficiary field"
- +18 WRITE !
- End DoDot:1
- +19 WRITE !?2,"PATIENT NAME",?24,"HRN",?36,"COMMUNITY",?47,"SEX",?51,"AGE"
- +20 WRITE !?2,"RACE*",?24,"HISPANIC OR LATINO IDENTITY*"
- +21 WRITE !?5,"LAST DM DATE",?19,"DX OR SVC CD",?35,"PROV TYPE",?45,"SVC CAT",?53,"CLINIC",?65,"LOCATION"
- +22 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-"),!
- +23 SET BUDP=1
- +24 QUIT
- +25 ;
- DMR1 ;EP
- +1 IF $DATA(IOF)
- WRITE @IOF
- +2 WRITE !,$$CTR($$LOC,80)
- +3 WRITE !,$$CTR("UDS 2013",80)
- +4 WRITE !!,"All Patients w/DM and A1c <7 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"
- +8 WRITE !,"of patients age 18 to 75 years old who have had two"
- +9 WRITE !,"medical visits during the report period, with a diagnosis"
- +10 WRITE !,"of Type I or Type II diabetes anytime through the end of the report"
- +11 WRITE !,"period, and without a diagnosis of polycystic ovaries, gestational diabetes,"
- +12 WRITE !,"or steroid-induced diabetes and with a most recent hemoglobin A1c of less"
- +13 WRITE !,"than 7%."
- +14 WRITE !
- +15 QUIT
- DMR1L ;EP
- +1 SET BUDP=0
- SET BUDQUIT=0
- SET BUDTOT=0
- +2 DO DMR1H
- IF BUDQUIT
- QUIT
- +3 IF '$DATA(^XTMP("BUDARP7",BUDJ,BUDH,"DMR1"))
- WRITE !!,"No patients to report."
- QUIT
- +4 DO DMR1L1
- +5 IF $Y>(IOSL-3)
- DO DMR1H
- IF BUDQUIT
- GOTO DMR1LX
- +6 WRITE !!,"TOTAL DIABETES PTS 18-75 W/A1C <7% BY RACE & HISPANIC OR LATINO IDENTITY: ",BUDTOT,!
- DMR1LX ;
- +1 QUIT
- DMR1L1 ;
- +1 IF $Y>(IOSL-7)
- DO DMR1H
- IF BUDQUIT
- QUIT
- +2 SET BUDTOT=0
- +3 SET BUDRACE=""
- FOR
- SET BUDRACE=$ORDER(^XTMP("BUDARP7",BUDJ,BUDH,"DMR1",BUDRACE))
- IF BUDRACE=""!(BUDQUIT)
- QUIT
- Begin DoDot:1
- +4 SET BUDETH=""
- FOR
- SET BUDETH=$ORDER(^XTMP("BUDARP7",BUDJ,BUDH,"DMR1",BUDRACE,BUDETH))
- IF BUDETH=""!(BUDQUIT)
- QUIT
- DO DMR1L2
- End DoDot:1
- +5 QUIT
- DMR1L2 ;
- +1 SET BUDSTOT=0
- +2 SET BUDRACEL=$$RACEL^BUDARP7I(BUDRACE,BUDETH)
- +3 WRITE !,BUDRACEL
- +4 SET BUDCOM=""
- FOR
- SET BUDCOM=$ORDER(^XTMP("BUDARP7",BUDJ,BUDH,"DMR1",BUDRACE,BUDETH,BUDCOM))
- IF BUDCOM=""!(BUDQUIT)
- QUIT
- Begin DoDot:1
- +5 SET BUDA=""
- FOR
- SET BUDA=$ORDER(^XTMP("BUDARP7",BUDJ,BUDH,"DMR1",BUDRACE,BUDETH,BUDCOM,BUDA))
- IF BUDA=""!(BUDQUIT)
- QUIT
- Begin DoDot:2
- +6 SET BUDNAME=""
- FOR
- SET BUDNAME=$ORDER(^XTMP("BUDARP7",BUDJ,BUDH,"DMR1",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME))
- IF BUDNAME=""!(BUDQUIT)
- QUIT
- Begin DoDot:3
- +7 SET DFN=0
- FOR
- SET DFN=$ORDER(^XTMP("BUDARP7",BUDJ,BUDH,"DMR1",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME,DFN))
- IF DFN'=+DFN!(BUDQUIT)
- QUIT
- Begin DoDot:4
- +8 IF $Y>(IOSL-3)
- DO DMR1H
- 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^BUDARPTC(DFN)
- +12 ;,?60,$E($P($$RACE^BUDARPTC(DFN),U,3)_"-"_$P($$RACE^BUDARPTC(DFN),U,4),1,19)
- WRITE ?2,$EXTRACT($PIECE(BUDRACV,U,4),1,16)_" ("_$PIECE(BUDRACV,U,3),")"
- +13 SET BUDHISV=$$HISP^BUDARPTC(DFN)
- +14 WRITE ?24,$PIECE(BUDHISV,U,3)," (",$PIECE(BUDHISV,U,2),")",!
- +15 SET BUDALL=^XTMP("BUDARP7",BUDJ,BUDH,"DMR1",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 DMR1H
- 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 DMR1H
- IF BUDQUIT
- QUIT
- WRITE !,BUDRACEL,!
- +24 WRITE !,"Sub-Total ",BUDRACEL,": ",BUDSTOT,!
- +25 QUIT
- DMR1H ;
- +1 IF 'BUDGPG
- GOTO DMR1H1
- +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
- DMR1H1 ;
- +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 <7 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 all patients 18 to 75 years"
- +12 WRITE !,"old who have had two medical visits during the report period and were diagnosed"
- +13 WRITE !,"with Type I or Type II diabetes anytime through the end of the report period "
- +14 WRITE !,"and whose most recent hemoglobin A1c is <7%."
- +15 WRITE !,"Age is calculated as of December 31."
- +16 WRITE !,"* E - denotes the value was obtained from the Ethnicity field."
- +17 WRITE !," R - denotes the value was obtained from the Race field"
- +18 WRITE !," C - denotes the value was obtained from the Classification/Beneficiary field"
- +19 WRITE !
- End DoDot:1
- +20 WRITE !?2,"PATIENT NAME",?24,"HRN",?36,"COMMUNITY",?47,"SEX",?51,"AGE"
- +21 WRITE !?2,"RACE*",?24,"HISPANIC OR LATINO IDENTITY*"
- +22 WRITE !?5,"LAST A1C VALUE OR CD & DATE"
- +23 WRITE !?5,"LAST DM DATE",?19,"DX OR SVC CD",?35,"PROV TYPE",?45,"SVC CAT",?53,"CLINIC",?65,"LOCATION"
- +24 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-"),!
- +25 SET BUDP=1
- +26 QUIT
- +27 ;
- DMR2 ;EP
- +1 IF $DATA(IOF)
- WRITE @IOF
- +2 WRITE !,$$CTR($$LOC,80)
- +3 WRITE !,$$CTR("UDS 2013",80)
- +4 WRITE !!,"All Patients w/DM and A1c >=7 and <8 by Race and Hispanic/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"
- +9 WRITE !,"visits during the report period, with a diagnosis"
- +10 WRITE !,"of Type I or Type II diabetes anytime through the end of the report"
- +11 WRITE !,"period, and without a diagnosis of polycystic ovaries, gestational diabetes,"
- +12 WRITE !,"or steroid-induced diabetes and with a most recent hemoglobin A1c greater"
- +13 WRITE !,"than or equal to 7% and less than 8%."
- +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("BUDARP7",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 >=7% AND <8% 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("BUDARP7",BUDJ,BUDH,"DMR2",BUDRACE))
- IF BUDRACE=""!(BUDQUIT)
- QUIT
- Begin DoDot:1
- +4 SET BUDETH=""
- FOR
- SET BUDETH=$ORDER(^XTMP("BUDARP7",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^BUDARP7I(BUDRACE,BUDETH)
- +3 WRITE !,BUDRACEL
- +4 SET BUDCOM=""
- FOR
- SET BUDCOM=$ORDER(^XTMP("BUDARP7",BUDJ,BUDH,"DMR2",BUDRACE,BUDETH,BUDCOM))
- IF BUDCOM=""!(BUDQUIT)
- QUIT
- Begin DoDot:1
- +5 SET BUDA=""
- FOR
- SET BUDA=$ORDER(^XTMP("BUDARP7",BUDJ,BUDH,"DMR2",BUDRACE,BUDETH,BUDCOM,BUDA))
- IF BUDA=""!(BUDQUIT)
- QUIT
- Begin DoDot:2
- +6 SET BUDNAME=""
- FOR
- SET BUDNAME=$ORDER(^XTMP("BUDARP7",BUDJ,BUDH,"DMR2",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME))
- IF BUDNAME=""!(BUDQUIT)
- QUIT
- Begin DoDot:3
- +7 SET DFN=0
- FOR
- SET DFN=$ORDER(^XTMP("BUDARP7",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^BUDARPTC(DFN)
- +12 ;,?60,$E($P($$RACE^BUDARPTC(DFN),U,3)_"-"_$P($$RACE^BUDARPTC(DFN),U,4),1,19)
- WRITE ?2,$EXTRACT($PIECE(BUDRACV,U,4),1,16)_" ("_$PIECE(BUDRACV,U,3),")"
- +13 SET BUDHISV=$$HISP^BUDARPTC(DFN)
- +14 WRITE ?24,$PIECE(BUDHISV,U,3)," (",$PIECE(BUDHISV,U,2),")",!
- +15 SET BUDALL=^XTMP("BUDARP7",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 >=7 and <8 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 >=7% and <8%."
- +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 ;