BUD8RP7J ; 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 encounters"
W !,"(visits) 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 (encounters) 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), 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")
;----------
;
HTR ;EP
W:$D(IOF) @IOF
W !,$$CTR($$LOC,80)
W !,$$CTR("UDS 2008",80)
W !!,"All Hypertension Patients by Race (Table 7)",!
D GENI
D PAUSE
W !!,"This report provides a list by race 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
HTRL ;EP
S BUDP=0,BUDQUIT=0,BUDTOT=0
D HTRH Q:BUDQUIT
I '$D(^XTMP("BUD8RP7",BUDJ,BUDH,"HTR")) W !!,"No patients to report." Q
D HTRL1
I $Y>(IOSL-3) D HTRH G:BUDQUIT HTRLX
W !!,"TOTAL HTN PATIENTS 18+ BY RACE: ",BUDTOT,!
HTRLX ;
Q
HTRL1 ;
I $Y>(IOSL-7) D HTRH Q:BUDQUIT
S BUDTOT=0
S BUDRACE="" F S BUDRACE=$O(^XTMP("BUD8RP7",BUDJ,BUDH,"HTR",BUDRACE)) Q:BUDRACE=""!(BUDQUIT) D HTRL2
Q
HTRL2 ;
S BUDSTOT=0
W !,BUDRACE
S BUDCOM="" F S BUDCOM=$O(^XTMP("BUD8RP7",BUDJ,BUDH,"HTR",BUDRACE,BUDCOM)) Q:BUDCOM=""!(BUDQUIT) D
.S BUDA="" F S BUDA=$O(^XTMP("BUD8RP7",BUDJ,BUDH,"HTR",BUDRACE,BUDCOM,BUDA)) Q:BUDA=""!(BUDQUIT) D
..S BUDNAME="" F S BUDNAME=$O(^XTMP("BUD8RP7",BUDJ,BUDH,"HTR",BUDRACE,BUDCOM,BUDA,BUDNAME)) Q:BUDNAME=""!(BUDQUIT) D
...S DFN=0 F S DFN=$O(^XTMP("BUD8RP7",BUDJ,BUDH,"HTR",BUDRACE,BUDCOM,BUDA,BUDNAME,DFN)) Q:DFN'=+DFN!(BUDQUIT) D
....I $Y>(IOSL-3) D HTRH 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($$RACE^BUD8RPTC(DFN),U,3)_"-"_$P($$RACE^BUD8RPTC(DFN),U,4),!
....S BUDTOT=BUDTOT+1,BUDSTOT=BUDSTOT+1
....S BUDALL=^XTMP("BUD8RP7",BUDJ,BUDH,"HTR",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 HTRH 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 HTRH Q:BUDQUIT W !,BUDRACE
W !,"Sub-Total ",BUDRACE,": ",BUDSTOT,!
Q
HTRH ;
G:'BUDGPG HTRH1
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
HTRH1 ;
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 Race",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 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 !," *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,"RACE*"
W !?5,"LAST HTN DATE",?19,"DX OR SRV CD",?35,"PROV TYPE",?45,"SRV CAT",?53,"CLINIC",?65,"LOCATION"
W !,$TR($J("",80)," ","-"),!
S BUDP=1
Q
;
HTCR ;EP
W:$D(IOF) @IOF
W !,$$CTR($$LOC,80)
W !,$$CTR("UDS 2008",80)
W !!,"All Hypertension Patients w/Controlled BP by Race (Table 7)",!
D GENI
D PAUSE
W !!,"This report provides a list by race 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
HTCRL ;EP
S BUDP=0,BUDQUIT=0,BUDTOT=0
D HTCRH Q:BUDQUIT
I '$D(^XTMP("BUD8RP7",BUDJ,BUDH,"HTCR")) W !!,"No patients to report." Q
D HTCRL1
I $Y>(IOSL-3) D HTCRH G:BUDQUIT HTCRLX
W !!,"TOTAL HTN PATIENTS 18+ W/CONTROLLED BP BY RACE: ",BUDTOT,!
HTCRLX ;
Q
HTCRL1 ;
I $Y>(IOSL-7) D HTCRH Q:BUDQUIT
S BUDTOT=0
S BUDRACE="" F S BUDRACE=$O(^XTMP("BUD8RP7",BUDJ,BUDH,"HTCR",BUDRACE)) Q:BUDRACE=""!(BUDQUIT) D HTCRL2
Q
HTCRL2 ;
S BUDSTOT=0
W !,BUDRACE
S BUDNAME="" F S BUDNAME=$O(^XTMP("BUD8RP7",BUDJ,BUDH,"HTCR",BUDRACE,BUDNAME)) Q:BUDNAME=""!(BUDQUIT) D
.S BUDCOM="" F S BUDCOM=$O(^XTMP("BUD8RP7",BUDJ,BUDH,"HTCR",BUDRACE,BUDNAME,BUDCOM)) Q:BUDCOM=""!(BUDQUIT) D
..S DFN=0 F S DFN=$O(^XTMP("BUD8RP7",BUDJ,BUDH,"HTCR",BUDRACE,BUDNAME,BUDCOM,DFN)) Q:DFN'=+DFN!(BUDQUIT) D
...I $Y>(IOSL-3) D HTCRH 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,$E(BUDRACE,1,24),!
...S BUDTOT=BUDTOT+1,BUDSTOT=BUDSTOT+1
...S BUDALL=^XTMP("BUD8RP7",BUDJ,BUDH,"HTCR",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 HTCRH 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 HTCRH Q:BUDQUIT W !,BUDRACE,!
W !,"Sub-Total ",BUDRACE,": ",BUDSTOT,!
Q
HTCRH ;
G:'BUDGPG HTCRH1
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
HTCRH1 ;
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 Race",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 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 !,"*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,"RACE*"
W !?5,"LAST BP VALUE OR CD & DATE"
W !?5,"LAST HTN DATE",?19,"DX OR SRV CD",?35,"PROV TYPE",?45,"SRV CAT",?53,"CLINIC",?65,"LOCATION"
W !,$TR($J("",80)," ","-"),!
S BUDP=1
Q
;
HTUR ;EP
W:$D(IOF) @IOF
W !,$$CTR($$LOC,80)
W !,$$CTR("UDS 2008",80)
W !!,"All Hypertension Patients w/Uncontrolled BP by Race (Table 7)",!
D GENI
D PAUSE
W !!,"This report provides a list by race 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
HTURL ;EP
S BUDP=0,BUDQUIT=0,BUDTOT=0
D HTURH Q:BUDQUIT
I '$D(^XTMP("BUD8RP7",BUDJ,BUDH,"HTUR")) W !!,"No patients to report." Q
D HTURL1
I $Y>(IOSL-3) D HTURH G:BUDQUIT HTURLX
W !!,"TOTAL HTN PATIENTS 18+ W/UNCONTROLLED BP BY RACE: ",BUDTOT,!
HTURLX ;
Q
HTURL1 ;
I $Y>(IOSL-7) D HTURH Q:BUDQUIT
S BUDTOT=0
S BUDRACE="" F S BUDRACE=$O(^XTMP("BUD8RP7",BUDJ,BUDH,"HTUR",BUDRACE)) Q:BUDRACE=""!(BUDQUIT) D HTURL2
Q
HTURL2 ;
S BUDSTOT=0
W !,BUDRACE
S BUDNAME="" F S BUDNAME=$O(^XTMP("BUD8RP7",BUDJ,BUDH,"HTUR",BUDRACE,BUDNAME)) Q:BUDNAME=""!(BUDQUIT) D
.S BUDCOM="" F S BUDCOM=$O(^XTMP("BUD8RP7",BUDJ,BUDH,"HTUR",BUDRACE,BUDNAME,BUDCOM)) Q:BUDCOM=""!(BUDQUIT) D
..S DFN=0 F S DFN=$O(^XTMP("BUD8RP7",BUDJ,BUDH,"HTUR",BUDRACE,BUDNAME,BUDCOM,DFN)) Q:DFN'=+DFN!(BUDQUIT) D
...I $Y>(IOSL-3) D HTURH 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($$RACE^BUD8RPTC(DFN),U,3)_"-"_$P($$RACE^BUD8RPTC(DFN),U,4),!
...S BUDTOT=BUDTOT+1,BUDSTOT=BUDSTOT+1
...S BUDALL=^XTMP("BUD8RP7",BUDJ,BUDH,"HTUR",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 HTURH 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 HTURH Q:BUDQUIT W !,BUDRACE,!
W !,"Sub-Total ",BUDRACE,": ",BUDSTOT,!
Q
HTURH ;
G:'BUDGPG HTURH1
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
HTURH1 ;
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 Race",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 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 !,"* 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,"RACE*"
W !?5,"LAST BP VALUE & DATE"
W !?5,"LAST HTN DATE",?19,"DX OR SRV CD",?35,"PROV TYPE",?45,"SRV CAT",?53,"CLINIC",?65,"LOCATION"
W !,$TR($J("",80)," ","-"),!
S BUDP=1
Q
;
BUD8RP7J ; 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 encounters"
+6 WRITE !,"(visits) 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 (encounters) 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), 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 ;
HTR ;EP
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$$CTR($$LOC,80)
+3 WRITE !,$$CTR("UDS 2008",80)
+4 WRITE !!,"All Hypertension Patients by Race (Table 7)",!
+5 DO GENI
+6 DO PAUSE
+7 WRITE !!,"This report provides a list by race 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
HTRL ;EP
+1 SET BUDP=0
SET BUDQUIT=0
SET BUDTOT=0
+2 DO HTRH
IF BUDQUIT
QUIT
+3 IF '$DATA(^XTMP("BUD8RP7",BUDJ,BUDH,"HTR"))
WRITE !!,"No patients to report."
QUIT
+4 DO HTRL1
+5 IF $Y>(IOSL-3)
DO HTRH
IF BUDQUIT
GOTO HTRLX
+6 WRITE !!,"TOTAL HTN PATIENTS 18+ BY RACE: ",BUDTOT,!
HTRLX ;
+1 QUIT
HTRL1 ;
+1 IF $Y>(IOSL-7)
DO HTRH
IF BUDQUIT
QUIT
+2 SET BUDTOT=0
+3 SET BUDRACE=""
FOR
SET BUDRACE=$ORDER(^XTMP("BUD8RP7",BUDJ,BUDH,"HTR",BUDRACE))
IF BUDRACE=""!(BUDQUIT)
QUIT
DO HTRL2
+4 QUIT
HTRL2 ;
+1 SET BUDSTOT=0
+2 WRITE !,BUDRACE
+3 SET BUDCOM=""
FOR
SET BUDCOM=$ORDER(^XTMP("BUD8RP7",BUDJ,BUDH,"HTR",BUDRACE,BUDCOM))
IF BUDCOM=""!(BUDQUIT)
QUIT
Begin DoDot:1
+4 SET BUDA=""
FOR
SET BUDA=$ORDER(^XTMP("BUD8RP7",BUDJ,BUDH,"HTR",BUDRACE,BUDCOM,BUDA))
IF BUDA=""!(BUDQUIT)
QUIT
Begin DoDot:2
+5 SET BUDNAME=""
FOR
SET BUDNAME=$ORDER(^XTMP("BUD8RP7",BUDJ,BUDH,"HTR",BUDRACE,BUDCOM,BUDA,BUDNAME))
IF BUDNAME=""!(BUDQUIT)
QUIT
Begin DoDot:3
+6 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("BUD8RP7",BUDJ,BUDH,"HTR",BUDRACE,BUDCOM,BUDA,BUDNAME,DFN))
IF DFN'=+DFN!(BUDQUIT)
QUIT
Begin DoDot:4
+7 IF $Y>(IOSL-3)
DO HTRH
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($$RACE^BUD8RPTC(DFN),U,3)_"-"_$PIECE($$RACE^BUD8RPTC(DFN),U,4),!
+10 SET BUDTOT=BUDTOT+1
SET BUDSTOT=BUDSTOT+1
+11 SET BUDALL=^XTMP("BUD8RP7",BUDJ,BUDH,"HTR",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 HTRH
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 HTRH
IF BUDQUIT
QUIT
WRITE !,BUDRACE
+19 WRITE !,"Sub-Total ",BUDRACE,": ",BUDSTOT,!
+20 QUIT
HTRH ;
+1 IF 'BUDGPG
GOTO HTRH1
+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
HTRH1 ;
+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 Race",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 race 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 !," *R- denotes the value was obtained from the Race field"
+15 WRITE !," C- denotes the value was obtained from the Classification/Beneficiary field"
+16 WRITE !
End DoDot:1
+17 WRITE !?2,"PATIENT NAME",?24,"HRN",?36,"COMMUNITY",?47,"SEX",?51,"AGE",?55,"RACE*"
+18 WRITE !?5,"LAST HTN DATE",?19,"DX OR SRV CD",?35,"PROV TYPE",?45,"SRV CAT",?53,"CLINIC",?65,"LOCATION"
+19 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-"),!
+20 SET BUDP=1
+21 QUIT
+22 ;
HTCR ;EP
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$$CTR($$LOC,80)
+3 WRITE !,$$CTR("UDS 2008",80)
+4 WRITE !!,"All Hypertension Patients w/Controlled BP by Race (Table 7)",!
+5 DO GENI
+6 DO PAUSE
+7 WRITE !!,"This report provides a list by race 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
HTCRL ;EP
+1 SET BUDP=0
SET BUDQUIT=0
SET BUDTOT=0
+2 DO HTCRH
IF BUDQUIT
QUIT
+3 IF '$DATA(^XTMP("BUD8RP7",BUDJ,BUDH,"HTCR"))
WRITE !!,"No patients to report."
QUIT
+4 DO HTCRL1
+5 IF $Y>(IOSL-3)
DO HTCRH
IF BUDQUIT
GOTO HTCRLX
+6 WRITE !!,"TOTAL HTN PATIENTS 18+ W/CONTROLLED BP BY RACE: ",BUDTOT,!
HTCRLX ;
+1 QUIT
HTCRL1 ;
+1 IF $Y>(IOSL-7)
DO HTCRH
IF BUDQUIT
QUIT
+2 SET BUDTOT=0
+3 SET BUDRACE=""
FOR
SET BUDRACE=$ORDER(^XTMP("BUD8RP7",BUDJ,BUDH,"HTCR",BUDRACE))
IF BUDRACE=""!(BUDQUIT)
QUIT
DO HTCRL2
+4 QUIT
HTCRL2 ;
+1 SET BUDSTOT=0
+2 WRITE !,BUDRACE
+3 SET BUDNAME=""
FOR
SET BUDNAME=$ORDER(^XTMP("BUD8RP7",BUDJ,BUDH,"HTCR",BUDRACE,BUDNAME))
IF BUDNAME=""!(BUDQUIT)
QUIT
Begin DoDot:1
+4 SET BUDCOM=""
FOR
SET BUDCOM=$ORDER(^XTMP("BUD8RP7",BUDJ,BUDH,"HTCR",BUDRACE,BUDNAME,BUDCOM))
IF BUDCOM=""!(BUDQUIT)
QUIT
Begin DoDot:2
+5 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("BUD8RP7",BUDJ,BUDH,"HTCR",BUDRACE,BUDNAME,BUDCOM,DFN))
IF DFN'=+DFN!(BUDQUIT)
QUIT
Begin DoDot:3
+6 IF $Y>(IOSL-3)
DO HTCRH
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,$EXTRACT(BUDRACE,1,24),!
+9 SET BUDTOT=BUDTOT+1
SET BUDSTOT=BUDSTOT+1
+10 SET BUDALL=^XTMP("BUD8RP7",BUDJ,BUDH,"HTCR",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 HTCRH
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 HTCRH
IF BUDQUIT
QUIT
WRITE !,BUDRACE,!
+19 WRITE !,"Sub-Total ",BUDRACE,": ",BUDSTOT,!
+20 QUIT
HTCRH ;
+1 IF 'BUDGPG
GOTO HTCRH1
+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
HTCRH1 ;
+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 Race",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 race 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 !,"*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,"RACE*"
+19 WRITE !?5,"LAST BP VALUE OR CD & DATE"
+20 WRITE !?5,"LAST HTN DATE",?19,"DX OR SRV CD",?35,"PROV TYPE",?45,"SRV CAT",?53,"CLINIC",?65,"LOCATION"
+21 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-"),!
+22 SET BUDP=1
+23 QUIT
+24 ;
HTUR ;EP
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$$CTR($$LOC,80)
+3 WRITE !,$$CTR("UDS 2008",80)
+4 WRITE !!,"All Hypertension Patients w/Uncontrolled BP by Race (Table 7)",!
+5 DO GENI
+6 DO PAUSE
+7 WRITE !!,"This report provides a list by race 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
HTURL ;EP
+1 SET BUDP=0
SET BUDQUIT=0
SET BUDTOT=0
+2 DO HTURH
IF BUDQUIT
QUIT
+3 IF '$DATA(^XTMP("BUD8RP7",BUDJ,BUDH,"HTUR"))
WRITE !!,"No patients to report."
QUIT
+4 DO HTURL1
+5 IF $Y>(IOSL-3)
DO HTURH
IF BUDQUIT
GOTO HTURLX
+6 WRITE !!,"TOTAL HTN PATIENTS 18+ W/UNCONTROLLED BP BY RACE: ",BUDTOT,!
HTURLX ;
+1 QUIT
HTURL1 ;
+1 IF $Y>(IOSL-7)
DO HTURH
IF BUDQUIT
QUIT
+2 SET BUDTOT=0
+3 SET BUDRACE=""
FOR
SET BUDRACE=$ORDER(^XTMP("BUD8RP7",BUDJ,BUDH,"HTUR",BUDRACE))
IF BUDRACE=""!(BUDQUIT)
QUIT
DO HTURL2
+4 QUIT
HTURL2 ;
+1 SET BUDSTOT=0
+2 WRITE !,BUDRACE
+3 SET BUDNAME=""
FOR
SET BUDNAME=$ORDER(^XTMP("BUD8RP7",BUDJ,BUDH,"HTUR",BUDRACE,BUDNAME))
IF BUDNAME=""!(BUDQUIT)
QUIT
Begin DoDot:1
+4 SET BUDCOM=""
FOR
SET BUDCOM=$ORDER(^XTMP("BUD8RP7",BUDJ,BUDH,"HTUR",BUDRACE,BUDNAME,BUDCOM))
IF BUDCOM=""!(BUDQUIT)
QUIT
Begin DoDot:2
+5 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("BUD8RP7",BUDJ,BUDH,"HTUR",BUDRACE,BUDNAME,BUDCOM,DFN))
IF DFN'=+DFN!(BUDQUIT)
QUIT
Begin DoDot:3
+6 IF $Y>(IOSL-3)
DO HTURH
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($$RACE^BUD8RPTC(DFN),U,3)_"-"_$PIECE($$RACE^BUD8RPTC(DFN),U,4),!
+9 SET BUDTOT=BUDTOT+1
SET BUDSTOT=BUDSTOT+1
+10 SET BUDALL=^XTMP("BUD8RP7",BUDJ,BUDH,"HTUR",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 HTURH
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 HTURH
IF BUDQUIT
QUIT
WRITE !,BUDRACE,!
+19 WRITE !,"Sub-Total ",BUDRACE,": ",BUDSTOT,!
+20 QUIT
HTURH ;
+1 IF 'BUDGPG
GOTO HTURH1
+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
HTURH1 ;
+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 Race",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 race 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 !,"* 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,"RACE*"
+19 WRITE !?5,"LAST BP VALUE & DATE"
+20 WRITE !?5,"LAST HTN DATE",?19,"DX OR SRV CD",?35,"PROV TYPE",?45,"SRV CAT",?53,"CLINIC",?65,"LOCATION"
+21 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-"),!
+22 SET BUDP=1
+23 QUIT
+24 ;
