BUDARP7 ; IHS/CMI/LAB - UDS REPORT DRIVER TABLE 6B 12 Dec 2013 6:51 AM 30 Dec 2013 8:19 PM 27 Aug 2013 12:41 PM ; 21 Jan 2014 2:52 PM
;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50
;
;
T7 ;
D EOJ
EN ;
D GENI
D T7I
D PAUSE
D PRENATT
D PAUSE
;
EN1 ;
PNC ;
S BUDPREN=""
S DIR(0)="Y",DIR("A")="Does your facility provide prenatal care",DIR("B")="N" KILL DA D ^DIR KILL DIR
I $D(DIRUT) D EOJ Q
S BUDPREN=Y
;
EN2 ;
S BUDSITE=""
S DIC="^BUDQSITE(",DIC(0)="AEMQ",DIC("A")="Enter your site: " D ^DIC
I Y=-1 G PNC
S BUDSITE=+Y
I '$O(^BUDQSITE(BUDSITE,11,0)) W !!,"Warning: There are no locations defined in the site parameter file for this",!,"site. Report will not be accurate!" G EN
S BUDTAXT="7" D TAXCHK^BUDAXTCH
;S BUDYEAR=3080000,BUDBD=3080101,BUDED=3081231
;S BUDCAD=3080630
;S BUDYEAR=3030000,BUDBD=3030101,BUDED=3031231
;S BUDCAD=3030630
S BUDYEAR=""
D YEAR
I BUDYEAR="" D EOJ Q
W !!,"Your report will be run for the time period: ",$$FMTE^XLFDT(BUDBD)," to ",$$FMTE^XLFDT(BUDED)
;get indian or not
S BUDBEN=""
S DIR(0)="S^1:Indian/Alaskan Native (Classification 01);2:Not Indian Alaskan/Native (Not Classification 01);3:All (both Indian/Alaskan Natives and Non 01)",DIR("A")="Select Beneficiary Population to include in this report"
S DIR("B")="1" KILL DA D ^DIR KILL DIR
I $D(DIRUT) W !!,"Classification not entered." D EOJ Q
S BUDBEN=Y
ZIS ;call to XBDBQUE
K IOP,%ZIS
W !! S %ZIS="PQM" D ^%ZIS
I POP D EOJ Q
ZIS1 ;
I $D(IO("Q")) G TSKMN
DRIVER ;
D PROC
U IO
D PRINT
D ^%ZISC
D EOJ
Q
TSKMN ;EP ENTRY POINT FROM TASKMAN
S ZTIO=$S($D(ION):ION,1:IO) I $D(IOST)#2,IOST]"" S ZTIO=ZTIO_";"_IOST
I $G(IO("DOC"))]"" S ZTIO=ZTIO_";"_$G(IO("DOC"))
I $D(IOM)#2,IOM S ZTIO=ZTIO_";"_IOM I $D(IOSL)#2,IOSL S ZTIO=ZTIO_";"_IOSL
K ZTSAVE S ZTSAVE("BUD*")=""
S ZTCPU=$G(IOCPU),ZTRTN="DRIVER^BUDARP7",ZTDTH="",ZTDESC="UDS 13 REPORT TABLE 7" D ^%ZTLOAD D EOJ Q
Q
EOJ ;
D EN^XBVK("BUD")
Q
PRGHLIST ;EP
D EOJ
S BUDPRGHL=1
D PRGH^BUDARP7I
G EN1
;
PRGRLIST ;EP
D EOJ
S BUDPRGRL=1
D PRGR^BUDARP7I
G EN1
;
PRGELIST ;EP
D EOJ
S BUDPRGEL=1
D PRGE^BUDARP7I
G EN1
;
HTRLIST ;EP
D EOJ
S BUDHTRL=1
D HTR^BUDARP7J
G EN1
;
HTCRLIST ;EP
D EOJ
S BUDHTCRL=1
D HTCR^BUDARP7J
G EN1
;
HTURLIST ;EP
D EOJ
S BUDHTURL=1
D HTUR^BUDARP7J
G EN1
;
HTELIST ;EP
D EOJ
S BUDHTEL=1
D HTE^BUDARP7K
G EN1
;
HTCELIST ;EP
D EOJ
S BUDHTCEL=1
D HTCE^BUDARP7K
G EN1
;
HTUELIST ;EP
D EOJ
S BUDHTUEL=1
D HTUE^BUDARP7K
G EN1
;
;
MHT ;EP
D EOJ
D GENI^BUDARP7I
S (BUDHTRL,BUDHTCRL,BUDHTURL,BUDHTEL,BUDHTCEL,BUDHTUEL)=0
W !!,"UDS Table 7 Hypertension Patient List Selection"
W !!?5,"1 All HTN Patients by Race and Hispanic or Latino Identity"
;W !?5,"Z All HTN Patients by Ethnicity"
W !?5,"2 All HTN Pts w/Controlled BP by Race and Hispanic or Latino Identity"
W !?5,"3 All HTN Pts w/Uncontrolled BP by Race and Hispanic or Latino Identity"
;W !?5,"Z All HTN Patients w/Controlled BP by Ethnicity"
;W !?5,"Z All HTN Patients w/Uncontrolled BP by Ethnicity"
W !?5,"4 ALL Lists for HTN Patients"
S DIR(0)="L^1:4",DIR("A")="Include which Tables",DIR("B")=1 KILL DA D ^DIR KILL DIR
I $D(DIRUT) D EOJ Q
I Y[4 S (BUDHTRL,BUDHTCRL,BUDHTURL)=1
I Y[1 S BUDHTRL=1
I Y[2 S BUDHTCRL=1
I Y[3 S BUDHTURL=1
G EN1
LIST ;
DMRLIST ;EP
D EOJ
S BUDDMRL=1
D DMR^BUDARP7L
G EN1
;
DMR1LIST ;EP
D EOJ
S BUDDMR1L=1
D DMR1^BUDARP7L
G EN1
;
DMR2LIST ;EP
D EOJ
S BUDDMR2L=1
D DMR2^BUDARP7L
G EN1
;
DMR4LIST ;EP
D EOJ
S BUDDMR4L=1
D DMR4^BUDARP7T
G EN1
;
DMR3LIST ;EP
D EOJ
S BUDDMR3L=1
D DMR3^BUDARP7T
G EN1
;
DMELIST ;EP
D EOJ
S BUDDMEL=1
D DME^BUDARP7M
G EN1
;
DME1LIST ;EP
D EOJ
S BUDDME1L=1
D DME1^BUDARP7M
G EN1
;
DME2LIST ;EP
D EOJ
S BUDDME2L=1
D DME2^BUDARP7M
G EN1
;
DME3LIST ;EP
D EOJ
S BUDDME3L=1
D DME3^BUDARP7S
G EN1
;
MDM ;EP
D EOJ
D GENI^BUDARP7I
S (BUDHTRL,BUDDMR1L,BUDHTURL,BUDHTEL,BUDHTCEL,BUDHTUEL)=0
W !!,"UDS Table 7 Diabetes Patient List Selection"
W !!?5,"1 All Patients w/DM by Race and Hispanic or Latino Identity"
;W !?5,"2 All Patients w/DM by Ethnicity"
W !?5,"2 All Patients w/DM and A1c <7 by Race and Hispanic or Latino Identity"
W !?5,"3 All Pts w/DM and A1c >=7 & <8 by Race and Hispanic or Latino Identity"
W !?5,"4 All Patients w/A1c >=8 & <=9 by Race and Hispanic or Latino Identity"
W !?5,"5 All Patients w/DM and A1c >9 or No Test by Race and Hispanic or Latino Identity"
;W !?5,"6 All Patients w/DM and A1c <7 by Ethnicity"
;W !?5,"7 All Patients w/DM and A1c >=7 and <=9 by Ethnicity"
;W !?5,"8 All Patients w/DM and A1c >9 by Ethnicity"
W !?5,"6 ALL Lists for DM Patients"
S DIR(0)="L^1:6",DIR("A")="Include which Tables",DIR("B")=1 KILL DA D ^DIR KILL DIR
I $D(DIRUT) D EOJ Q
I Y[6 S (BUDDMRL,BUDDMR1L,BUDDMR2L,BUDDMR3L,BUDDMR4L)=1
I Y[1 S BUDDMRL=1
I Y[2 S BUDDMR1L=1
I Y[3 S BUDDMR2L=1
I Y[4 S BUDDMR3L=1
I Y[5 S BUDDMR4L=1
G EN1
MPRG ;EP - called from option
D EOJ
D GENI^BUDARP7I
S (BUDPRGHL,BUDPRGRL,BUDPRGEL)=0
W !!,"UDS Table 7 Pregnant Patient List Selection"
W !!?5,"1 All Pregnant Patients w/HIV"
W !?5,"2 All Pregnant Patients by Race"
;W !?5,"3 All Pregnant Patients by Ethnicity"
W !?5,"3 ALL Lists"
S DIR(0)="L^1:3",DIR("A")="Include which Tables",DIR("B")=1 KILL DA D ^DIR KILL DIR
I $D(DIRUT) D EOJ Q
I Y[3 S (BUDPRGHL,BUDPRGRL)=1
I Y[1 S BUDPRGHL=1
I Y[2 S BUDPRGRL=1
;I Y[3 S BUDPRGEL=1
G EN1
;
PROC ;EP - called from taskman
S BUDJ=$J,BUDH=$H
S ^XTMP("BUDARP7B",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^BUD TABLE 7 LISTS"
;NOW LOOP THROUGH PATIENT FILE for imms and paps
S DFN=0 F S DFN=$O(^AUPNPAT(DFN)) Q:DFN'=+DFN D
.K ^TMP($J)
.Q:'$D(^AUPNPAT(DFN,0))
.Q:'$D(^DPT(DFN,0))
.;;I DUZ=5634 Q:'$$IWTO^BUDARPTC(DFN) G LORIN
.Q:$P(^DPT(DFN,0),U,19) ;merged away
.Q:$P(^DPT(DFN,0),U,1)["DEMO,PATIENT"
.Q:$P(^DPT(DFN,0),U,1)["PATIENT,CRS"
.Q:$P(^DPT(DFN,0),U,1)["PATIENT,UDS"
.Q:$$DEMO^BUDADU(DFN,"E")
LORIN .;DO NOT COUNT BASED ON CLASSIFICATION IN V6.0
.I BUDBEN=1,$$BEN^AUPNPAT(DFN,"C")'="01" Q ;must be Indian/Alaskan Native
.I BUDBEN=2,$$BEN^AUPNPAT(DFN,"C")="01" Q ;must not be I/A
.S BUDSEX=$P(^DPT(DFN,0),U,2)
.I BUDSEX'="F",BUDSEX'="M" Q ;valid gender
.S BUDCOM=$$COMMRES^AUPNPAT(DFN,"E") I BUDCOM="" S BUDCOM="UNKNOWN"
.S BUDAGE=$$AGE^AUPNPAT(DFN,BUDED) ;age at end of time period
.S BUDAGEP=$$AGE^AUPNPAT(DFN,BUDCAD) ;age on june 30 for pregnancy
.D GETV^BUDARPTD ;get visits that meet criteria
.I BUDT35V=0 Q ;user doesn't have any countable visits and is not considered a user
.D PRGHLST^BUDARP7A
.D PRGRLST^BUDARP7A
.;I $G(BUDPRGEL) D PRGELST^BUDARP7A
.D HTN^BUDARP7B
.D DM^BUDARP7C
Q
;
PRINT ;EP - called from taskman
D PRINT^BUDARP71
Q
;
T7H ;
W !,$$CTR("TABLE 7 - HEALTH OUTCOMES AND DISPARITIES"),!,$$REPEAT^XLFSTR("_",79),!
Q
LINE ;
W $$REPEAT^XLFSTR("_",79),?79,"|",!
Q
LINE1 ;
W $$REPEAT^XLFSTR("_",29),?29,"|",$$REPEAT^XLFSTR("_",9),?39,"|",$$REPEAT^XLFSTR("_",9),?49,"|",$$REPEAT^XLFSTR("_",9),?59,"|",$$REPEAT^XLFSTR("_",9),?69,"|",$$REPEAT^XLFSTR("_",9),?79,"|",!
Q
LINE2 ;
W $$REPEAT^XLFSTR("_",29),?29,"|",$$REPEAT^XLFSTR("_",39),?69,"|_________",?79,"|",!
Q
;
LINE3 ;
W $$REPEAT^XLFSTR("_",29),?29,"|",$$REPEAT^XLFSTR("_",49),?79,"|",!
Q
T7I ;EP
W !!,"TABLE 7: HEALTH OUTCOMES AND DISPARITIES"
W !,"This report will produce UDS Table 7, health outcomes indicators by race"
W !,"and Hispanic/Latino identity for deliveries and birth weights, controlled"
W !,"hypertension, and controlled diabetes Glycemic control. Patients must meet "
W !,"additional criteria as specified for each indicator."
W !
Q
GENI ;general introductions
W:$D(IOF) @(IOF)
W !!,$$CTR($$LOC,80),!,$$CTR("UDS 2013",80),!
W !,"UDS searches your database to find all patients reported for the quality"
W !,"of care indicators during the time period January 1 - December 31, 2013."
W !,"Based on the UDS defintion, to be considered a patient, the patient must"
W !,"have had at least one visit meeting the 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
;
PRENATT ;EP
W !!,"UDS does not calculate the deliveries and birth weight indicators"
W !,"in Section A. However, you can run a list of patients identified "
W !,"by UDS as pregnant to determine which of them received prenatal care at"
W !,"your facility to assist you with completing Table 7, Section A."
W !,"The menu options you would select to run the patient list are: LST, LST3,"
W !,"PRG, PRGR (list by race and Hispanic or Latino identity)."
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")
;----------
PAUSE ;EP
K DIR S DIR(0)="E",DIR("A")="PRESS ENTER" KILL DA D ^DIR KILL DIR
Q
C(X,Y) ;
I $G(Y)=1,+X=0 Q ""
I $G(Y)=2 Q "********"
S X2=0,X3=8
D COMMA^%DTC
Q X
YEAR ;
S BUDYEAR=""
W !
W !,"Enter the Calendar Year. Use a 4 digit year, e.g. 2003, 2007"
S DIR(0)="D^::EP"
S DIR("A")="Enter Calendar Year"
S DIR("?")="This report is compiled for a period. Enter a valid date."
D ^DIR KILL DIR
K DIC
I $D(DUOUT) S DIRUT=1 Q
I $D(DIRUT) Q
I $E(Y,4,7)'="0000" W !!,"Please enter a year only!",! G YEAR
S BUDYEAR=Y,BUDBD=$E(BUDYEAR,1,3)_"0101",BUDED=$E(BUDYEAR,1,3)_"1231"
S BUDCAD=$E(BUDYEAR,1,3)_"0630"
Q
BUDARP7 ; IHS/CMI/LAB - UDS REPORT DRIVER TABLE 6B 12 Dec 2013 6:51 AM 30 Dec 2013 8:19 PM 27 Aug 2013 12:41 PM ; 21 Jan 2014 2:52 PM
+1 ;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50
+2 ;
+3 ;
T7 ;
+1 DO EOJ
EN ;
+1 DO GENI
+2 DO T7I
+3 DO PAUSE
+4 DO PRENATT
+5 DO PAUSE
+6 ;
EN1 ;
PNC ;
+1 SET BUDPREN=""
+2 SET DIR(0)="Y"
SET DIR("A")="Does your facility provide prenatal care"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
DO EOJ
QUIT
+4 SET BUDPREN=Y
+5 ;
EN2 ;
+1 SET BUDSITE=""
+2 SET DIC="^BUDQSITE("
SET DIC(0)="AEMQ"
SET DIC("A")="Enter your site: "
DO ^DIC
+3 IF Y=-1
GOTO PNC
+4 SET BUDSITE=+Y
+5 IF '$ORDER(^BUDQSITE(BUDSITE,11,0))
WRITE !!,"Warning: There are no locations defined in the site parameter file for this",!,"site. Report will not be accurate!"
GOTO EN
+6 SET BUDTAXT="7"
DO TAXCHK^BUDAXTCH
+7 ;S BUDYEAR=3080000,BUDBD=3080101,BUDED=3081231
+8 ;S BUDCAD=3080630
+9 ;S BUDYEAR=3030000,BUDBD=3030101,BUDED=3031231
+10 ;S BUDCAD=3030630
+11 SET BUDYEAR=""
+12 DO YEAR
+13 IF BUDYEAR=""
DO EOJ
QUIT
+14 WRITE !!,"Your report will be run for the time period: ",$$FMTE^XLFDT(BUDBD)," to ",$$FMTE^XLFDT(BUDED)
+15 ;get indian or not
+16 SET BUDBEN=""
+17 SET DIR(0)="S^1:Indian/Alaskan Native (Classification 01);2:Not Indian Alaskan/Native (Not Classification 01);3:All (both Indian/Alaskan Natives and Non 01)"
SET DIR("A")="Select Beneficiary Population to include in this report"
+18 SET DIR("B")="1"
KILL DA
DO ^DIR
KILL DIR
+19 IF $DATA(DIRUT)
WRITE !!,"Classification not entered."
DO EOJ
QUIT
+20 SET BUDBEN=Y
ZIS ;call to XBDBQUE
+1 KILL IOP,%ZIS
+2 WRITE !!
SET %ZIS="PQM"
DO ^%ZIS
+3 IF POP
DO EOJ
QUIT
ZIS1 ;
+1 IF $DATA(IO("Q"))
GOTO TSKMN
DRIVER ;
+1 DO PROC
+2 USE IO
+3 DO PRINT
+4 DO ^%ZISC
+5 DO EOJ
+6 QUIT
TSKMN ;EP ENTRY POINT FROM TASKMAN
+1 SET ZTIO=$SELECT($DATA(ION):ION,1:IO)
IF $DATA(IOST)#2
IF IOST]""
SET ZTIO=ZTIO_";"_IOST
+2 IF $GET(IO("DOC"))]""
SET ZTIO=ZTIO_";"_$GET(IO("DOC"))
+3 IF $DATA(IOM)#2
IF IOM
SET ZTIO=ZTIO_";"_IOM
IF $DATA(IOSL)#2
IF IOSL
SET ZTIO=ZTIO_";"_IOSL
+4 KILL ZTSAVE
SET ZTSAVE("BUD*")=""
+5 SET ZTCPU=$GET(IOCPU)
SET ZTRTN="DRIVER^BUDARP7"
SET ZTDTH=""
SET ZTDESC="UDS 13 REPORT TABLE 7"
DO ^%ZTLOAD
DO EOJ
QUIT
+6 QUIT
EOJ ;
+1 DO EN^XBVK("BUD")
+2 QUIT
PRGHLIST ;EP
+1 DO EOJ
+2 SET BUDPRGHL=1
+3 DO PRGH^BUDARP7I
+4 GOTO EN1
+5 ;
PRGRLIST ;EP
+1 DO EOJ
+2 SET BUDPRGRL=1
+3 DO PRGR^BUDARP7I
+4 GOTO EN1
+5 ;
PRGELIST ;EP
+1 DO EOJ
+2 SET BUDPRGEL=1
+3 DO PRGE^BUDARP7I
+4 GOTO EN1
+5 ;
HTRLIST ;EP
+1 DO EOJ
+2 SET BUDHTRL=1
+3 DO HTR^BUDARP7J
+4 GOTO EN1
+5 ;
HTCRLIST ;EP
+1 DO EOJ
+2 SET BUDHTCRL=1
+3 DO HTCR^BUDARP7J
+4 GOTO EN1
+5 ;
HTURLIST ;EP
+1 DO EOJ
+2 SET BUDHTURL=1
+3 DO HTUR^BUDARP7J
+4 GOTO EN1
+5 ;
HTELIST ;EP
+1 DO EOJ
+2 SET BUDHTEL=1
+3 DO HTE^BUDARP7K
+4 GOTO EN1
+5 ;
HTCELIST ;EP
+1 DO EOJ
+2 SET BUDHTCEL=1
+3 DO HTCE^BUDARP7K
+4 GOTO EN1
+5 ;
HTUELIST ;EP
+1 DO EOJ
+2 SET BUDHTUEL=1
+3 DO HTUE^BUDARP7K
+4 GOTO EN1
+5 ;
+6 ;
MHT ;EP
+1 DO EOJ
+2 DO GENI^BUDARP7I
+3 SET (BUDHTRL,BUDHTCRL,BUDHTURL,BUDHTEL,BUDHTCEL,BUDHTUEL)=0
+4 WRITE !!,"UDS Table 7 Hypertension Patient List Selection"
+5 WRITE !!?5,"1 All HTN Patients by Race and Hispanic or Latino Identity"
+6 ;W !?5,"Z All HTN Patients by Ethnicity"
+7 WRITE !?5,"2 All HTN Pts w/Controlled BP by Race and Hispanic or Latino Identity"
+8 WRITE !?5,"3 All HTN Pts w/Uncontrolled BP by Race and Hispanic or Latino Identity"
+9 ;W !?5,"Z All HTN Patients w/Controlled BP by Ethnicity"
+10 ;W !?5,"Z All HTN Patients w/Uncontrolled BP by Ethnicity"
+11 WRITE !?5,"4 ALL Lists for HTN Patients"
+12 SET DIR(0)="L^1:4"
SET DIR("A")="Include which Tables"
SET DIR("B")=1
KILL DA
DO ^DIR
KILL DIR
+13 IF $DATA(DIRUT)
DO EOJ
QUIT
+14 IF Y[4
SET (BUDHTRL,BUDHTCRL,BUDHTURL)=1
+15 IF Y[1
SET BUDHTRL=1
+16 IF Y[2
SET BUDHTCRL=1
+17 IF Y[3
SET BUDHTURL=1
+18 GOTO EN1
LIST ;
DMRLIST ;EP
+1 DO EOJ
+2 SET BUDDMRL=1
+3 DO DMR^BUDARP7L
+4 GOTO EN1
+5 ;
DMR1LIST ;EP
+1 DO EOJ
+2 SET BUDDMR1L=1
+3 DO DMR1^BUDARP7L
+4 GOTO EN1
+5 ;
DMR2LIST ;EP
+1 DO EOJ
+2 SET BUDDMR2L=1
+3 DO DMR2^BUDARP7L
+4 GOTO EN1
+5 ;
DMR4LIST ;EP
+1 DO EOJ
+2 SET BUDDMR4L=1
+3 DO DMR4^BUDARP7T
+4 GOTO EN1
+5 ;
DMR3LIST ;EP
+1 DO EOJ
+2 SET BUDDMR3L=1
+3 DO DMR3^BUDARP7T
+4 GOTO EN1
+5 ;
DMELIST ;EP
+1 DO EOJ
+2 SET BUDDMEL=1
+3 DO DME^BUDARP7M
+4 GOTO EN1
+5 ;
DME1LIST ;EP
+1 DO EOJ
+2 SET BUDDME1L=1
+3 DO DME1^BUDARP7M
+4 GOTO EN1
+5 ;
DME2LIST ;EP
+1 DO EOJ
+2 SET BUDDME2L=1
+3 DO DME2^BUDARP7M
+4 GOTO EN1
+5 ;
DME3LIST ;EP
+1 DO EOJ
+2 SET BUDDME3L=1
+3 DO DME3^BUDARP7S
+4 GOTO EN1
+5 ;
MDM ;EP
+1 DO EOJ
+2 DO GENI^BUDARP7I
+3 SET (BUDHTRL,BUDDMR1L,BUDHTURL,BUDHTEL,BUDHTCEL,BUDHTUEL)=0
+4 WRITE !!,"UDS Table 7 Diabetes Patient List Selection"
+5 WRITE !!?5,"1 All Patients w/DM by Race and Hispanic or Latino Identity"
+6 ;W !?5,"2 All Patients w/DM by Ethnicity"
+7 WRITE !?5,"2 All Patients w/DM and A1c <7 by Race and Hispanic or Latino Identity"
+8 WRITE !?5,"3 All Pts w/DM and A1c >=7 & <8 by Race and Hispanic or Latino Identity"
+9 WRITE !?5,"4 All Patients w/A1c >=8 & <=9 by Race and Hispanic or Latino Identity"
+10 WRITE !?5,"5 All Patients w/DM and A1c >9 or No Test by Race and Hispanic or Latino Identity"
+11 ;W !?5,"6 All Patients w/DM and A1c <7 by Ethnicity"
+12 ;W !?5,"7 All Patients w/DM and A1c >=7 and <=9 by Ethnicity"
+13 ;W !?5,"8 All Patients w/DM and A1c >9 by Ethnicity"
+14 WRITE !?5,"6 ALL Lists for DM Patients"
+15 SET DIR(0)="L^1:6"
SET DIR("A")="Include which Tables"
SET DIR("B")=1
KILL DA
DO ^DIR
KILL DIR
+16 IF $DATA(DIRUT)
DO EOJ
QUIT
+17 IF Y[6
SET (BUDDMRL,BUDDMR1L,BUDDMR2L,BUDDMR3L,BUDDMR4L)=1
+18 IF Y[1
SET BUDDMRL=1
+19 IF Y[2
SET BUDDMR1L=1
+20 IF Y[3
SET BUDDMR2L=1
+21 IF Y[4
SET BUDDMR3L=1
+22 IF Y[5
SET BUDDMR4L=1
+23 GOTO EN1
MPRG ;EP - called from option
+1 DO EOJ
+2 DO GENI^BUDARP7I
+3 SET (BUDPRGHL,BUDPRGRL,BUDPRGEL)=0
+4 WRITE !!,"UDS Table 7 Pregnant Patient List Selection"
+5 WRITE !!?5,"1 All Pregnant Patients w/HIV"
+6 WRITE !?5,"2 All Pregnant Patients by Race"
+7 ;W !?5,"3 All Pregnant Patients by Ethnicity"
+8 WRITE !?5,"3 ALL Lists"
+9 SET DIR(0)="L^1:3"
SET DIR("A")="Include which Tables"
SET DIR("B")=1
KILL DA
DO ^DIR
KILL DIR
+10 IF $DATA(DIRUT)
DO EOJ
QUIT
+11 IF Y[3
SET (BUDPRGHL,BUDPRGRL)=1
+12 IF Y[1
SET BUDPRGHL=1
+13 IF Y[2
SET BUDPRGRL=1
+14 ;I Y[3 S BUDPRGEL=1
+15 GOTO EN1
+16 ;
PROC ;EP - called from taskman
+1 SET BUDJ=$JOB
SET BUDH=$HOROLOG
+2 SET ^XTMP("BUDARP7B",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^BUD TABLE 7 LISTS"
+3 ;NOW LOOP THROUGH PATIENT FILE for imms and paps
+4 SET DFN=0
FOR
SET DFN=$ORDER(^AUPNPAT(DFN))
IF DFN'=+DFN
QUIT
Begin DoDot:1
+5 KILL ^TMP($JOB)
+6 IF '$DATA(^AUPNPAT(DFN,0))
QUIT
+7 IF '$DATA(^DPT(DFN,0))
QUIT
+8 ;;I DUZ=5634 Q:'$$IWTO^BUDARPTC(DFN) G LORIN
+9 ;merged away
IF $PIECE(^DPT(DFN,0),U,19)
QUIT
+10 IF $PIECE(^DPT(DFN,0),U,1)["DEMO,PATIENT"
QUIT
+11 IF $PIECE(^DPT(DFN,0),U,1)["PATIENT,CRS"
QUIT
+12 IF $PIECE(^DPT(DFN,0),U,1)["PATIENT,UDS"
QUIT
+13 IF $$DEMO^BUDADU(DFN,"E")
QUIT
LORIN ;DO NOT COUNT BASED ON CLASSIFICATION IN V6.0
+1 ;must be Indian/Alaskan Native
IF BUDBEN=1
IF $$BEN^AUPNPAT(DFN,"C")'="01"
QUIT
+2 ;must not be I/A
IF BUDBEN=2
IF $$BEN^AUPNPAT(DFN,"C")="01"
QUIT
+3 SET BUDSEX=$PIECE(^DPT(DFN,0),U,2)
+4 ;valid gender
IF BUDSEX'="F"
IF BUDSEX'="M"
QUIT
+5 SET BUDCOM=$$COMMRES^AUPNPAT(DFN,"E")
IF BUDCOM=""
SET BUDCOM="UNKNOWN"
+6 ;age at end of time period
SET BUDAGE=$$AGE^AUPNPAT(DFN,BUDED)
+7 ;age on june 30 for pregnancy
SET BUDAGEP=$$AGE^AUPNPAT(DFN,BUDCAD)
+8 ;get visits that meet criteria
DO GETV^BUDARPTD
+9 ;user doesn't have any countable visits and is not considered a user
IF BUDT35V=0
QUIT
+10 DO PRGHLST^BUDARP7A
+11 DO PRGRLST^BUDARP7A
+12 ;I $G(BUDPRGEL) D PRGELST^BUDARP7A
+13 DO HTN^BUDARP7B
+14 DO DM^BUDARP7C
End DoDot:1
+15 QUIT
+16 ;
PRINT ;EP - called from taskman
+1 DO PRINT^BUDARP71
+2 QUIT
+3 ;
T7H ;
+1 WRITE !,$$CTR("TABLE 7 - HEALTH OUTCOMES AND DISPARITIES"),!,$$REPEAT^XLFSTR("_",79),!
+2 QUIT
LINE ;
+1 WRITE $$REPEAT^XLFSTR("_",79),?79,"|",!
+2 QUIT
LINE1 ;
+1 WRITE $$REPEAT^XLFSTR("_",29),?29,"|",$$REPEAT^XLFSTR("_",9),?39,"|",$$REPEAT^XLFSTR("_",9),?49,"|",$$REPEAT^XLFSTR("_",9),?59,"|",$$REPEAT^XLFSTR("_",9),?69,"|",$$REPEAT^XLFSTR("_",9),?79,"|",!
+2 QUIT
LINE2 ;
+1 WRITE $$REPEAT^XLFSTR("_",29),?29,"|",$$REPEAT^XLFSTR("_",39),?69,"|_________",?79,"|",!
+2 QUIT
+3 ;
LINE3 ;
+1 WRITE $$REPEAT^XLFSTR("_",29),?29,"|",$$REPEAT^XLFSTR("_",49),?79,"|",!
+2 QUIT
T7I ;EP
+1 WRITE !!,"TABLE 7: HEALTH OUTCOMES AND DISPARITIES"
+2 WRITE !,"This report will produce UDS Table 7, health outcomes indicators by race"
+3 WRITE !,"and Hispanic/Latino identity for deliveries and birth weights, controlled"
+4 WRITE !,"hypertension, and controlled diabetes Glycemic control. Patients must meet "
+5 WRITE !,"additional criteria as specified for each indicator."
+6 WRITE !
+7 QUIT
GENI ;general introductions
+1 IF $DATA(IOF)
WRITE @(IOF)
+2 WRITE !!,$$CTR($$LOC,80),!,$$CTR("UDS 2013",80),!
+3 WRITE !,"UDS searches your database to find all patients reported for the quality"
+4 WRITE !,"of care indicators during the time period January 1 - December 31, 2013."
+5 WRITE !,"Based on the UDS defintion, to be considered a patient, the patient must"
+6 WRITE !,"have had at least one visit meeting the following criteria:"
+7 WRITE !?4,"- must be to a location specified in your visit location setup"
+8 WRITE !?4,"- must be to Service Category Ambulatory (A), Hospitalization (H), Day"
+9 WRITE !?6,"Surgery (S), Observation (O), Telemedicine (M), Nursing home visit (R), "
+10 WRITE !?6,"or In-Hospital (I) visit"
+11 WRITE !?4,"- must NOT have an excluded clinic code (see User Manual for a list)"
+12 WRITE !?4,"- must have a primary provider and a coded purpose of visit"
+13 WRITE !?4,"- the patient must NOT have a gender of 'Unknown'"
+14 WRITE !
+15 QUIT
+16 ;
PRENATT ;EP
+1 WRITE !!,"UDS does not calculate the deliveries and birth weight indicators"
+2 WRITE !,"in Section A. However, you can run a list of patients identified "
+3 WRITE !,"by UDS as pregnant to determine which of them received prenatal care at"
+4 WRITE !,"your facility to assist you with completing Table 7, Section A."
+5 WRITE !,"The menu options you would select to run the patient list are: LST, LST3,"
+6 WRITE !,"PRG, PRGR (list by race and Hispanic or Latino identity)."
+7 WRITE !
+8 QUIT
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 ;----------
PAUSE ;EP
+1 KILL DIR
SET DIR(0)="E"
SET DIR("A")="PRESS ENTER"
KILL DA
DO ^DIR
KILL DIR
+2 QUIT
C(X,Y) ;
+1 IF $GET(Y)=1
IF +X=0
QUIT ""
+2 IF $GET(Y)=2
QUIT "********"
+3 SET X2=0
SET X3=8
+4 DO COMMA^%DTC
+5 QUIT X
YEAR ;
+1 SET BUDYEAR=""
+2 WRITE !
+3 WRITE !,"Enter the Calendar Year. Use a 4 digit year, e.g. 2003, 2007"
+4 SET DIR(0)="D^::EP"
+5 SET DIR("A")="Enter Calendar Year"
+6 SET DIR("?")="This report is compiled for a period. Enter a valid date."
+7 DO ^DIR
KILL DIR
+8 KILL DIC
+9 IF $DATA(DUOUT)
SET DIRUT=1
QUIT
+10 IF $DATA(DIRUT)
QUIT
+11 IF $EXTRACT(Y,4,7)'="0000"
WRITE !!,"Please enter a year only!",!
GOTO YEAR
+12 SET BUDYEAR=Y
SET BUDBD=$EXTRACT(BUDYEAR,1,3)_"0101"
SET BUDED=$EXTRACT(BUDYEAR,1,3)_"1231"
+13 SET BUDCAD=$EXTRACT(BUDYEAR,1,3)_"0630"
+14 QUIT
