BUD9RP7K ; 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 !
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")
;----------
;
HTE ;EP
W:$D(IOF) @IOF
W !,$$CTR($$LOC,80)
W !,$$CTR("UDS 2009",80)
W !!,"All Hypertension Patients by Ethnicity (Table 7)",!
D GENI
D PAUSE
W !!,"This report provides a list by ethnicity of patients age 18 and older who"
W !,"have had two medical visits during the report period and were diagnosed"
W !,"with hypertension before June 30 of the report period."
W !
Q
HTEL ;EP
S BUDP=0,BUDQUIT=0,BUDTOT=0
D HTEH Q:BUDQUIT
I '$D(^XTMP("BUD9RP7",BUDJ,BUDH,"HTE")) W !!,"No patients to report." Q
D HTEL1
I $Y>(IOSL-3) D HTEH G:BUDQUIT HTELX
W !!,"TOTAL HTN PATIENTS 18+ BY ETHNICITY: ",BUDTOT,!
HTELX ;
Q
HTEL1 ;
I $Y>(IOSL-7) D HTEH Q:BUDQUIT
S BUDTOT=0
S BUDRACE="" F S BUDRACE=$O(^XTMP("BUD9RP7",BUDJ,BUDH,"HTE",BUDRACE)) Q:BUDRACE=""!(BUDQUIT) D HTEL2
Q
HTEL2 ;
S BUDSTOT=0
W !,BUDRACE
S BUDCOM="" F S BUDCOM=$O(^XTMP("BUD9RP7",BUDJ,BUDH,"HTE",BUDRACE,BUDCOM)) Q:BUDCOM=""!(BUDQUIT) D
.S BUDA="" F S BUDA=$O(^XTMP("BUD9RP7",BUDJ,BUDH,"HTE",BUDRACE,BUDCOM,BUDA)) Q:BUDA=""!(BUDQUIT) D
..S BUDNAME="" F S BUDNAME=$O(^XTMP("BUD9RP7",BUDJ,BUDH,"HTE",BUDRACE,BUDCOM,BUDA,BUDNAME)) Q:BUDNAME=""!(BUDQUIT) D
...S DFN=0 F S DFN=$O(^XTMP("BUD9RP7",BUDJ,BUDH,"HTE",BUDRACE,BUDCOM,BUDA,BUDNAME,DFN)) Q:DFN'=+DFN!(BUDQUIT) D
....I $Y>(IOSL-3) D HTEH Q:BUDQUIT W !,BUDRACE,!
....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))
....W ?36,$E(BUDCOM,1,10),?47,$P(^DPT(DFN,0),U,2),?51,BUDA,?55,$P($$HISP^BUD9RPTC(DFN),U,2)_"-"_$P($$HISP^BUD9RPTC(DFN),U,3),!
....S BUDTOT=BUDTOT+1,BUDSTOT=BUDSTOT+1
....S BUDALL=^XTMP("BUD9RP7",BUDJ,BUDH,"HTE",BUDRACE,BUDCOM,BUDA,BUDNAME,DFN)
....S BUDPPV=$P(BUDALL,"#",1)
....F BUDX=1:1 S BUDV=$P(BUDPPV,U,BUDX) Q:BUDV=""!(BUDQUIT) D
.....I $Y>(IOSL-3) D HTEH Q:BUDQUIT W !,BUDRACE,!
.....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 HTEH Q:BUDQUIT W !,BUDRACE,!
W !,"Sub-Total ",BUDRACE,": ",BUDSTOT,!
Q
HTEH ;
G:'BUDGPG HTEH1
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
HTEH1 ;
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 B, HTN Patients by Ethnicity",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 ethnicity of patients age 18 and older who have had two medical visits"
.W !,"during the report period and were diagnosed with hypertension before"
.W !,"June 30 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",?55,"ETHNICITY*"
W !?5,"VISIT DATE",?19,"DX OR SVC CD",?35,"PROV TYPE",?45,"SVC CAT",?53,"CLINIC",?65,"LOCATION"
W !,$TR($J("",80)," ","-"),!
S BUDP=1
Q
;
HTCE ;EP
W:$D(IOF) @IOF
W !,$$CTR($$LOC,80)
W !,$$CTR("UDS 2009",80)
W !!,"All Hypertension Patients w/Controlled BP by Ethnicity (Table 7)",!
D GENI
D PAUSE
W !!,"This report provides a list by ethnicity of patients age 18 and older who"
W !,"have had two medical visits during the report period, were diagnosed"
W !,"with hypertension before June 30 of the report period, and who have"
W !,"controlled blood pressure (<140/90 mm HG) during the report period."
W !
Q
HTCEL ;EP
S BUDP=0,BUDQUIT=0,BUDTOT=0
D HTCEH Q:BUDQUIT
I '$D(^XTMP("BUD9RP7",BUDJ,BUDH,"HTCE")) W !!,"No patients to report." Q
D HTCEL1
I $Y>(IOSL-3) D HTCEH G:BUDQUIT HTCELX
W !!,"TOTAL HTN PATIENTS 18+ W/CONTROLLED BP BY ETHNICITY: ",BUDTOT,!
HTCELX ;
Q
HTCEL1 ;
I $Y>(IOSL-7) D HTCEH Q:BUDQUIT
S BUDTOT=0
S BUDRACE="" F S BUDRACE=$O(^XTMP("BUD9RP7",BUDJ,BUDH,"HTCE",BUDRACE)) Q:BUDRACE=""!(BUDQUIT) D HTCEL2
Q
HTCEL2 ;
S BUDSTOT=0
W !,BUDRACE
S BUDNAME="" F S BUDNAME=$O(^XTMP("BUD9RP7",BUDJ,BUDH,"HTCE",BUDRACE,BUDNAME)) Q:BUDNAME=""!(BUDQUIT) D
.S BUDCOM="" F S BUDCOM=$O(^XTMP("BUD9RP7",BUDJ,BUDH,"HTCE",BUDRACE,BUDNAME,BUDCOM)) Q:BUDCOM=""!(BUDQUIT) D
..S DFN=0 F S DFN=$O(^XTMP("BUD9RP7",BUDJ,BUDH,"HTCE",BUDRACE,BUDNAME,BUDCOM,DFN)) Q:DFN'=+DFN!(BUDQUIT) D
...I $Y>(IOSL-3) D HTCEH Q:BUDQUIT W !,BUDRACE,!
...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))
...W ?36,$E(BUDCOM,1,10),?47,$P(^DPT(DFN,0),U,2),?51,$$AGE^AUPNPAT(DFN,BUDED),?55,$P($$HISP^BUD9RPTC(DFN),U,2)_"-"_$P($$HISP^BUD9RPTC(DFN),U,3),!
...S BUDTOT=BUDTOT+1,BUDSTOT=BUDSTOT+1
...S BUDALL=^XTMP("BUD9RP7",BUDJ,BUDH,"HTCE",BUDRACE,BUDNAME,BUDCOM,DFN)
...W ?5,$P(BUDALL,U,2),!
...S BUDPPV=$P(BUDALL,"^",1)
...F BUDX=1:1 S BUDV=$P(BUDPPV,U,BUDX) Q:BUDV=""!(BUDQUIT) D
....I $Y>(IOSL-3) D HTCEH Q:BUDQUIT W !,BUDRACE,!
....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 HTCEH Q:BUDQUIT W !,BUDRACE,!
W !,"Sub-Total ",BUDRACE,": ",BUDSTOT,!
Q
HTCEH ;
G:'BUDGPG HTCEH1
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
HTCEH1 ;
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 B, HTN w/Controlled BP by Ethnicity",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 ethnicity of patients age 18 and older who have had two medical visits"
.W !,"during the report period, who were diagnosed with hypertension before"
.W !,"June 30 of the report period, and have controlled blood pressure"
.W !,"(BP <140/90 mm Hg)."
.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",?55,"ETHNICITY*"
W !?5,"VISIT DATE",?19,"DX OR SVC CD",?35,"PROV TYPE",?45,"SVC CAT",?53,"CLINIC",?65,"LOCATION"
W !,$TR($J("",80)," ","-"),!
S BUDP=1
Q
;
HTUE ;EP
W:$D(IOF) @IOF
W !,$$CTR($$LOC,80)
W !,$$CTR("UDS 2009",80)
W !!,"All Hypertension Patients w/Uncontrolled BP by Ethnicity (Table 7)",!
D GENI
D PAUSE
W !!,"This report provides a list by ethnicity of patients age 18 and older who"
W !,"have had two medical visits during the report period, were diagnosed"
W !,"with hypertension before June 30 of the report period, and who do not have"
W !,"controlled blood pressure (<140/90 mm HG) during the report period."
W !
Q
HTUEL ;EP
S BUDP=0,BUDQUIT=0,BUDTOT=0
D HTUEH Q:BUDQUIT
I '$D(^XTMP("BUD9RP7",BUDJ,BUDH,"HTUE")) W !!,"No patients to report." Q
D HTUEL1
I $Y>(IOSL-3) D HTUEH G:BUDQUIT HTUELX
W !!,"TOTAL HTN PATIENTS 18+ W/UNCONTROLLED BP BY Ethnicity: ",BUDTOT,!
HTUELX ;
Q
HTUEL1 ;
I $Y>(IOSL-7) D HTUEH Q:BUDQUIT
S BUDTOT=0
S BUDRACE="" F S BUDRACE=$O(^XTMP("BUD9RP7",BUDJ,BUDH,"HTUE",BUDRACE)) Q:BUDRACE=""!(BUDQUIT) D HTUEL2
Q
HTUEL2 ;
S BUDSTOT=0
W !,BUDRACE
S BUDNAME="" F S BUDNAME=$O(^XTMP("BUD9RP7",BUDJ,BUDH,"HTUE",BUDRACE,BUDNAME)) Q:BUDNAME=""!(BUDQUIT) D
.S BUDCOM="" F S BUDCOM=$O(^XTMP("BUD9RP7",BUDJ,BUDH,"HTUE",BUDRACE,BUDNAME,BUDCOM)) Q:BUDCOM=""!(BUDQUIT) D
..S DFN=0 F S DFN=$O(^XTMP("BUD9RP7",BUDJ,BUDH,"HTUE",BUDRACE,BUDNAME,BUDCOM,DFN)) Q:DFN'=+DFN!(BUDQUIT) D
...I $Y>(IOSL-3) D HTUEH Q:BUDQUIT W !,BUDRACE,!
...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))
...W ?36,$E(BUDCOM,1,10),?47,$P(^DPT(DFN,0),U,2),?51,$$AGE^AUPNPAT(DFN,BUDED),?55,$P($$HISP^BUD9RPTC(DFN),U,2)_"-"_$P($$HISP^BUD9RPTC(DFN),U,3),!
...S BUDTOT=BUDTOT+1,BUDSTOT=BUDSTOT+1
...S BUDALL=^XTMP("BUD9RP7",BUDJ,BUDH,"HTUE",BUDRACE,BUDNAME,BUDCOM,DFN)
...W ?5,$P(BUDALL,U,2),!
...S BUDPPV=$P(BUDALL,"^",1)
...F BUDX=1:1 S BUDV=$P(BUDPPV,U,BUDX) Q:BUDV=""!(BUDQUIT) D
....I $Y>(IOSL-3) D HTUEH Q:BUDQUIT W !,BUDRACE,!
....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 HTUEH Q:BUDQUIT W !,BUDRACE,!
W !,"Sub-Total ",BUDRACE,": ",BUDSTOT,!
Q
HTUEH ;
G:'BUDGPG HTUEH1
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
HTUEH1 ;
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 B, HTN w/Uncontrolled BP by Ethnicity",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 ethnicity of patients age 18 and older who have had two medical visits"
.W !,"during the report period, who were diagnosed with hypertension before"
.W !,"June 30 of the report period, and do not have controlled blood pressure"
.W !,"(BP <140/90 mm Hg)."
.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",?55,"ETHNICITY*"
W !?5,"VISIT DATE",?19,"DX OR SVC CD",?35,"PROV TYPE",?45,"SVC CAT",?53,"CLINIC",?65,"LOCATION"
W !,$TR($J("",80)," ","-"),!
S BUDP=1
Q
;
BUD9RP7K ; 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 !
+20 QUIT
+21 ;
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 ;
HTE ;EP
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$$CTR($$LOC,80)
+3 WRITE !,$$CTR("UDS 2009",80)
+4 WRITE !!,"All Hypertension Patients by Ethnicity (Table 7)",!
+5 DO GENI
+6 DO PAUSE
+7 WRITE !!,"This report provides a list by ethnicity of patients age 18 and older who"
+8 WRITE !,"have had two medical visits during the report period and were diagnosed"
+9 WRITE !,"with hypertension before June 30 of the report period."
+10 WRITE !
+11 QUIT
HTEL ;EP
+1 SET BUDP=0
SET BUDQUIT=0
SET BUDTOT=0
+2 DO HTEH
IF BUDQUIT
QUIT
+3 IF '$DATA(^XTMP("BUD9RP7",BUDJ,BUDH,"HTE"))
WRITE !!,"No patients to report."
QUIT
+4 DO HTEL1
+5 IF $Y>(IOSL-3)
DO HTEH
IF BUDQUIT
GOTO HTELX
+6 WRITE !!,"TOTAL HTN PATIENTS 18+ BY ETHNICITY: ",BUDTOT,!
HTELX ;
+1 QUIT
HTEL1 ;
+1 IF $Y>(IOSL-7)
DO HTEH
IF BUDQUIT
QUIT
+2 SET BUDTOT=0
+3 SET BUDRACE=""
FOR
SET BUDRACE=$ORDER(^XTMP("BUD9RP7",BUDJ,BUDH,"HTE",BUDRACE))
IF BUDRACE=""!(BUDQUIT)
QUIT
DO HTEL2
+4 QUIT
HTEL2 ;
+1 SET BUDSTOT=0
+2 WRITE !,BUDRACE
+3 SET BUDCOM=""
FOR
SET BUDCOM=$ORDER(^XTMP("BUD9RP7",BUDJ,BUDH,"HTE",BUDRACE,BUDCOM))
IF BUDCOM=""!(BUDQUIT)
QUIT
Begin DoDot:1
+4 SET BUDA=""
FOR
SET BUDA=$ORDER(^XTMP("BUD9RP7",BUDJ,BUDH,"HTE",BUDRACE,BUDCOM,BUDA))
IF BUDA=""!(BUDQUIT)
QUIT
Begin DoDot:2
+5 SET BUDNAME=""
FOR
SET BUDNAME=$ORDER(^XTMP("BUD9RP7",BUDJ,BUDH,"HTE",BUDRACE,BUDCOM,BUDA,BUDNAME))
IF BUDNAME=""!(BUDQUIT)
QUIT
Begin DoDot:3
+6 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("BUD9RP7",BUDJ,BUDH,"HTE",BUDRACE,BUDCOM,BUDA,BUDNAME,DFN))
IF DFN'=+DFN!(BUDQUIT)
QUIT
Begin DoDot:4
+7 IF $Y>(IOSL-3)
DO HTEH
IF BUDQUIT
QUIT
WRITE !,BUDRACE,!
+8 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))
+9 WRITE ?36,$EXTRACT(BUDCOM,1,10),?47,$PIECE(^DPT(DFN,0),U,2),?51,BUDA,?55,$PIECE($$HISP^BUD9RPTC(DFN),U,2)_"-"_$PIECE($$HISP^BUD9RPTC(DFN),U,3),!
+10 SET BUDTOT=BUDTOT+1
SET BUDSTOT=BUDSTOT+1
+11 SET BUDALL=^XTMP("BUD9RP7",BUDJ,BUDH,"HTE",BUDRACE,BUDCOM,BUDA,BUDNAME,DFN)
+12 SET BUDPPV=$PIECE(BUDALL,"#",1)
+13 FOR BUDX=1:1
SET BUDV=$PIECE(BUDPPV,U,BUDX)
IF BUDV=""!(BUDQUIT)
QUIT
Begin DoDot:5
+14 IF $Y>(IOSL-3)
DO HTEH
IF BUDQUIT
QUIT
WRITE !,BUDRACE,!
+15 IF $EXTRACT(BUDV)="P"
WRITE ?5,BUDV,!
QUIT
+16 SET V=$PIECE(BUDV,"|")
SET C=$PIECE(BUDV,"|",2)
+17 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
+18 IF $Y>(IOSL-4)
DO HTEH
IF BUDQUIT
QUIT
WRITE !,BUDRACE,!
+19 WRITE !,"Sub-Total ",BUDRACE,": ",BUDSTOT,!
+20 QUIT
HTEH ;
+1 IF 'BUDGPG
GOTO HTEH1
+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
HTEH1 ;
+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 B, HTN Patients by Ethnicity",80),!
+6 WRITE $$CTR($PIECE(^DIC(4,BUDSITE,0),U),80),!
+7 SET X="Reporting Period: "_$$FMTE^XLFDT(BUDBD)_" to "_$$FMTE^XLFDT(BUDED)
WRITE $$CTR(X,80),!
+8 WRITE $TRANSLATE($JUSTIFY("",80)," ","-")
+9 IF BUDP=0
Begin DoDot:1
+10 WRITE !,"List by ethnicity of patients age 18 and older who have had two medical visits"
+11 WRITE !,"during the report period and were diagnosed with hypertension before"
+12 WRITE !,"June 30 of the report period."
+13 WRITE !,"Age is calculated as of December 31."
+14 WRITE !,"* E- denotes the value was obtained from the Ethnicity field"
+15 WRITE !," R- denotes the value was obtained from the Race field"
+16 WRITE !," C- denotes the value was obtained from the Classification/Beneficiary field"
+17 WRITE !
End DoDot:1
+18 WRITE !?2,"PATIENT NAME",?24,"HRN",?36,"COMMUNITY",?47,"SEX",?51,"AGE",?55,"ETHNICITY*"
+19 WRITE !?5,"VISIT DATE",?19,"DX OR SVC CD",?35,"PROV TYPE",?45,"SVC CAT",?53,"CLINIC",?65,"LOCATION"
+20 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-"),!
+21 SET BUDP=1
+22 QUIT
+23 ;
HTCE ;EP
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$$CTR($$LOC,80)
+3 WRITE !,$$CTR("UDS 2009",80)
+4 WRITE !!,"All Hypertension Patients w/Controlled BP by Ethnicity (Table 7)",!
+5 DO GENI
+6 DO PAUSE
+7 WRITE !!,"This report provides a list by ethnicity of patients age 18 and older who"
+8 WRITE !,"have had two medical visits during the report period, were diagnosed"
+9 WRITE !,"with hypertension before June 30 of the report period, and who have"
+10 WRITE !,"controlled blood pressure (<140/90 mm HG) during the report period."
+11 WRITE !
+12 QUIT
HTCEL ;EP
+1 SET BUDP=0
SET BUDQUIT=0
SET BUDTOT=0
+2 DO HTCEH
IF BUDQUIT
QUIT
+3 IF '$DATA(^XTMP("BUD9RP7",BUDJ,BUDH,"HTCE"))
WRITE !!,"No patients to report."
QUIT
+4 DO HTCEL1
+5 IF $Y>(IOSL-3)
DO HTCEH
IF BUDQUIT
GOTO HTCELX
+6 WRITE !!,"TOTAL HTN PATIENTS 18+ W/CONTROLLED BP BY ETHNICITY: ",BUDTOT,!
HTCELX ;
+1 QUIT
HTCEL1 ;
+1 IF $Y>(IOSL-7)
DO HTCEH
IF BUDQUIT
QUIT
+2 SET BUDTOT=0
+3 SET BUDRACE=""
FOR
SET BUDRACE=$ORDER(^XTMP("BUD9RP7",BUDJ,BUDH,"HTCE",BUDRACE))
IF BUDRACE=""!(BUDQUIT)
QUIT
DO HTCEL2
+4 QUIT
HTCEL2 ;
+1 SET BUDSTOT=0
+2 WRITE !,BUDRACE
+3 SET BUDNAME=""
FOR
SET BUDNAME=$ORDER(^XTMP("BUD9RP7",BUDJ,BUDH,"HTCE",BUDRACE,BUDNAME))
IF BUDNAME=""!(BUDQUIT)
QUIT
Begin DoDot:1
+4 SET BUDCOM=""
FOR
SET BUDCOM=$ORDER(^XTMP("BUD9RP7",BUDJ,BUDH,"HTCE",BUDRACE,BUDNAME,BUDCOM))
IF BUDCOM=""!(BUDQUIT)
QUIT
Begin DoDot:2
+5 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("BUD9RP7",BUDJ,BUDH,"HTCE",BUDRACE,BUDNAME,BUDCOM,DFN))
IF DFN'=+DFN!(BUDQUIT)
QUIT
Begin DoDot:3
+6 IF $Y>(IOSL-3)
DO HTCEH
IF BUDQUIT
QUIT
WRITE !,BUDRACE,!
+7 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))
+8 WRITE ?36,$EXTRACT(BUDCOM,1,10),?47,$PIECE(^DPT(DFN,0),U,2),?51,$$AGE^AUPNPAT(DFN,BUDED),?55,$PIECE($$HISP^BUD9RPTC(DFN),U,2)_"-"_$PIECE($$HISP^BUD9RPTC(DFN),U,3),!
+9 SET BUDTOT=BUDTOT+1
SET BUDSTOT=BUDSTOT+1
+10 SET BUDALL=^XTMP("BUD9RP7",BUDJ,BUDH,"HTCE",BUDRACE,BUDNAME,BUDCOM,DFN)
+11 WRITE ?5,$PIECE(BUDALL,U,2),!
+12 SET BUDPPV=$PIECE(BUDALL,"^",1)
+13 FOR BUDX=1:1
SET BUDV=$PIECE(BUDPPV,U,BUDX)
IF BUDV=""!(BUDQUIT)
QUIT
Begin DoDot:4
+14 IF $Y>(IOSL-3)
DO HTCEH
IF BUDQUIT
QUIT
WRITE !,BUDRACE,!
+15 IF $EXTRACT(BUDV)="P"
WRITE ?5,BUDV,!
QUIT
+16 SET V=$PIECE(BUDV,"|")
SET C=$PIECE(BUDV,"|",2)
+17 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:4
End DoDot:3
End DoDot:2
End DoDot:1
+18 IF $Y>(IOSL-4)
DO HTCEH
IF BUDQUIT
QUIT
WRITE !,BUDRACE,!
+19 WRITE !,"Sub-Total ",BUDRACE,": ",BUDSTOT,!
+20 QUIT
HTCEH ;
+1 IF 'BUDGPG
GOTO HTCEH1
+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
HTCEH1 ;
+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 B, HTN w/Controlled BP by Ethnicity",80),!
+6 WRITE $$CTR($PIECE(^DIC(4,BUDSITE,0),U),80),!
+7 SET X="Reporting Period: "_$$FMTE^XLFDT(BUDBD)_" to "_$$FMTE^XLFDT(BUDED)
WRITE $$CTR(X,80),!
+8 WRITE $TRANSLATE($JUSTIFY("",80)," ","-")
+9 IF BUDP=0
Begin DoDot:1
+10 WRITE !,"List by ethnicity of patients age 18 and older who have had two medical visits"
+11 WRITE !,"during the report period, who were diagnosed with hypertension before"
+12 WRITE !,"June 30 of the report period, and have controlled blood pressure"
+13 WRITE !,"(BP <140/90 mm Hg)."
+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",?55,"ETHNICITY*"
+20 WRITE !?5,"VISIT DATE",?19,"DX OR SVC CD",?35,"PROV TYPE",?45,"SVC CAT",?53,"CLINIC",?65,"LOCATION"
+21 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-"),!
+22 SET BUDP=1
+23 QUIT
+24 ;
HTUE ;EP
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$$CTR($$LOC,80)
+3 WRITE !,$$CTR("UDS 2009",80)
+4 WRITE !!,"All Hypertension Patients w/Uncontrolled BP by Ethnicity (Table 7)",!
+5 DO GENI
+6 DO PAUSE
+7 WRITE !!,"This report provides a list by ethnicity of patients age 18 and older who"
+8 WRITE !,"have had two medical visits during the report period, were diagnosed"
+9 WRITE !,"with hypertension before June 30 of the report period, and who do not have"
+10 WRITE !,"controlled blood pressure (<140/90 mm HG) during the report period."
+11 WRITE !
+12 QUIT
HTUEL ;EP
+1 SET BUDP=0
SET BUDQUIT=0
SET BUDTOT=0
+2 DO HTUEH
IF BUDQUIT
QUIT
+3 IF '$DATA(^XTMP("BUD9RP7",BUDJ,BUDH,"HTUE"))
WRITE !!,"No patients to report."
QUIT
+4 DO HTUEL1
+5 IF $Y>(IOSL-3)
DO HTUEH
IF BUDQUIT
GOTO HTUELX
+6 WRITE !!,"TOTAL HTN PATIENTS 18+ W/UNCONTROLLED BP BY Ethnicity: ",BUDTOT,!
HTUELX ;
+1 QUIT
HTUEL1 ;
+1 IF $Y>(IOSL-7)
DO HTUEH
IF BUDQUIT
QUIT
+2 SET BUDTOT=0
+3 SET BUDRACE=""
FOR
SET BUDRACE=$ORDER(^XTMP("BUD9RP7",BUDJ,BUDH,"HTUE",BUDRACE))
IF BUDRACE=""!(BUDQUIT)
QUIT
DO HTUEL2
+4 QUIT
HTUEL2 ;
+1 SET BUDSTOT=0
+2 WRITE !,BUDRACE
+3 SET BUDNAME=""
FOR
SET BUDNAME=$ORDER(^XTMP("BUD9RP7",BUDJ,BUDH,"HTUE",BUDRACE,BUDNAME))
IF BUDNAME=""!(BUDQUIT)
QUIT
Begin DoDot:1
+4 SET BUDCOM=""
FOR
SET BUDCOM=$ORDER(^XTMP("BUD9RP7",BUDJ,BUDH,"HTUE",BUDRACE,BUDNAME,BUDCOM))
IF BUDCOM=""!(BUDQUIT)
QUIT
Begin DoDot:2
+5 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("BUD9RP7",BUDJ,BUDH,"HTUE",BUDRACE,BUDNAME,BUDCOM,DFN))
IF DFN'=+DFN!(BUDQUIT)
QUIT
Begin DoDot:3
+6 IF $Y>(IOSL-3)
DO HTUEH
IF BUDQUIT
QUIT
WRITE !,BUDRACE,!
+7 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))
+8 WRITE ?36,$EXTRACT(BUDCOM,1,10),?47,$PIECE(^DPT(DFN,0),U,2),?51,$$AGE^AUPNPAT(DFN,BUDED),?55,$PIECE($$HISP^BUD9RPTC(DFN),U,2)_"-"_$PIECE($$HISP^BUD9RPTC(DFN),U,3),!
+9 SET BUDTOT=BUDTOT+1
SET BUDSTOT=BUDSTOT+1
+10 SET BUDALL=^XTMP("BUD9RP7",BUDJ,BUDH,"HTUE",BUDRACE,BUDNAME,BUDCOM,DFN)
+11 WRITE ?5,$PIECE(BUDALL,U,2),!
+12 SET BUDPPV=$PIECE(BUDALL,"^",1)
+13 FOR BUDX=1:1
SET BUDV=$PIECE(BUDPPV,U,BUDX)
IF BUDV=""!(BUDQUIT)
QUIT
Begin DoDot:4
+14 IF $Y>(IOSL-3)
DO HTUEH
IF BUDQUIT
QUIT
WRITE !,BUDRACE,!
+15 IF $EXTRACT(BUDV)="P"
WRITE ?5,BUDV,!
QUIT
+16 SET V=$PIECE(BUDV,"|")
SET C=$PIECE(BUDV,"|",2)
+17 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:4
End DoDot:3
End DoDot:2
End DoDot:1
+18 IF $Y>(IOSL-4)
DO HTUEH
IF BUDQUIT
QUIT
WRITE !,BUDRACE,!
+19 WRITE !,"Sub-Total ",BUDRACE,": ",BUDSTOT,!
+20 QUIT
HTUEH ;
+1 IF 'BUDGPG
GOTO HTUEH1
+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
HTUEH1 ;
+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 B, HTN w/Uncontrolled BP by Ethnicity",80),!
+6 WRITE $$CTR($PIECE(^DIC(4,BUDSITE,0),U),80),!
+7 SET X="Reporting Period: "_$$FMTE^XLFDT(BUDBD)_" to "_$$FMTE^XLFDT(BUDED)
WRITE $$CTR(X,80),!
+8 WRITE $TRANSLATE($JUSTIFY("",80)," ","-")
+9 IF BUDP=0
Begin DoDot:1
+10 WRITE !,"List by ethnicity of patients age 18 and older who have had two medical visits"
+11 WRITE !,"during the report period, who were diagnosed with hypertension before"
+12 WRITE !,"June 30 of the report period, and do not have controlled blood pressure"
+13 WRITE !,"(BP <140/90 mm Hg)."
+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",?55,"ETHNICITY*"
+20 WRITE !?5,"VISIT DATE",?19,"DX OR SVC CD",?35,"PROV TYPE",?45,"SVC CAT",?53,"CLINIC",?65,"LOCATION"
+21 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-"),!
+22 SET BUDP=1
+23 QUIT
+24 ;
