BGPAPH ; IHS/CMI/LAB - NO DESCRIPTION PROVIDED ;
;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007
;
;HEADERS FOR REPORTS
CALC(N,O) ;ENTRY POINT
NEW Z
I O=0!(N=0)!(O="")!(N="") Q "**"
NEW X,X2,X3
S X=N,X2=1,X3=0 D COMMA^%DTC S N=X
S X=O,X2=1,X3=0 D COMMA^%DTC S O=X
I +O=0 Q "**"
S Z=(((N-O)/O)*100),Z=$FN(Z,"+,",1)
Q Z
C(X,X2,X3) ;
D COMMA^%DTC
Q X
H2 ;EP
S BGPX="",BGPX=$$C(BGP98N,0,8),$E(BGPX,9)=$J(BGP98P,5,1),$E(BGPX,16)=$$C(BGPPRN,0,8),$E(BGPX,24)=$J(BGPPRP,5,1),$E(BGPX,31)=$$C(BGPCYN,0,8),$E(BGPX,39)=$J(BGPCYP,5,1)
S $E(BGPX,46)=$J($$CALC(BGPCYP,BGP98P),6),$E(BGPX,53)=$J($$CALC(BGPCYP,BGPPRP),6)
W ?22,BGPX
Q
H4 ;
W !,"Age specific Diabetes Prevalence (DM DX in yr prior to end of time frame)",!!,$$CTR(BGPHD1,80),!
W !?40,"Age Distribution"
W !?25,"< 15",?30,"15-19",?37,"20-24",?44,"25-34",?51,"35-44",?58,"45-54",?65,"55-64",?72,">64 yrs",!
Q
H6 ;EP
W !,"Age specific Exercise Education Provided",!!,$$CTR(BGPHD1,80),!
W !?40,"Age Distribution"
W !?25,"0-9",?30,"10-19",?37,"20-24",?44,"25-34",?51,"35-44",?58,"45-54",?65,"55-64",?72,">64 yrs",!
Q
H3 ;EP
W !,"Age specific Diabetes Prevalence (DM Diagnosis ever)",!!,$$CTR(BGPHD1,80),!
W !?40,"Age Distribution"
W !?25,"< 15",?30,"15-19",?37,"20-24",?44,"25-34",?51,"35-44",?58,"45-54",?65,"55-64",?72,">64 yrs",!
Q
H5 ;
W !,"Age specific Tobacco Use Prevalence",!,$$CTR(BGPHD1,80)
W !?40,"Age Distribution"
W !?25,"0-9",?30,"10-19",?37,"20-24",?44,"25-34",?51,"35-44",?58,"45-54",?65,"55-64",?72,">64 yrs"
Q
H1 ;EP
W !?23,"BASE",?31," %",?37,"PREV YR",?45," %",?53,"REPORT",?60," %",?67,"% CHG",?73,"% CHG",!,?23,"PERIOD",?37,"PERIOD",?53,"PERIOD",?68,"BASE",?73,"PREV YR"
Q
G:'BGPGPG HEADER1
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 BGPQUIT=1 Q
W:$D(IOF) @IOF S BGPGPG=BGPGPG+1
W !,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BGPGPG,!
W !,$$CTR("*** IHS GPRA PERFORMANCE INDICATORS ***",80),!
I $G(BGPAREAA) W $S(BGPSUCNT=1:$$CTR(BGPSUNM,80),1:$$CTR("AREA AGGREGATE",80)),!
I '$G(BGPAREAA) W $$CTR($P(^DIC(4,DUZ(2),0),U),80),!
S X="Reporting Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED) W $$CTR(X,80),!
S X="Previous Year Period: "_$$FMTE^XLFDT(BGPPBD)_" to "_$$FMTE^XLFDT(BGPPED) W $$CTR(X,80),!
S X="Baseline Period: "_$$FMTE^XLFDT(BGPBBD)_" to "_$$FMTE^XLFDT(BGPBED) W $$CTR(X,80),!
W $TR($J("",80)," ","-")
Q
AREACP ;EP - area cover page
;
S BGPGPG=0 D HEADER^BGPAPH
W !!?1,"Report includes the following facility data:"
NEW BGPX
S BGPX="" F S BGPX=$O(BGPSUL(BGPX)) Q:BGPX="" D
.I $Y>(IOSL-5) D EOP W:$D(IOF) @IOF
.S X=$P(^BGPD(BGPX,0),U,5),X=$O(^AUTTLOC("C",X,0)) S X=$S(X:$P(^DIC(4,X,0),U),1:"?????")
.W !?3,X
.W !?5,"Communities: " S X=0,N=0,Y="" F S X=$O(^BGPD(BGPX,28,X)) Q:X'=+X S N=N+1,Y=Y_$S(N=1:"",1:";")_$P(^BGPD(BGPX,28,X,0),U)
.S X=0,C=0 F X=1:3:N W !?10,$E($P(Y,";",X),1,20),?30,$E($P(Y,";",(X+1)),1,20),?60,$E($P(Y,";",(X+2)),1,20)
.Q
K BGPX,BGPQUIT
Q
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
EOP ;EP - End of page.
Q:$E(IOST)'="C"
Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
NEW DIR
K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
S DIR(0)="E" D ^DIR
Q
;----------
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")
;----------
BGPAPH ; IHS/CMI/LAB - NO DESCRIPTION PROVIDED ;
+1 ;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007
+2 ;
+3 ;HEADERS FOR REPORTS
CALC(N,O) ;ENTRY POINT
+1 NEW Z
+2 IF O=0!(N=0)!(O="")!(N="")
QUIT "**"
+3 NEW X,X2,X3
+4 SET X=N
SET X2=1
SET X3=0
DO COMMA^%DTC
SET N=X
+5 SET X=O
SET X2=1
SET X3=0
DO COMMA^%DTC
SET O=X
+6 IF +O=0
QUIT "**"
+7 SET Z=(((N-O)/O)*100)
SET Z=$FNUMBER(Z,"+,",1)
+8 QUIT Z
C(X,X2,X3) ;
+1 DO COMMA^%DTC
+2 QUIT X
H2 ;EP
+1 SET BGPX=""
SET BGPX=$$C(BGP98N,0,8)
SET $EXTRACT(BGPX,9)=$JUSTIFY(BGP98P,5,1)
SET $EXTRACT(BGPX,16)=$$C(BGPPRN,0,8)
SET $EXTRACT(BGPX,24)=$JUSTIFY(BGPPRP,5,1)
SET $EXTRACT(BGPX,31)=$$C(BGPCYN,0,8)
SET $EXTRACT(BGPX,39)=$JUSTIFY(BGPCYP,5,1)
+2 SET $EXTRACT(BGPX,46)=$JUSTIFY($$CALC(BGPCYP,BGP98P),6)
SET $EXTRACT(BGPX,53)=$JUSTIFY($$CALC(BGPCYP,BGPPRP),6)
+3 WRITE ?22,BGPX
+4 QUIT
H4 ;
+1 WRITE !,"Age specific Diabetes Prevalence (DM DX in yr prior to end of time frame)",!!,$$CTR(BGPHD1,80),!
+2 WRITE !?40,"Age Distribution"
+3 WRITE !?25,"< 15",?30,"15-19",?37,"20-24",?44,"25-34",?51,"35-44",?58,"45-54",?65,"55-64",?72,">64 yrs",!
+4 QUIT
H6 ;EP
+1 WRITE !,"Age specific Exercise Education Provided",!!,$$CTR(BGPHD1,80),!
+2 WRITE !?40,"Age Distribution"
+3 WRITE !?25,"0-9",?30,"10-19",?37,"20-24",?44,"25-34",?51,"35-44",?58,"45-54",?65,"55-64",?72,">64 yrs",!
+4 QUIT
H3 ;EP
+1 WRITE !,"Age specific Diabetes Prevalence (DM Diagnosis ever)",!!,$$CTR(BGPHD1,80),!
+2 WRITE !?40,"Age Distribution"
+3 WRITE !?25,"< 15",?30,"15-19",?37,"20-24",?44,"25-34",?51,"35-44",?58,"45-54",?65,"55-64",?72,">64 yrs",!
+4 QUIT
H5 ;
+1 WRITE !,"Age specific Tobacco Use Prevalence",!,$$CTR(BGPHD1,80)
+2 WRITE !?40,"Age Distribution"
+3 WRITE !?25,"0-9",?30,"10-19",?37,"20-24",?44,"25-34",?51,"35-44",?58,"45-54",?65,"55-64",?72,">64 yrs"
+4 QUIT
H1 ;EP
+1 WRITE !?23,"BASE",?31," %",?37,"PREV YR",?45," %",?53,"REPORT",?60," %",?67,"% CHG",?73,"% CHG",!,?23,"PERIOD",?37,"PERIOD",?53,"PERIOD",?68,"BASE",?73,"PREV YR"
+2 QUIT
+1 IF 'BGPGPG
GOTO HEADER1
+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 BGPQUIT=1
QUIT
+1 IF $DATA(IOF)
WRITE @IOF
SET BGPGPG=BGPGPG+1
+2 WRITE !,$PIECE(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BGPGPG,!
+3 WRITE !,$$CTR("*** IHS GPRA PERFORMANCE INDICATORS ***",80),!
+4 IF $GET(BGPAREAA)
WRITE $SELECT(BGPSUCNT=1:$$CTR(BGPSUNM,80),1:$$CTR("AREA AGGREGATE",80)),!
+5 IF '$GET(BGPAREAA)
WRITE $$CTR($PIECE(^DIC(4,DUZ(2),0),U),80),!
+6 SET X="Reporting Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED)
WRITE $$CTR(X,80),!
+7 SET X="Previous Year Period: "_$$FMTE^XLFDT(BGPPBD)_" to "_$$FMTE^XLFDT(BGPPED)
WRITE $$CTR(X,80),!
+8 SET X="Baseline Period: "_$$FMTE^XLFDT(BGPBBD)_" to "_$$FMTE^XLFDT(BGPBED)
WRITE $$CTR(X,80),!
+9 WRITE $TRANSLATE($JUSTIFY("",80)," ","-")
+10 QUIT
AREACP ;EP - area cover page
+1 ;
+2 SET BGPGPG=0
DO HEADER^BGPAPH
+3 WRITE !!?1,"Report includes the following facility data:"
+4 NEW BGPX
+5 SET BGPX=""
FOR
SET BGPX=$ORDER(BGPSUL(BGPX))
IF BGPX=""
QUIT
Begin DoDot:1
+6 IF $Y>(IOSL-5)
DO EOP
IF $DATA(IOF)
WRITE @IOF
+7 SET X=$PIECE(^BGPD(BGPX,0),U,5)
SET X=$ORDER(^AUTTLOC("C",X,0))
SET X=$SELECT(X:$PIECE(^DIC(4,X,0),U),1:"?????")
+8 WRITE !?3,X
+9 WRITE !?5,"Communities: "
SET X=0
SET N=0
SET Y=""
FOR
SET X=$ORDER(^BGPD(BGPX,28,X))
IF X'=+X
QUIT
SET N=N+1
SET Y=Y_$SELECT(N=1:"",1:";")_$PIECE(^BGPD(BGPX,28,X,0),U)
+10 SET X=0
SET C=0
FOR X=1:3:N
WRITE !?10,$EXTRACT($PIECE(Y,";",X),1,20),?30,$EXTRACT($PIECE(Y,";",(X+1)),1,20),?60,$EXTRACT($PIECE(Y,";",(X+2)),1,20)
+11 QUIT
End DoDot:1
+12 KILL BGPX,BGPQUIT
+13 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 ;----------
EOP ;EP - End of page.
+1 IF $EXTRACT(IOST)'="C"
QUIT
+2 IF $DATA(ZTQUEUED)!'(IOT="TRM")!$DATA(IO("S"))
QUIT
+3 NEW DIR
+4 KILL DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
+5 SET DIR(0)="E"
DO ^DIR
+6 QUIT
+7 ;----------
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 ;----------
