BUDCRP7I ; IHS/CMI/LAB - UDS REPORT DRIVER TABLE 6B ;
;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50
;
;
S(V) ;
S BUDDECNT=BUDDECNT+1
S ^TMP($J,"BUDDEL",BUDDECNT)=$G(V)
Q
;----------
PAUSE ;
K DIR S DIR(0)="E",DIR("A")="PRESS ENTER" KILL DA D ^DIR KILL DIR
Q
GENI ;EP - general introductions
W !,"NOTE: Patient lists may be hundreds of pages long, depending on the size of your"
W !,"patient population. It is recommended that you run these reports at night and"
W !,"print to an electronic file, not directly to a printer.",!
K DIR S DIR(0)="E",DIR("A")="Press Enter to Continue" D ^DIR K DIR
W !!,"This Patient List option documents the individual patients and visits"
W !,"that are counted and summarized on each Table report (main menu"
W !,"option REP). The summary Table report is included at the beginning of each"
W !,"List report."
W !,"UDS searches your database to find all visits and related patients"
W !,"during the time period selected. Based on the UDS definition, to be counted"
W !,"as a patient, the patient must have had at least one visit meeting the "
W !,"following criteria:"
W !?4,"- must be to a location specified in your visit location setup"
W !?4,"- must be to Service Category Ambulatory (A), Hospitalization (H), Day"
W !?6,"Surgery (S), Observation (O), Telemedicine (M), Nursing home visit (R), "
W !?6,"or In-Hospital (I) visit"
W !?4,"- must NOT have an excluded clinic code (see User Manual for a list)"
W !?4,"- must have a primary provider and a coded purpose of visit"
W !?4,"- the patient must NOT have a gender of 'Unknown'"
W !
Q
;
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
USR() ;EP - Return name of current user from ^VA(200.
Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
;----------
PRGH ;EP
W:$D(IOF) @IOF
W !,$$CTR($$LOC,80)
W !,$$CTR("UDS 2015",80)
W !!,"Pregnant Patients w/HIV (Table 7, Section A)",!
D GENI
D PAUSE
W !!,"This report provides a list of patients that had pregnancy-related visits"
W !,"during the past 20 months, with at least one pregnancy-related visit"
W !,"during the report period, and who have been diagnosed with HIV."
W !
Q
PRGHL ;EP
S BUDP=0,BUDQUIT=0,BUDTOT=0
D PRGHH Q:BUDQUIT
I '$D(^XTMP("BUDCRP7",BUDJ,BUDH,"PRGH")) S X="No patients to report." W:BUDROT="P" !!,X D:BUDROT="D" S(),S(X) Q
D PRGHL1
I BUDROT="P",$Y>(IOSL-3) D PRGHH G:BUDQUIT PRGHLX
S X="TOTAL HIV POSITIVE PREGNANT PATIENTS: "_BUDTOT
I BUDROT="P" W !!,X,!
I BUDROT="D" D S(),S(X)
PRGHLX ;
Q
PRGHL1 ;
I BUDROT="P",$Y>(IOSL-7) D PRGHH Q:BUDQUIT
S BUDTOT=0
S BUDA=0 F S BUDA=$O(^XTMP("BUDCRP7",BUDJ,BUDH,"PRGH",BUDA)) Q:BUDA'=+BUDA!(BUDQUIT) D
.S BUDNAME="" F S BUDNAME=$O(^XTMP("BUDCRP7",BUDJ,BUDH,"PRGH",BUDA,BUDNAME)) Q:BUDNAME=""!(BUDQUIT) D
..S BUDCOM="" F S BUDCOM=$O(^XTMP("BUDCRP7",BUDJ,BUDH,"PRGH",BUDA,BUDNAME,BUDCOM)) Q:BUDCOM=""!(BUDQUIT) D
...S DFN=0 F S DFN=$O(^XTMP("BUDCRP7",BUDJ,BUDH,"PRGH",BUDA,BUDNAME,BUDCOM,DFN)) Q:DFN'=+DFN!(BUDQUIT) D
....I BUDROT="P",$Y>(IOSL-3) D PRGHH Q:BUDQUIT
....S BUDX=^XTMP("BUDCRP7",BUDJ,BUDH,"PRGH",BUDA,BUDNAME,BUDCOM,DFN)
....I BUDROT="P" W !,$E($P(^DPT(DFN,0),U,1),1,23),?25,$S($$HRN^AUPNPAT(DFN,BUDSITE)]"":$$HRN^AUPNPAT(DFN,BUDSITE,2),1:$$HRN^AUPNPAT(DFN,DUZ(2),2)),?41,$E(BUDCOM,1,12),?54,BUDA,?59,$P(BUDX,"@",2),!
....S BUDTOT=BUDTOT+1
....S BUDALL=^XTMP("BUDCRP7",BUDJ,BUDH,"PRGH",BUDA,BUDNAME,BUDCOM,DFN)
....S BUDPPV=$P(BUDALL,"#",1)
....S BUDHIV=$P(BUDALL,"#",2)
....S BUDHIV=$P(BUDHIV,"@",1)
....S BUDPV="" I BUDROT="D" S BUDPV=$E($P(^DPT(DFN,0),U,1),1,30)_U_$S($$HRN^AUPNPAT(DFN,BUDSITE)]"":$$HRN^AUPNPAT(DFN,BUDSITE,2),1:$$HRN^AUPNPAT(DFN,DUZ(2),2))_U_$E(BUDCOM,1,12)_U_BUDA_U_$P(BUDX,"@",2)
....F BUDX=1:1 S BUDV=$P(BUDPPV,U,BUDX) Q:BUDV=""!(BUDQUIT) D
.....I BUDROT="P",$Y>(IOSL-3) D PRGHH Q:BUDQUIT
.....I BUDROT="P",$E(BUDV)="P" W ?5,BUDV,! Q
.....I BUDROT="D" S BUDPV=BUDPV_U_BUDV D S(BUDPV) Q
.....S V=$P(BUDV,"|"),C=$P(BUDV,"|",2)
.....I BUDROT="P" 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 BUDROT="D" S X=BUDPV_U_$$FMTE^XLFDT($P($P(^AUPNVSIT(V,0),U),"."))_U_C_U_$$PRIMPROV^APCLV(V,"D")_U_$P(^AUPNVSIT(V,0),U,7)_U_$$CLINIC^APCLV(V,"C")_U_$$VAL^XBDIQ1(9000010,V,.06) D S(X)
....F BUDX=1:1 S BUDV=$P(BUDHIV,U,BUDX) Q:BUDV=""!(BUDQUIT) D
.....I BUDROT="P",$Y>(IOSL-3) D PRGHH Q:BUDQUIT
.....I BUDROT="P",$E(BUDV)="P" W ?5,BUDV,! Q
.....I BUDROT="D" S BUDPV=BUDPV_U_BUDV D S(BUDPV) Q
.....S V=$P(BUDV,"|"),C=$P(BUDV,"|",2)
.....I BUDROT="P" 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 BUDROT="D" S X=BUDPV_U_$$FMTE^XLFDT($P($P(^AUPNVSIT(V,0),U),"."))_U_C_U_$$PRIMPROV^APCLV(V,"D")_U_$P(^AUPNVSIT(V,0),U,7)_U_$$CLINIC^APCLV(V,"C")_U_$$VAL^XBDIQ1(9000010,V,.06) D S(X)
Q
PRGHHD ;
D S(),S(),S()
D S("***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****")
D S($P(^VA(200,DUZ,0),U,2)_" "_$$FMTE^XLFDT(DT))
D S("*** RPMS Uniform Data System (UDS) ***")
D S("Patient List for Table 7, HIV Positive Pregnant Women")
D S($P(^DIC(4,BUDSITE,0),U))
S X="Reporting Period: "_$$FMTE^XLFDT(BUDBD)_" to "_$$FMTE^XLFDT(BUDED) D S(X)
S X="Population: "_$S($G(BUDCEN)=1:"Indian/Alaskan Native (Classification 01)",$G(BUDCEN)=2:"Not Indian Alaskan/Native (Not Classification 01)",$G(BUDCEN)=3:"All (both Indian/Alaskan Natives and Non 01)",1:"") D S(X)
D S()
D S("List of all pregnant patients with HIV, with most recent pregnancy")
D S("related visits during the past 20 months.")
D S("Age is calculated as of June 30.")
D S()
D S("PATIENT NAME^HRN^COMMUNITY^AGE^CD & Date Last HIV DX^VISIT DATE^DX OR SVC CD^PROV TYPE^SVC CAT^CLINIC^LOCATION")
Q
PRGHH ;
I BUDROT="D" D PRGHHD Q
G:'BUDGPG PRGHH1
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
PRGHH1 ;
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, HIV Positive Pregnant Women",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 of all pregnant patients with HIV, with most recent pregnancy"
.W !,"related visits during the past 20 months."
.W !,"Age is calculated as of June 30."
.W !
W !,"PATIENT NAME",?25,"HRN",?41,"COMMUNITY",?53,"AGE",?59,"CD & Date Last HIV DX"
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
;
PRGR ;EP
W:$D(IOF) @IOF
W !,$$CTR($$LOC,80)
W !,$$CTR("UDS 2015",80)
W !!,"All Pregnant Patients by Race and Hispanic or Latino Identity",!,"(Table 7, Section A)",!
D GENI
D PAUSE
W !!,"This report provides a list by race and Hispanic or Latino Identity"
W !,"of patients that had pregnancy-related visits during the past 20 months,"
W !,"with at least one pregnancy related visit during the report period."
W !
Q
PRGRL ;EP
S BUDP=0,BUDQUIT=0,BUDTOT=0
D PRGRH Q:BUDQUIT
I '$D(^XTMP("BUDCRP7",BUDJ,BUDH,"PRGR")) S X="No patients to report." W:BUDROT="P" !!,X D:BUDROT="D" S(),S(X) Q
D PRGRL1
I BUDROT="P",$Y>(IOSL-3) D PRGRH G:BUDQUIT PRGRLX
S X="TOTAL PREGNANT PATIENTS BY HISPANIC OR LATINO IDENTITY AND RACE: "_BUDTOT
I BUDROT="P" W !!,X,!
I BUDROT="D" D S(),S(X)
PRGRLX ;
Q
RACE(R) ;EP
I R="UNREP/REF" Q "Unreported/Refused to Report"
I R="ASIAN" Q "Asian"
I R="NATIVE HAWAIIAN" Q "Native Hawaiian"
I R="OTH PAC ISLANDER" Q "Other Pacific Islander"
I R="BLACK" Q "Black/African American"
I R="AI/AN" Q "American Indian/Alaska Native"
I R="WHITE" Q "White"
I R="HISPANIC,WHITE" Q "White"
I R="HISPANIC,BLACK" Q "Black/African American"
I R="MORE THAN ONE RACE" Q "More than One Race"
Q ""
;
PRGRL1 ;
I BUDROT="P",$Y>(IOSL-7) D PRGRH Q:BUDQUIT
S BUDTOT=0
S BUDRACE="" F S BUDRACE=$O(^XTMP("BUDCRP7",BUDJ,BUDH,"PRGR",BUDRACE)) Q:BUDRACE=""!(BUDQUIT) D
.S BUDETH="" F S BUDETH=$O(^XTMP("BUDCRP7",BUDJ,BUDH,"PRGR",BUDRACE,BUDETH)) Q:BUDETH=""!(BUDQUIT) D PRGRL2
Q
PRGRL2 ;
S BUDSTOT=0
S BUDRACEL=$$RACEL(BUDRACE,BUDETH)
I BUDROT="P" W !,BUDRACEL
I BUDROT="D" D S(BUDRACEL)
S BUDCOM="" F S BUDCOM=$O(^XTMP("BUDCRP7",BUDJ,BUDH,"PRGR",BUDRACE,BUDETH,BUDCOM)) Q:BUDCOM=""!(BUDQUIT) D
.S BUDA="" F S BUDA=$O(^XTMP("BUDCRP7",BUDJ,BUDH,"PRGR",BUDRACE,BUDETH,BUDCOM,BUDA)) Q:BUDA=""!(BUDQUIT) D
..S BUDNAME="" F S BUDNAME=$O(^XTMP("BUDCRP7",BUDJ,BUDH,"PRGR",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME)) Q:BUDNAME=""!(BUDQUIT) D
...S DFN=0 F S DFN=$O(^XTMP("BUDCRP7",BUDJ,BUDH,"PRGR",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME,DFN)) Q:DFN'=+DFN!(BUDQUIT) D
....I BUDROT="P",$Y>(IOSL-3) D PRGRH Q:BUDQUIT W !,BUDRACEL,!
....I BUDROT="P" 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,BUDA,! ;
....I BUDROT="D" S BUDPV="",BUDPV=$E($P(^DPT(DFN,0),U,1),1,30)_U_$S($$HRN^AUPNPAT(DFN,BUDSITE)]"":$$HRN^AUPNPAT(DFN,BUDSITE,2),1:$$HRN^AUPNPAT(DFN,DUZ(2),2))_U_$E(BUDCOM,1,12)_U_BUDA
....S BUDTOT=BUDTOT+1,BUDSTOT=BUDSTOT+1
....S BUDRACV=$$RACE^BUDCRPTC(DFN)
....I BUDROT="P" W ?2,$E($P(BUDRACV,U,4),1,16)_" ("_$P(BUDRACV,U,3),")" ;,?60,$E($P($$RACE^BUDCRPTC(DFN),U,3)_"-"_$P($$RACE^BUDCRPTC(DFN),U,4),1,19)
....I BUDROT="D" S BUDPV=BUDPV_U_$E($P(BUDRACV,U,4),1,16)_" ("_$P(BUDRACV,U,3)_")"
....S BUDHISV=$$HISP^BUDCRPTC(DFN)
....I BUDROT="P" W ?24,$P(BUDHISV,U,3)," (",$P(BUDHISV,U,2),")",!
....I BUDROT="D" S BUDPV=BUDPV_U_$P(BUDHISV,U,3)_" ("_$P(BUDHISV,U,2)_")"
....S BUDALL=^XTMP("BUDCRP7",BUDJ,BUDH,"PRGR",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME,DFN)
....S BUDPPV=$P(BUDALL,"#",1)
....F BUDX=1:1 S BUDV=$P(BUDPPV,U,BUDX) Q:BUDV=""!(BUDQUIT) D
.....I BUDROT="P",$Y>(IOSL-3) D PRGRH Q:BUDQUIT W !,BUDRACEL,!
.....I BUDROT="P" I $E(BUDV)="P" W ?5,BUDV,! Q
.....I BUDROT="D" I $E(BUDV)="P" S X=BUDPV_U_BUDV D S(X) Q
.....S V=$P(BUDV,"|"),C=$P(BUDV,"|",2)
.....I BUDROT="P" 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 BUDROT="D" S X=BUDPV_U_$$FMTE^XLFDT($P($P(^AUPNVSIT(V,0),U),"."))_U_C_U_$$PRIMPROV^APCLV(V,"D")_U_$P(^AUPNVSIT(V,0),U,7)_U_$$CLINIC^APCLV(V,"C")_U_$$VAL^XBDIQ1(9000010,V,.06) D S(X)
I BUDROT="P",$Y>(IOSL-4) D PRGRH Q:BUDQUIT W !,BUDRACEL,!
S X="Sub-Total "_BUDRACEL_": "_BUDSTOT
I BUDROT="P" W !,X,!
I BUDROT="D" D S(X),S()
Q
PRGRH ;
I BUDROT="D" D PRGRHD Q
G:'BUDGPG PRGRH1
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
PRGRH1 ;
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 A",80),!,$$CTR("All Pregnant 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 of all pregnant patients by race and Hispanic or Latino Identity,"
.W !,"with most recent pregnancy related visits during the past 20 months."
.W !,"Age is calculated as of June 30."
.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,"AGE"
W !?2,"RACE*",?24,"HISPANIC OR LATINO IDENTITY*"
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
PRGRHD ;
D S(),S(),S()
D S("***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****")
D S($P(^VA(200,DUZ,0),U,2)_" "_$$FMTE^XLFDT(DT))
D S("*** RPMS Uniform Data System (UDS) ***")
D S("Patient List for Table 7, Section A, All Pregnant Patients by Race and Hispanic or Latino Identity")
D S($P(^DIC(4,BUDSITE,0),U))
S X="Reporting Period: "_$$FMTE^XLFDT(BUDBD)_" to "_$$FMTE^XLFDT(BUDED) D S(X)
S X="Population: "_$S($G(BUDCEN)=1:"Indian/Alaskan Native (Classification 01)",$G(BUDCEN)=2:"Not Indian Alaskan/Native (Not Classification 01)",$G(BUDCEN)=3:"All (both Indian/Alaskan Natives and Non 01)",1:"") D S(X)
D S()
D S("List of all pregnant patients by race and Hispanic or Latino Identity,")
D S("with most recent pregnancy related visits during the past 20 months.")
D S("Age is calculated as of June 30.")
D S("* E - denotes the value was obtained from the Ethnicity field.")
D S(" R - denotes the value was obtained from the Race field")
D S(" C - denotes the value was obtained from the Classification/Beneficiary field")
D S()
D S("PATIENT NAME^HRN^COMMUNITY^AGE^RACE*^HISPANIC OR LATINO IDENTITY^VISIT DATE^DX OR SVC CD^PROV TYPE^SVC CAT^CLINIC^LOCATION")
Q
RACEL(R,E) ;EP
I R=1,E=1 Q "Asian, Hispanic"
I R=1,E=2 Q "Asian, Non-Hispanic"
I R=2,E=1 Q "Native Hawaiian, Hispanic"
I R=2,E=2 Q "Native Hawaiian, Non-Hispanic"
I R=3,E=1 Q "Other Pacific Islander, Hispanic"
I R=3,E=2 Q "Other Pacific Islander, Non-Hispanic"
I R=4,E=1 Q "Black/African American, Hispanic"
I R=4,E=2 Q "Black/African American, Non-Hispanic"
I R=5,E=1 Q "American Indian/Alaska Native, Hispanic"
I R=5,E=2 Q "American Indian/Alaska Native, Non-Hispanic"
I R=6,E=1 Q "White, Hispanic"
I R=6,E=2 Q "White, Non-Hispanic"
I R=7,E=1 Q "More than one race, Hispanic"
I R=7,E=2 Q "More than one race, Non-Hispanic"
I R=8,E=1 Q "Unreported / Refused to Report, Hispanic"
I R=8,E=2 Q "Unreported / Refused to Report, Non-Hispanic"
I R=8,E=3 Q "Unreported / Refused to Report Race and Identity"
Q "UNKNOWN"
;
BUDCRP7I ; IHS/CMI/LAB - UDS REPORT DRIVER TABLE 6B ;
+1 ;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50
+2 ;
+3 ;
S(V) ;
+1 SET BUDDECNT=BUDDECNT+1
+2 SET ^TMP($JOB,"BUDDEL",BUDDECNT)=$GET(V)
+3 QUIT
+4 ;----------
PAUSE ;
+1 KILL DIR
SET DIR(0)="E"
SET DIR("A")="PRESS ENTER"
KILL DA
DO ^DIR
KILL DIR
+2 QUIT
GENI ;EP - general introductions
+1 WRITE !,"NOTE: Patient lists may be hundreds of pages long, depending on the size of your"
+2 WRITE !,"patient population. It is recommended that you run these reports at night and"
+3 WRITE !,"print to an electronic file, not directly to a printer.",!
+4 KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Enter to Continue"
DO ^DIR
KILL DIR
+5 WRITE !!,"This Patient List option documents the individual patients and visits"
+6 WRITE !,"that are counted and summarized on each Table report (main menu"
+7 WRITE !,"option REP). The summary Table report is included at the beginning of each"
+8 WRITE !,"List report."
+9 WRITE !,"UDS searches your database to find all visits and related patients"
+10 WRITE !,"during the time period selected. Based on the UDS definition, to be counted"
+11 WRITE !,"as a patient, the patient must have had at least one visit meeting the "
+12 WRITE !,"following criteria:"
+13 WRITE !?4,"- must be to a location specified in your visit location setup"
+14 WRITE !?4,"- must be to Service Category Ambulatory (A), Hospitalization (H), Day"
+15 WRITE !?6,"Surgery (S), Observation (O), Telemedicine (M), Nursing home visit (R), "
+16 WRITE !?6,"or In-Hospital (I) visit"
+17 WRITE !?4,"- must NOT have an excluded clinic code (see User Manual for a list)"
+18 WRITE !?4,"- must have a primary provider and a coded purpose of visit"
+19 WRITE !?4,"- the patient must NOT have a gender of 'Unknown'"
+20 WRITE !
+21 QUIT
+22 ;
CTR(X,Y) ;EP - Center X in a field Y wide.
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
+2 ;----------
USR() ;EP - Return name of current user from ^VA(200.
+1 QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
+2 ;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
+1 QUIT $SELECT($GET(DUZ(2)):$SELECT($DATA(^DIC(4,DUZ(2),0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
+2 ;----------
PRGH ;EP
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$$CTR($$LOC,80)
+3 WRITE !,$$CTR("UDS 2015",80)
+4 WRITE !!,"Pregnant Patients w/HIV (Table 7, Section A)",!
+5 DO GENI
+6 DO PAUSE
+7 WRITE !!,"This report provides a list of patients that had pregnancy-related visits"
+8 WRITE !,"during the past 20 months, with at least one pregnancy-related visit"
+9 WRITE !,"during the report period, and who have been diagnosed with HIV."
+10 WRITE !
+11 QUIT
PRGHL ;EP
+1 SET BUDP=0
SET BUDQUIT=0
SET BUDTOT=0
+2 DO PRGHH
IF BUDQUIT
QUIT
+3 IF '$DATA(^XTMP("BUDCRP7",BUDJ,BUDH,"PRGH"))
SET X="No patients to report."
IF BUDROT="P"
WRITE !!,X
IF BUDROT="D"
DO S()
DO S(X)
QUIT
+4 DO PRGHL1
+5 IF BUDROT="P"
IF $Y>(IOSL-3)
DO PRGHH
IF BUDQUIT
GOTO PRGHLX
+6 SET X="TOTAL HIV POSITIVE PREGNANT PATIENTS: "_BUDTOT
+7 IF BUDROT="P"
WRITE !!,X,!
+8 IF BUDROT="D"
DO S()
DO S(X)
PRGHLX ;
+1 QUIT
PRGHL1 ;
+1 IF BUDROT="P"
IF $Y>(IOSL-7)
DO PRGHH
IF BUDQUIT
QUIT
+2 SET BUDTOT=0
+3 SET BUDA=0
FOR
SET BUDA=$ORDER(^XTMP("BUDCRP7",BUDJ,BUDH,"PRGH",BUDA))
IF BUDA'=+BUDA!(BUDQUIT)
QUIT
Begin DoDot:1
+4 SET BUDNAME=""
FOR
SET BUDNAME=$ORDER(^XTMP("BUDCRP7",BUDJ,BUDH,"PRGH",BUDA,BUDNAME))
IF BUDNAME=""!(BUDQUIT)
QUIT
Begin DoDot:2
+5 SET BUDCOM=""
FOR
SET BUDCOM=$ORDER(^XTMP("BUDCRP7",BUDJ,BUDH,"PRGH",BUDA,BUDNAME,BUDCOM))
IF BUDCOM=""!(BUDQUIT)
QUIT
Begin DoDot:3
+6 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("BUDCRP7",BUDJ,BUDH,"PRGH",BUDA,BUDNAME,BUDCOM,DFN))
IF DFN'=+DFN!(BUDQUIT)
QUIT
Begin DoDot:4
+7 IF BUDROT="P"
IF $Y>(IOSL-3)
DO PRGHH
IF BUDQUIT
QUIT
+8 SET BUDX=^XTMP("BUDCRP7",BUDJ,BUDH,"PRGH",BUDA,BUDNAME,BUDCOM,DFN)
+9 IF BUDROT="P"
WRITE !,$EXTRACT($PIECE(^DPT(DFN,0),U,1),1,23),?25,$SELECT($$HRN^AUPNPAT(DFN,BUDSITE)]"":$$HRN^AUPNPAT(DFN,BUDSITE,2),1:$$HRN^AUPNPAT(DFN,DUZ(2),2)),?41,$EXTRACT(BUDCOM,1,12),?54,BUDA,?59,$PIECE(BUDX,"@",2),!
+10 SET BUDTOT=BUDTOT+1
+11 SET BUDALL=^XTMP("BUDCRP7",BUDJ,BUDH,"PRGH",BUDA,BUDNAME,BUDCOM,DFN)
+12 SET BUDPPV=$PIECE(BUDALL,"#",1)
+13 SET BUDHIV=$PIECE(BUDALL,"#",2)
+14 SET BUDHIV=$PIECE(BUDHIV,"@",1)
+15 SET BUDPV=""
IF BUDROT="D"
SET BUDPV=$EXTRACT($PIECE(^DPT(DFN,0),U,1),1,30)_U_$SELECT($$HRN^AUPNPAT(DFN,BUDSITE)]"":$$HRN^AUPNPAT(DFN,BUDSITE,2),1:$$HRN^AUPNPAT(DFN,DUZ(2),2))_U_$EXTRACT(BUDCOM,1,12)_U_BUDA_U_$PIECE(BUDX,"@",2)
+16 FOR BUDX=1:1
SET BUDV=$PIECE(BUDPPV,U,BUDX)
IF BUDV=""!(BUDQUIT)
QUIT
Begin DoDot:5
+17 IF BUDROT="P"
IF $Y>(IOSL-3)
DO PRGHH
IF BUDQUIT
QUIT
+18 IF BUDROT="P"
IF $EXTRACT(BUDV)="P"
WRITE ?5,BUDV,!
QUIT
+19 IF BUDROT="D"
SET BUDPV=BUDPV_U_BUDV
DO S(BUDPV)
QUIT
+20 SET V=$PIECE(BUDV,"|")
SET C=$PIECE(BUDV,"|",2)
+21 IF BUDROT="P"
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),!
+22 IF BUDROT="D"
SET X=BUDPV_U_$$FMTE^XLFDT($PIECE($PIECE(^AUPNVSIT(V,0),U),"."))_U_C_U_$$PRIMPROV^APCLV(V,"D")_U_$PIECE(^AUPNVSIT(V,0),U,7)_U_$$CLINIC^APCLV(V,"C")_U_$$VAL^XBDIQ1(9000010,V,.06)
DO S(X)
End DoDot:5
+23 FOR BUDX=1:1
SET BUDV=$PIECE(BUDHIV,U,BUDX)
IF BUDV=""!(BUDQUIT)
QUIT
Begin DoDot:5
+24 IF BUDROT="P"
IF $Y>(IOSL-3)
DO PRGHH
IF BUDQUIT
QUIT
+25 IF BUDROT="P"
IF $EXTRACT(BUDV)="P"
WRITE ?5,BUDV,!
QUIT
+26 IF BUDROT="D"
SET BUDPV=BUDPV_U_BUDV
DO S(BUDPV)
QUIT
+27 SET V=$PIECE(BUDV,"|")
SET C=$PIECE(BUDV,"|",2)
+28 IF BUDROT="P"
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),!
+29 IF BUDROT="D"
SET X=BUDPV_U_$$FMTE^XLFDT($PIECE($PIECE(^AUPNVSIT(V,0),U),"."))_U_C_U_$$PRIMPROV^APCLV(V,"D")_U_$PIECE(^AUPNVSIT(V,0),U,7)_U_$$CLINIC^APCLV(V,"C")_U_$$VAL^XBDIQ1(9000010,V,.06)
DO S(X)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+30 QUIT
PRGHHD ;
+1 DO S()
DO S()
DO S()
+2 DO S("***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****")
+3 DO S($PIECE(^VA(200,DUZ,0),U,2)_" "_$$FMTE^XLFDT(DT))
+4 DO S("*** RPMS Uniform Data System (UDS) ***")
+5 DO S("Patient List for Table 7, HIV Positive Pregnant Women")
+6 DO S($PIECE(^DIC(4,BUDSITE,0),U))
+7 SET X="Reporting Period: "_$$FMTE^XLFDT(BUDBD)_" to "_$$FMTE^XLFDT(BUDED)
DO S(X)
+8 SET X="Population: "_$SELECT($GET(BUDCEN)=1:"Indian/Alaskan Native (Classification 01)",$GET(BUDCEN)=2:"Not Indian Alaskan/Native (Not Classification 01)",$GET(BUDCEN)=3:"All (both Indian/Alaskan Natives and Non 01)",1:"")
DO S(X)
+9 DO S()
+10 DO S("List of all pregnant patients with HIV, with most recent pregnancy")
+11 DO S("related visits during the past 20 months.")
+12 DO S("Age is calculated as of June 30.")
+13 DO S()
+14 DO S("PATIENT NAME^HRN^COMMUNITY^AGE^CD & Date Last HIV DX^VISIT DATE^DX OR SVC CD^PROV TYPE^SVC CAT^CLINIC^LOCATION")
+15 QUIT
PRGHH ;
+1 IF BUDROT="D"
DO PRGHHD
QUIT
+2 IF 'BUDGPG
GOTO PRGHH1
+3 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
PRGHH1 ;
+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, HIV Positive Pregnant Women",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 of all pregnant patients with HIV, with most recent pregnancy"
+11 WRITE !,"related visits during the past 20 months."
+12 WRITE !,"Age is calculated as of June 30."
+13 WRITE !
End DoDot:1
+14 WRITE !,"PATIENT NAME",?25,"HRN",?41,"COMMUNITY",?53,"AGE",?59,"CD & Date Last HIV DX"
+15 WRITE !?5,"VISIT DATE",?19,"DX OR SVC CD",?35,"PROV TYPE",?45,"SVC CAT",?53,"CLINIC",?65,"LOCATION"
+16 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-"),!
+17 SET BUDP=1
+18 QUIT
+19 ;
PRGR ;EP
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$$CTR($$LOC,80)
+3 WRITE !,$$CTR("UDS 2015",80)
+4 WRITE !!,"All Pregnant Patients by Race and Hispanic or Latino Identity",!,"(Table 7, Section A)",!
+5 DO GENI
+6 DO PAUSE
+7 WRITE !!,"This report provides a list by race and Hispanic or Latino Identity"
+8 WRITE !,"of patients that had pregnancy-related visits during the past 20 months,"
+9 WRITE !,"with at least one pregnancy related visit during the report period."
+10 WRITE !
+11 QUIT
PRGRL ;EP
+1 SET BUDP=0
SET BUDQUIT=0
SET BUDTOT=0
+2 DO PRGRH
IF BUDQUIT
QUIT
+3 IF '$DATA(^XTMP("BUDCRP7",BUDJ,BUDH,"PRGR"))
SET X="No patients to report."
IF BUDROT="P"
WRITE !!,X
IF BUDROT="D"
DO S()
DO S(X)
QUIT
+4 DO PRGRL1
+5 IF BUDROT="P"
IF $Y>(IOSL-3)
DO PRGRH
IF BUDQUIT
GOTO PRGRLX
+6 SET X="TOTAL PREGNANT PATIENTS BY HISPANIC OR LATINO IDENTITY AND RACE: "_BUDTOT
+7 IF BUDROT="P"
WRITE !!,X,!
+8 IF BUDROT="D"
DO S()
DO S(X)
PRGRLX ;
+1 QUIT
RACE(R) ;EP
+1 IF R="UNREP/REF"
QUIT "Unreported/Refused to Report"
+2 IF R="ASIAN"
QUIT "Asian"
+3 IF R="NATIVE HAWAIIAN"
QUIT "Native Hawaiian"
+4 IF R="OTH PAC ISLANDER"
QUIT "Other Pacific Islander"
+5 IF R="BLACK"
QUIT "Black/African American"
+6 IF R="AI/AN"
QUIT "American Indian/Alaska Native"
+7 IF R="WHITE"
QUIT "White"
+8 IF R="HISPANIC,WHITE"
QUIT "White"
+9 IF R="HISPANIC,BLACK"
QUIT "Black/African American"
+10 IF R="MORE THAN ONE RACE"
QUIT "More than One Race"
+11 QUIT ""
+12 ;
PRGRL1 ;
+1 IF BUDROT="P"
IF $Y>(IOSL-7)
DO PRGRH
IF BUDQUIT
QUIT
+2 SET BUDTOT=0
+3 SET BUDRACE=""
FOR
SET BUDRACE=$ORDER(^XTMP("BUDCRP7",BUDJ,BUDH,"PRGR",BUDRACE))
IF BUDRACE=""!(BUDQUIT)
QUIT
Begin DoDot:1
+4 SET BUDETH=""
FOR
SET BUDETH=$ORDER(^XTMP("BUDCRP7",BUDJ,BUDH,"PRGR",BUDRACE,BUDETH))
IF BUDETH=""!(BUDQUIT)
QUIT
DO PRGRL2
End DoDot:1
+5 QUIT
PRGRL2 ;
+1 SET BUDSTOT=0
+2 SET BUDRACEL=$$RACEL(BUDRACE,BUDETH)
+3 IF BUDROT="P"
WRITE !,BUDRACEL
+4 IF BUDROT="D"
DO S(BUDRACEL)
+5 SET BUDCOM=""
FOR
SET BUDCOM=$ORDER(^XTMP("BUDCRP7",BUDJ,BUDH,"PRGR",BUDRACE,BUDETH,BUDCOM))
IF BUDCOM=""!(BUDQUIT)
QUIT
Begin DoDot:1
+6 SET BUDA=""
FOR
SET BUDA=$ORDER(^XTMP("BUDCRP7",BUDJ,BUDH,"PRGR",BUDRACE,BUDETH,BUDCOM,BUDA))
IF BUDA=""!(BUDQUIT)
QUIT
Begin DoDot:2
+7 SET BUDNAME=""
FOR
SET BUDNAME=$ORDER(^XTMP("BUDCRP7",BUDJ,BUDH,"PRGR",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME))
IF BUDNAME=""!(BUDQUIT)
QUIT
Begin DoDot:3
+8 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("BUDCRP7",BUDJ,BUDH,"PRGR",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME,DFN))
IF DFN'=+DFN!(BUDQUIT)
QUIT
Begin DoDot:4
+9 IF BUDROT="P"
IF $Y>(IOSL-3)
DO PRGRH
IF BUDQUIT
QUIT
WRITE !,BUDRACEL,!
+10 ;
IF BUDROT="P"
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,BUDA,!
+11 IF BUDROT="D"
SET BUDPV=""
SET BUDPV=$EXTRACT($PIECE(^DPT(DFN,0),U,1),1,30)_U_$SELECT($$HRN^AUPNPAT(DFN,BUDSITE)]"":$$HRN^AUPNPAT(DFN,BUDSITE,2),1:$$HRN^AUPNPAT(DFN,DUZ(2),2))_U_$EXTRACT(BUDCOM,1,12)_U_BUDA
+12 SET BUDTOT=BUDTOT+1
SET BUDSTOT=BUDSTOT+1
+13 SET BUDRACV=$$RACE^BUDCRPTC(DFN)
+14 ;,?60,$E($P($$RACE^BUDCRPTC(DFN),U,3)_"-"_$P($$RACE^BUDCRPTC(DFN),U,4),1,19)
IF BUDROT="P"
WRITE ?2,$EXTRACT($PIECE(BUDRACV,U,4),1,16)_" ("_$PIECE(BUDRACV,U,3),")"
+15 IF BUDROT="D"
SET BUDPV=BUDPV_U_$EXTRACT($PIECE(BUDRACV,U,4),1,16)_" ("_$PIECE(BUDRACV,U,3)_")"
+16 SET BUDHISV=$$HISP^BUDCRPTC(DFN)
+17 IF BUDROT="P"
WRITE ?24,$PIECE(BUDHISV,U,3)," (",$PIECE(BUDHISV,U,2),")",!
+18 IF BUDROT="D"
SET BUDPV=BUDPV_U_$PIECE(BUDHISV,U,3)_" ("_$PIECE(BUDHISV,U,2)_")"
+19 SET BUDALL=^XTMP("BUDCRP7",BUDJ,BUDH,"PRGR",BUDRACE,BUDETH,BUDCOM,BUDA,BUDNAME,DFN)
+20 SET BUDPPV=$PIECE(BUDALL,"#",1)
+21 FOR BUDX=1:1
SET BUDV=$PIECE(BUDPPV,U,BUDX)
IF BUDV=""!(BUDQUIT)
QUIT
Begin DoDot:5
+22 IF BUDROT="P"
IF $Y>(IOSL-3)
DO PRGRH
IF BUDQUIT
QUIT
WRITE !,BUDRACEL,!
+23 IF BUDROT="P"
IF $EXTRACT(BUDV)="P"
WRITE ?5,BUDV,!
QUIT
+24 IF BUDROT="D"
IF $EXTRACT(BUDV)="P"
SET X=BUDPV_U_BUDV
DO S(X)
QUIT
+25 SET V=$PIECE(BUDV,"|")
SET C=$PIECE(BUDV,"|",2)
+26 IF BUDROT="P"
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),!
+27 IF BUDROT="D"
SET X=BUDPV_U_$$FMTE^XLFDT($PIECE($PIECE(^AUPNVSIT(V,0),U),"."))_U_C_U_$$PRIMPROV^APCLV(V,"D")_U_$PIECE(^AUPNVSIT(V,0),U,7)_U_$$CLINIC^APCLV(V,"C")_U_$$VAL^XBDIQ1(9000010,V,.06)
DO S(X)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+28 IF BUDROT="P"
IF $Y>(IOSL-4)
DO PRGRH
IF BUDQUIT
QUIT
WRITE !,BUDRACEL,!
+29 SET X="Sub-Total "_BUDRACEL_": "_BUDSTOT
+30 IF BUDROT="P"
WRITE !,X,!
+31 IF BUDROT="D"
DO S(X)
DO S()
+32 QUIT
PRGRH ;
+1 IF BUDROT="D"
DO PRGRHD
QUIT
+2 IF 'BUDGPG
GOTO PRGRH1
+3 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
PRGRH1 ;
+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 A",80),!,$$CTR("All Pregnant Patients by Race and Hispanic or Latino Identity",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 of all pregnant patients by race and Hispanic or Latino Identity,"
+11 WRITE !,"with most recent pregnancy related visits during the past 20 months."
+12 WRITE !,"Age is calculated as of June 30."
+13 WRITE !,"* E - denotes the value was obtained from the Ethnicity field."
+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,"AGE"
+18 WRITE !?2,"RACE*",?24,"HISPANIC OR LATINO IDENTITY*"
+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
PRGRHD ;
+1 DO S()
DO S()
DO S()
+2 DO S("***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****")
+3 DO S($PIECE(^VA(200,DUZ,0),U,2)_" "_$$FMTE^XLFDT(DT))
+4 DO S("*** RPMS Uniform Data System (UDS) ***")
+5 DO S("Patient List for Table 7, Section A, All Pregnant Patients by Race and Hispanic or Latino Identity")
+6 DO S($PIECE(^DIC(4,BUDSITE,0),U))
+7 SET X="Reporting Period: "_$$FMTE^XLFDT(BUDBD)_" to "_$$FMTE^XLFDT(BUDED)
DO S(X)
+8 SET X="Population: "_$SELECT($GET(BUDCEN)=1:"Indian/Alaskan Native (Classification 01)",$GET(BUDCEN)=2:"Not Indian Alaskan/Native (Not Classification 01)",$GET(BUDCEN)=3:"All (both Indian/Alaskan Natives and Non 01)",1:"")
DO S(X)
+9 DO S()
+10 DO S("List of all pregnant patients by race and Hispanic or Latino Identity,")
+11 DO S("with most recent pregnancy related visits during the past 20 months.")
+12 DO S("Age is calculated as of June 30.")
+13 DO S("* E - denotes the value was obtained from the Ethnicity field.")
+14 DO S(" R - denotes the value was obtained from the Race field")
+15 DO S(" C - denotes the value was obtained from the Classification/Beneficiary field")
+16 DO S()
+17 DO S("PATIENT NAME^HRN^COMMUNITY^AGE^RACE*^HISPANIC OR LATINO IDENTITY^VISIT DATE^DX OR SVC CD^PROV TYPE^SVC CAT^CLINIC^LOCATION")
+18 QUIT
RACEL(R,E) ;EP
+1 IF R=1
IF E=1
QUIT "Asian, Hispanic"
+2 IF R=1
IF E=2
QUIT "Asian, Non-Hispanic"
+3 IF R=2
IF E=1
QUIT "Native Hawaiian, Hispanic"
+4 IF R=2
IF E=2
QUIT "Native Hawaiian, Non-Hispanic"
+5 IF R=3
IF E=1
QUIT "Other Pacific Islander, Hispanic"
+6 IF R=3
IF E=2
QUIT "Other Pacific Islander, Non-Hispanic"
+7 IF R=4
IF E=1
QUIT "Black/African American, Hispanic"
+8 IF R=4
IF E=2
QUIT "Black/African American, Non-Hispanic"
+9 IF R=5
IF E=1
QUIT "American Indian/Alaska Native, Hispanic"
+10 IF R=5
IF E=2
QUIT "American Indian/Alaska Native, Non-Hispanic"
+11 IF R=6
IF E=1
QUIT "White, Hispanic"
+12 IF R=6
IF E=2
QUIT "White, Non-Hispanic"
+13 IF R=7
IF E=1
QUIT "More than one race, Hispanic"
+14 IF R=7
IF E=2
QUIT "More than one race, Non-Hispanic"
+15 IF R=8
IF E=1
QUIT "Unreported / Refused to Report, Hispanic"
+16 IF R=8
IF E=2
QUIT "Unreported / Refused to Report, Non-Hispanic"
+17 IF R=8
IF E=3
QUIT "Unreported / Refused to Report Race and Identity"
+18 QUIT "UNKNOWN"
+19 ;
