- BGPDPH ; 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 ;EP
- 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^BGPDPH
- 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")
- ;----------
- BGPDPH ; 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 ;EP
- +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^BGPDPH
- +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 ;----------