Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BUDCRP71

BUDCRP71.m

Go to the documentation of this file. 
  1. BUDCRP71 ; IHS/CMI/LAB - UDS REPORT DRIVER TABLE ;
  1.  ;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50
  1.  ;
  1.  ;
  1. PRINT ;EP
  1.  S BUDPG=0
  1.  ;S BUDPREN=1,BUDSITE=2582,BUDBD=3030101,BUDED=3031231
  1.  S BUDQUIT=0
  1.  I BUDROT="D" D  G PL
  1.  .D ^%ZISC ;close printer device
  1.  .K ^TMP($J)
  1.  .S ^TMP($J,"BUDDEL",0)=0
  1.  .S BUDDECNT=0
  1.  S BUDTELB="Hispanic/Latino",BUDTELN=1
  1.  D P71
  1.  Q:BUDQUIT
  1.  S BUDTELB="Non-Hispanic/Latino",BUDTELN=2
  1.  D P71
  1.  Q:BUDQUIT
  1.  ;D R
  1.  W "Unreported/Refused to Report Ethnicity",!
  1.  W $$REPEAT^XLFSTR("_",80),!
  1.  W "h",?5,"|Unreported/" D R1
  1.  W ?5,"| Refused" D R1
  1.  W ?5,"| to Report Race" D R1
  1.  W ?5,"| and Ethnicity" D R1
  1.  D R
  1.  W "i",?5,"| Total" D R1
  1.  D R ;W $$REPEAT^XLFSTR("_",80),!
  1.  Q:BUDQUIT
  1. B7 ;
  1.  S BUDTELB="Hispanic/Latino",BUDTELL=1,BUDTELN=1
  1.  D P7B
  1.  Q:BUDQUIT
  1.  S BUDTELB="Non-Hispanic/Latino",BUDTELL=2,BUDTELN=2
  1.  D P7B
  1.  Q:BUDQUIT
  1.  W "Unreported/Refused to Report Ethnicity",!
  1.  W $$REPEAT^XLFSTR("_",80),!
  1.  W "h",?5,"|Unreported/" D R2B
  1.  W ?5,"| Refused" D R2B
  1.  W ?5,"| to Report Race" D R2B
  1.  W ?5,"| and Ethnicity" S BUDTELL=3,X=1 D R1B
  1.  D RB
  1.  W "i",?5,"| Total" W ?23,"|",?28,$$C($P($G(BUDSECTB(4)),U,1),8),?42,"|",?47,$$C($P($G(BUDSECTB(4)),U,2),8),?61,"|",?66,$$C($P($G(BUDSECTB(4)),U,3),8),!
  1.  D RB ;W $$REPEAT^XLFSTR("_",80),!
  1.  Q:BUDQUIT
  1.  ;section c
  1. C7 ;
  1.  S BUDTELB="Hispanic/Latino",BUDTELL=1,BUDTELN=1
  1.  D P7C
  1.  Q:BUDQUIT
  1.  S BUDTELB="Non-Hispanic/Latino",BUDTELL=2,BUDTELN=2
  1.  D P7C
  1.  Q:BUDQUIT
  1.  W "Unreported/Refused to Report Ethnicity",!
  1.  W $$REPEAT^XLFSTR("_",80),!
  1.  W "h",?5,"|Unreported/" D R2C
  1.  W ?5,"| Refused" D R2C
  1.  W ?5,"| to Report Race" D R2C
  1.  W ?5,"| and Ethnicity" S BUDTELL=3,X=1 D R1C
  1.  D RC
  1.  W "i",?5,"| Total" D
  1.  .W ?23,"|",?24,$$C($P($G(BUDSECTC(4)),U,1),7),?32,"|",?33,$$C($P($G(BUDSECTC(4)),U,2),7),?41,"|",?42,$$C($P($G(BUDSECTC(4)),U,4),7)
  1.  .W ?50,"|",?51,$$C($P($G(BUDSECTC(4)),U,5),7),! ;,?59,"|",?60,$$C($P($G(BUDSECTC(4)),U,6),7),!
  1.  D RC ;W $$REPEAT^XLFSTR("_",80),!
  1.  Q:BUDQUIT
  1. PL D LISTS
  1.  D ^%ZISC
  1.  I BUDROT="D" D SAVEDEL^BUDCRPTD
  1.  K ^XTMP("BUDCRP7",BUDJ,BUDH)
  1.  Q
  1. P71 ;
  1.  D HEADER^BUDCRPTP Q:BUDQUIT  D T7H
  1.  W $$CTR("SECTION A: DELIVERIES AND BIRTH WEIGHT BY RACE AND HISPANIC/LATINO ETHNICITY",80),!
  1.  W $$REPEAT^XLFSTR("_",80),!
  1.  I BUDTELB'="Hispanic/Latino" G P71A
  1.  W !,"0",?5,"HIV Positive Pregnant Women",$$REPEAT^XLFSTR("*",(67-$X)),?67,"|  ",$P($G(BUDSECTH(1)),U,18),!
  1.  W $$REPEAT^XLFSTR("_",80),!
  1.  W "2",?5,"Deliveries Performed by Health Center's Providers",$$REPEAT^XLFSTR("*",(67-$X)),?67,"|",!
  1.  W $$REPEAT^XLFSTR("_",80),!
  1.  ;D R
  1. P71A ;W !!,$$REPEAT^XLFSTR("_",80),!
  1.  W ?5,"|",?23,"|Prenatal Care",?37,"| Live Births:",?51,"| Live Births:",?65,"| Live Births:",!
  1.  W ?5,"|",?23,"| Patients Who",?37,"| <1500 grams",?51,"| 1500-2499",?65,"| =>2500 grams",!
  1.  W "Line",?5,"|  Race and ",?23,"|  Delivered",?37,"|",?51,"| grams",?65,"|",!
  1.  W " #",?5,"|  Ethnicity",?23,"| During the",?37,"|",?51,"|",?65,"|",!
  1.  W ?5,"|",?23,"|   Year",?37,"|",?51,"|",?65,"|",!
  1.  W ?5,"|",?23,"|   (1a)",?37,"|   (1b)",?51,"|   (1c)",?65,"|   (1d)",!
  1.  D R
  1.  W BUDTELB,!
  1.  W $$REPEAT^XLFSTR("_",80),!
  1.  W BUDTELN_"a",?5,"| Asian" D R1
  1.  D R
  1.  W BUDTELN_"b1",?5,"| Native Hawaiian" D R1
  1.  D R
  1.  W BUDTELN_"b2",?5,"| Other Pacific" D R1
  1.  W ?5,"| Islander" D R1
  1.  D R
  1.  W BUDTELN_"c",?5,"| Black/African" D R1
  1.  W ?5,"| American" D R1
  1.  D R
  1.  W BUDTELN_"d",?5,"| American Indian/" D R1
  1.  W ?5,"| Alaska Native" D R1
  1.  D R
  1.  W BUDTELN_"e",?5,"| White" D R1
  1.  D R
  1.  W BUDTELN_"f",?5,"| More than One" D R1
  1.  W ?5,"| Race" D R1
  1.  D R
  1.  W BUDTELN_"g",?5,"| Unreported/" D R1
  1.  W ?5,"| Refused" D R1
  1.  W ?5,"| to Report Race" D R1
  1.  D R
  1.  W ?5,"| Subtotal"
  1.  I BUDTELB["Non" W ?16,"Non-"
  1.  D R1
  1.  W ?5,"| ",$S(BUDTELB["-":$P(BUDTELB,"-",2),1:BUDTELB),?23,"|             |             |             |              ",! I 1
  1.  D R
  1.  Q
  1. R ;EP
  1.  ;W $$REPEAT^XLFSTR("_",80),!
  1.  W "_____|_________________|_____________|_____________|_____________|______________",!
  1.  Q
  1. R1 ;EP
  1.  W ?23,"|",?37,"|",?51,"|",?65,"|",!
  1.  Q
  1. P7B ;
  1.  D HEADER^BUDCRPTP Q:BUDQUIT  D T7H
  1.  W $$CTR("SECTION B:  HYPERTENSION BY RACE AND HISPANIC/LATINO ETHNICITY",80),!
  1.  W $$REPEAT^XLFSTR("_",80),!
  1.  W ?5,"|",?23,"|Total Hypertensive",?42,"| Charts Sampled or",?61,"| Patients with HTN",!
  1.  W " #",?5,"|  Race and ",?23,"|  Patients",?42,"|  EHR Total",?61,"|   Controlled",!
  1.  W ?5,"|  Ethnicity",?23,"|   (2a)",?42,"|   (2b)",?61,"|   (2c)",!
  1.  D RB
  1.  W BUDTELB,!
  1.  W $$REPEAT^XLFSTR("_",80),!
  1.  W BUDTELN_"a",?5,"| Asian" S X=1 D R1B
  1.  D RB
  1.  W BUDTELN_"b1",?5,"| Native Hawaiian" S X=2 D R1B
  1.  D RB
  1.  W BUDTELN_"b2",?5,"| Other Pacific" D R2B
  1.  W ?5,"| American" S X=3 D R1B
  1.  D RB
  1.  W BUDTELN_"c",?5,"| Black/African" D R2B
  1.  W ?5,"| American" S X=4 D R1B
  1.  D RB
  1.  W BUDTELN_"d",?5,"| American Indian/" D R2B
  1.  W ?5,"| Alaska Native" S X=5 D R1B
  1.  D RB
  1.  W BUDTELN_"e",?5,"| White" S X=6 D R1B
  1.  D RB
  1.  W BUDTELN_"f",?5,"| More than One" D R2B
  1.  W ?5,"| Race" S X=7 D R1B
  1.  D RB
  1.  W BUDTELN_"g",?5,"| Unreported/" D R2B
  1.  W ?5,"| Refused" D R2B
  1.  W ?5,"| to Report Race" S X=8 D R1B
  1.  D RB
  1.  W ?5,"| Subtotal"
  1.  I BUDTELB["Non" W ?16,"Non-"
  1.  D R2B
  1.  W ?5,"| ",$S(BUDTELB["-":$P(BUDTELB,"-",2),1:BUDTELB) D
  1.  .W ?23,"|",?28,$$C($P($G(BUDSECTB(BUDTELL)),U,1),8),?42,"|",?47,$$C($P($G(BUDSECTB(BUDTELL)),U,2),8),?61,"|",?66,$$C($P($G(BUDSECTB(BUDTELL)),U,3),8),!
  1.  D RB
  1.  Q
  1. RB ;EP
  1.  ;W $$REPEAT^XLFSTR("_",80),!
  1.  W "_____|_________________|__________________|__________________|__________________",!
  1.  Q
  1. R1B ;EP
  1.  W ?23,"|",?28,$$C($P($G(BUDSECTB(BUDTELL,X)),U,1),8),?42,"|",?47,$$C($P($G(BUDSECTB(BUDTELL,X)),U,2),8),?61,"|",?66,$$C($P($G(BUDSECTB(BUDTELL,X)),U,3),8),!
  1.  Q
  1. R2B ;EP
  1.  W ?23,"|",?42,"|",?61,"|",!
  1.  Q
  1. P7C ;
  1.  D HEADER^BUDCRPTP Q:BUDQUIT  D T7H
  1.  W $$CTR("SECTION C:  DIABETES BY RACE AND HISPANIC/LATINO ETHNCITY",80),!
  1.  W $$REPEAT^XLFSTR("_",72),!
  1.  W ?5,"|",?23,"| Total",?32,"| Charts",?41,"|Patients",?50,"|Patients",!
  1.  W " #",?5,"|  Race and ",?23,"|Patients",?32,"|Sampled",?41,"| with",?50,"| with",!
  1.  W ?5,"|  Ethnicity",?23,"| with",?32,"| or EHR",?41,"| Hba1c",?50,"| Hba1c",!
  1.  W ?5,"|",?23,"|Diabetes",?32,"| Total",?41,"| <8%",?50,"|>9% Or No",!
  1.  W ?5,"|",?23,"|",?32,"|",?41,"|  ",?50,"| Test",!
  1.  W ?5,"|",?23,"|",?32,"|",?41,"|",?50,"|During Year",!
  1.  W ?5,"|",?23,"|  (3a)",?32,"|  (3b)",?41,"| (3d1)",?50,"|  (3f)",!
  1.  D RC
  1.  W BUDTELB,!
  1.  W $$REPEAT^XLFSTR("_",72),!
  1.  W BUDTELN_"a",?5,"| Asian" S X=1 D R1C
  1.  D RC
  1.  W BUDTELN_"b1",?5,"| Native Hawaiian" S X=2 D R1C
  1.  D RC
  1.  W BUDTELN_"b2",?5,"| Other Pacific" D R2C
  1.  W ?5,"| Islander" S X=3 D R1C
  1.  D RC
  1.  W BUDTELN_"c",?5,"| Black/African" D R2C
  1.  W ?5,"| American" S X=4 D R1C
  1.  D RC
  1.  W BUDTELN_"d",?5,"| American Indian/" D R2C
  1.  W ?5,"| Alaska Native" S X=5 D R1C
  1.  D RC
  1.  W BUDTELN_"e",?5,"| White" S X=6 D R1C
  1.  D RC
  1.  W BUDTELN_"f",?5,"| More than One" D R2C
  1.  W ?5,"| Race" S X=7 D R1C
  1.  D RC
  1.  W BUDTELN_"g",?5,"| Unreported/" D R2C
  1.  W ?5,"| Refused" D R2C
  1.  W ?5,"| to Report Race" S X=8 D R1C
  1.  D RC
  1.  W ?5,"| Subtotal"
  1.  I BUDTELB["Non" W ?16,"Non-"
  1.  D R2C
  1.  W ?5,"| ",$S(BUDTELB["-":$P(BUDTELB,"-",2),1:BUDTELB) D
  1.  .W ?23,"|",?24,$$C($P($G(BUDSECTC(BUDTELL)),U,1),7),?32,"|",?33,$$C($P($G(BUDSECTC(BUDTELL)),U,2),7),?41,"|",?42,$$C($P($G(BUDSECTC(BUDTELL)),U,4),7)
  1.  .W ?50,"|",?51,$$C($P($G(BUDSECTC(BUDTELL)),U,5),7),!
  1.  D RC
  1.  Q
  1. RC ;EP
  1.  ;W $$REPEAT^XLFSTR("_",80),!
  1.  W "_____|_________________|________|________|________|____________________",!
  1.  Q
  1. R1C ;EP
  1.  W ?23,"|",?24,$$C($P($G(BUDSECTC(BUDTELL,X)),U,1),7),?32,"|",?33,$$C($P($G(BUDSECTC(BUDTELL,X)),U,2),7),?41,"|",?42,$$C($P($G(BUDSECTC(BUDTELL,X)),U,4),7)
  1.  W ?50,"|",?51,$$C($P($G(BUDSECTC(BUDTELL,X)),U,5),7),!
  1.  Q
  1. R2C ;EP
  1.  W ?23,"|",?32,"|",?41,"|",?50,"|",!
  1.  Q
  1. LISTS ;
  1.  I $G(BUDPRGHL) S BUDGPG=0 D PRGHL^BUDCRP7I
  1.  I $G(BUDPRGRL) S BUDGPG=0 D PRGRL^BUDCRP7I
  1.  I $G(BUDHTRL) S BUDGPG=0 D HTRL^BUDCRP7J
  1.  I $G(BUDHTCRL) S BUDGPG=0 D HTCRL^BUDCRP7J
  1.  I $G(BUDHTURL) S BUDGPG=0 D HTURL^BUDCRP7U
  1.  I $G(BUDDMRL) S BUDGPG=0 D DMRL^BUDCRP7L
  1.  I $G(BUDDMR1L) S BUDGPG=0 D DMR1L^BUDCRP7L
  1.  I $G(BUDDMR2L) S BUDGPG=0 D DMR2L^BUDCRP7T
  1.  K ^XTMP("BUDCRP7",BUDJ,BUDH)
  1.  Q
  1.  ;
  1.  ;
  1. T7H ;EP
  1.  W !,$$CTR("TABLE 7 - HEALTH OUTCOMES AND DISPARITIES"),!  ;$$REPEAT^XLFSTR("_",80),!  ;,!?41,"HISPANIC/LATINO (1)",!
  1.  Q
  1. CTR(X,Y) ;EP - Center X in a field Y wide.
  1.  Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
  1.  ;----------
  1. USR() ;EP - Return name of current user from ^VA(200.
  1.  Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
  1.  ;----------
  1. LOC() ;EP - Return location name from file 4 based on DUZ(2).
  1.  Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
  1.  ;----------
  1. PAUSE ;
  1.  K DIR S DIR(0)="E",DIR("A")="PRESS ENTER" KILL DA D ^DIR KILL DIR
  1.  Q
  1. C(X,Y) ;
  1.  I $G(Y)=1,+X=0 Q ""
  1.  I $G(Y)=2 Q "********"
  1.  S X2=0,X3=8
  1.  D COMMA^%DTC
  1.  Q X
  1. LINE1 ;EP
  1.  W $$REPEAT^XLFSTR("_",29),?29,"|",$$REPEAT^XLFSTR("_",9),?39,"|",$$REPEAT^XLFSTR("_",9),?49,"|",$$REPEAT^XLFSTR("_",9),?50,"|",$$REPEAT^XLFSTR("_",9),?59,"|",!  ;$$REPEAT^XLFSTR("_",9),?79,"|",!
  1.  Q
  1. T7H1 ;EP
  1.  W !,$$CTR("TABLE 7 - HEALTH OUTCOMES AND DISPARITIES",60),!,$$REPEAT^XLFSTR("_",69),!  ;,!?41,"HISPANIC/LATINO",!
  1.  Q
  1. LINE4 ;EP
  1.  W $$REPEAT^XLFSTR("_",69),?59,"|",!
  1.  Q
  1. LINE5 ;EP
  1.  W $$REPEAT^XLFSTR("_",29),?29,"|",$$REPEAT^XLFSTR("_",9),?39,"|",$$REPEAT^XLFSTR("_",9),?49,"|",$$REPEAT^XLFSTR("_",9),?50,"|",$$REPEAT^XLFSTR("_",9),?59,"|",! ;,$$REPEAT^XLFSTR("_",9),?79,"|",!
  1.  Q
  1. LINE ;EP
  1.  W $$REPEAT^XLFSTR("_",69),?59,"|",!
  1.  Q