BGP4PDLZ ; IHS/CMI/LAB - ;
;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007
;
;
START ;
I BGPRTYPE=3 Q
I BGPRTYPE=4 Q
S BGPQUIT="",BGPGPG=0
D HEADER
S BGPC=0 F S BGPC=$O(^TMP($J,"SUMMARY",BGPC)) Q:BGPC'=+BGPC!(BGPQUIT) D
.I $Y>(IOSL-3) D HEADER Q:BGPQUIT
.S X=" " D S(X,1,1)
.I BGPC=1 S X="DIABETES" D S(X,1,1)
.I BGPC=2 S X="DENTAL" D S(X,1,1)
.I BGPC=3 S X="IMMUNIZATIONS" D S(X,1,1)
.I BGPC=4 S X="PREVENTION" D S(X,1,1)
.I BGPC=5 S X="PUBLIC HEALTH NURSING" D S(X,1,1)
.S BGPO="" F S BGPO=$O(^TMP($J,"SUMMARY",BGPC,BGPO)) Q:BGPO=""!(BGPQUIT) D
..S BGPPC=$O(^TMP($J,"SUMMARY",BGPC,BGPO,0))
..I BGPRTYPE=1,$P(^BGPINDFC(BGPPC,0),U,5)'=1 Q ;gpra and not gpra item
..I BGPRTYPE=2,$P(^BGPINDFC(BGPPC,0),U,6)'=1 Q
..S X="",X=$P(^BGPINDFC(BGPPC,14),U,4),$E(X,27)=$J($P(^TMP($J,"SUMMARY",BGPC,BGPO,BGPPC),U),7,1)_"%",$E(X,37)=$J($P(^TMP($J,"SUMMARY",BGPC,BGPO,BGPPC),U,2),7,1)_"%",$E(X,48)=$J($P(^TMP($J,"SUMMARY",BGPC,BGPO,BGPPC),U,3),7,1)_"%"
..S $E(X,60)=$P(^BGPINDFC(BGPPC,14),U,2),$E(X,71)=$P(^BGPINDFC(BGPPC,14),U,3) D S(X,1,1)
Q
;
D HEADER^BGP4PDL
D H1
Q
H1 ;
I BGPRTYPE=1 S X="GPRA PERFORMANCE SUMMARY PAGE" D S(X,1,1)
I BGPRTYPE=2 S X="CLINICAL PERFORMANCE SUMMARY PAGE" D S(X,1,1)
S X="",$E(X,27)=" Site",$E(X,37)=" Site",$E(X,48)=" Site",$E(X,60)="National",$E(X,71)="National" D S(X,1,1)
S X="",$E(X,27)="Current",$E(X,37)="Previous",$E(X,48)="Baseline",$E(X,60)="Current",$E(X,71)="Previous"
S X=$TR($J("",80)," ","-") D S(X,1,1)
Q
S(Y,F,P) ;set up array
I '$G(F) S F=0
S %=$P(^TMP($J,"BGPDEL",0),U)+F,$P(^TMP($J,"BGPDEL",0),U)=%
I '$D(^TMP($J,"BGPDEL",%)) S ^TMP($J,"BGPDEL",%)=""
S $P(^TMP($J,"BGPDEL",%),U,P)=Y
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")
;----------
BGP4PDLZ ; IHS/CMI/LAB - ;
+1 ;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007
+2 ;
+3 ;
START ;
+1 IF BGPRTYPE=3
QUIT
+2 IF BGPRTYPE=4
QUIT
+3 SET BGPQUIT=""
SET BGPGPG=0
+4 DO HEADER
+5 SET BGPC=0
FOR
SET BGPC=$ORDER(^TMP($JOB,"SUMMARY",BGPC))
IF BGPC'=+BGPC!(BGPQUIT)
QUIT
Begin DoDot:1
+6 IF $Y>(IOSL-3)
DO HEADER
IF BGPQUIT
QUIT
+7 SET X=" "
DO S(X,1,1)
+8 IF BGPC=1
SET X="DIABETES"
DO S(X,1,1)
+9 IF BGPC=2
SET X="DENTAL"
DO S(X,1,1)
+10 IF BGPC=3
SET X="IMMUNIZATIONS"
DO S(X,1,1)
+11 IF BGPC=4
SET X="PREVENTION"
DO S(X,1,1)
+12 IF BGPC=5
SET X="PUBLIC HEALTH NURSING"
DO S(X,1,1)
+13 SET BGPO=""
FOR
SET BGPO=$ORDER(^TMP($JOB,"SUMMARY",BGPC,BGPO))
IF BGPO=""!(BGPQUIT)
QUIT
Begin DoDot:2
+14 SET BGPPC=$ORDER(^TMP($JOB,"SUMMARY",BGPC,BGPO,0))
+15 ;gpra and not gpra item
IF BGPRTYPE=1
IF $PIECE(^BGPINDFC(BGPPC,0),U,5)'=1
QUIT
+16 IF BGPRTYPE=2
IF $PIECE(^BGPINDFC(BGPPC,0),U,6)'=1
QUIT
+17 SET X=""
SET X=$PIECE(^BGPINDFC(BGPPC,14),U,4)
SET $EXTRACT(X,27)=$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY",BGPC,BGPO,BGPPC),U),7,1)_"%"
SET $EXTRACT(X,37)=$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY",BGPC,BGPO,BGPPC),U,2),7,1)_"%"
SET $EXTRACT(X,48)=$JUSTIFY($PIECE(^TMP($JOB,"SUMMARY",BGPC,BGPO,BGPPC),U,3),7,1)_"%"
+18 SET $EXTRACT(X,60)=$PIECE(^BGPINDFC(BGPPC,14),U,2)
SET $EXTRACT(X,71)=$PIECE(^BGPINDFC(BGPPC,14),U,3)
DO S(X,1,1)
End DoDot:2
End DoDot:1
+19 QUIT
+20 ;
+1 DO HEADER^BGP4PDL
+2 DO H1
+3 QUIT
H1 ;
+1 IF BGPRTYPE=1
SET X="GPRA PERFORMANCE SUMMARY PAGE"
DO S(X,1,1)
+2 IF BGPRTYPE=2
SET X="CLINICAL PERFORMANCE SUMMARY PAGE"
DO S(X,1,1)
+3 SET X=""
SET $EXTRACT(X,27)=" Site"
SET $EXTRACT(X,37)=" Site"
SET $EXTRACT(X,48)=" Site"
SET $EXTRACT(X,60)="National"
SET $EXTRACT(X,71)="National"
DO S(X,1,1)
+4 SET X=""
SET $EXTRACT(X,27)="Current"
SET $EXTRACT(X,37)="Previous"
SET $EXTRACT(X,48)="Baseline"
SET $EXTRACT(X,60)="Current"
SET $EXTRACT(X,71)="Previous"
+5 SET X=$TRANSLATE($JUSTIFY("",80)," ","-")
DO S(X,1,1)
+6 QUIT
S(Y,F,P) ;set up array
+1 IF '$GET(F)
SET F=0
+2 SET %=$PIECE(^TMP($JOB,"BGPDEL",0),U)+F
SET $PIECE(^TMP($JOB,"BGPDEL",0),U)=%
+3 IF '$DATA(^TMP($JOB,"BGPDEL",%))
SET ^TMP($JOB,"BGPDEL",%)=""
+4 SET $PIECE(^TMP($JOB,"BGPDEL",%),U,P)=Y
+5 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 ;----------
