- 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 ;----------
