BIREPD3 ;IHS/CMI/MWR - REPORT, ADOLESCENT RATES; MAY 10, 2010
;;8.5;IMMUNIZATION;**5**;JUL 01,2013
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; VIEW ADOLESCENT IMMUNIZATION RATES REPORT.
;; PATCH 3: Include new "1-Td 1-Men 3-HPV" lines. VCOMB+14
;; PATCH 5: Correct Male HPV percentage denominator. VGRP+60
;
;
;----------
GETDATA(BICC,BIHCF,BICM,BIBEN,BIQDT,BIDAR,BIAGRPS,BISITE,BIUP,BITMP,BIERR) ;EP
;---> Gather Immunization History data on selected patients.
;---> Parameters:
; 1 - BICC (req) Current Community array.
; 2 - BIHCF (req) Health Care Facility array.
; 3 - BICM (req) Case Manager array.
; 4 - BIBEN (req) Beneficiary Type array.
; 5 - BIQDT (req) Quarter Ending Date.
; 6 - BIDAR (opt) Adolescent Age Range: "11-18^1" (years).
; 7 - BIAGRPS (req) String of Age Groups ("1112,1313,1317").
; 8 - BISITE (req) Site IEN.
; 9 - BIUP (req) User Population/Group (All, Imm, User, Active).
; 10 - BITMP (ret) Stores Patient Totals by Age Group and Sex.
; 11 - BIERR (ret) Error.
;
S:'$G(BISITE) BISITE=$G(DUZ(2)) I '$G(BISITE) S BIERR=109 Q
S:'$G(BIQDT) BIQDT=DT
S:'$D(BIDAR) BIDAR="11-18^1"
S:$G(BIUP)="" BIUP="u"
;
;---> Get Begin and End Dates (DOB's).
D AGEDATE^BIAGE(BIDAR,BIQDT,.BIBEGDT,.BIENDDT,.BIERR)
Q:$G(BIERR)]""
;
;---> Gather and sort patients.
D GETPATS^BIREPD4(BIBEGDT,BIENDDT,.BICC,.BIHCF,.BICM,.BIBEN,BIQDT,BIAGRPS,BISITE,BIUP,.BITMP)
Q
;
; Call from BIREPD2: F BIVGRP=4,6,7,8,9,16,10,17 D VGRP^BIREPD3(.BILINE,BIVGRP,BIAGRPS,BISEX,.BIERR)
;
;----------
VGRP(BILINE,BIVGRP,BIAGRPS,BITMP,BISEX,BIERR) ;EP
;---> Write Stats lines for each Vaccine Group.
;---> Parameters:
; 1 - BILINE (req) Line number in ^TMP Listman array.
; 2 - BIVGRP (req) IEN of Vaccine Group.
; 3 - BIAGRPS (req) String of Age Groups ("1112,1313,1317").
; 4 - BITMP (req) Stores Patient Totals by Age Group and Sex.
; 5 - BISEX (opt) F or M for HPV.
; 6 - BIERR (ret) Error.
;
I '$G(BIVGRP) D ERRCD^BIUTL2(510,.BIERR) Q
I '$G(BIAGRPS) D ERRCD^BIUTL2(677,.BIERR) Q
;
;---> Write two lines for each Dose of this Vaccine Group.
N BIDOSE,BIMAXD S BIMAXD=$$VGROUP^BIUTL2(BIVGRP,7)
;
;---> Include exception here for Tdap.
I ((BIVGRP=132)!(BIVGRP=221)) S BIMAXD=1
;
F BIDOSE=1:1:BIMAXD D
.;---> BIX=text of the line to write.
.;
.;---> First, write the Dose#-Vaccine Group in left margin.
.N BIX D
..;---> Include exception here for Tdap.
..I BIVGRP=132 S BIX=" Hx of Chickenpox" Q
..I BIVGRP=221 S BIX=" 1-Tdap" Q
..I BIVGRP=8 S BIX=" 1-Tdap/Td" Q
..S BIX=" "_BIDOSE_"-"_$$VGROUP^BIUTL2(BIVGRP,5)
.;
.S BIX=$$PAD^BIUTL5(BIX,17)_"|"
.;
.;---> Write actual totals line for this dose for each Age Group
.;---> (loop through the age groups, concating the totals horizontally).
.N BIAGRP,K
.F K=1:1 S BIAGRP=$P(BIAGRPS,",",K) Q:'BIAGRP D
..N Y D
...;---> If HPV (17), append sex to age group to retrieve HPV stats.
...I BIVGRP=17 S Y=+$G(BITMP("STATS",BIVGRP,BIDOSE,BIAGRP_BISEX)) Q
...S Y=+$G(BITMP("STATS",BIVGRP,BIDOSE,BIAGRP))
..;
..S BIX=BIX_$J(Y,12)_" "
.D WRITE(.BILINE,BIX)
.D MARK^BIW(BILINE,3,"BIREPD1")
.;
.;
.;---> Now write Percentages line for each Age Group (under the actual totals).
.S BIX="" S:BIVGRP=132 BIX=" (Immune)"
.S BIX=$$PAD^BIUTL5(BIX,17)_"|"
.F K=1:1 S BIAGRP=$P(BIAGRPS,",",K) Q:'BIAGRP D
..;N Y S Y=$G(BITMP("STATS",BIVGRP,BIDOSE,BIAGRP))
..N Y D
...;---> If HPV (17), append sex to age group to retrieve HPV stats.
...I BIVGRP=17 S Y=+$G(BITMP("STATS",BIVGRP,BIDOSE,BIAGRP_BISEX)) Q
...S Y=+$G(BITMP("STATS",BIVGRP,BIDOSE,BIAGRP))
..;
..I 'Y S BIX=BIX_$J("",12)_" " Q
..;
..;---> If Vaccine Group is HPV-17, use female denominators.
..;
..;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
..;---> Correct Male HPV percentage denominator.
..;N Z S Z=$G(BITMP("STATS",$S(BIVGRP=17:"TOTLFPTS",1:"TOTLPTS"),BIAGRP))
..;
..N BIDENOM D
...I (BIVGRP=17)&($G(BISEX)="F") S BIDENOM="TOTLFPTS" Q
...I (BIVGRP=17)&($G(BISEX)="M") S BIDENOM="TOTLMPTS" Q
...S BIDENOM="TOTLPTS" Q
..N Z S Z=$G(BITMP("STATS",BIDENOM,BIAGRP))
..;**********
..;
..;---> To avoid bomb if Z=0/null.
..S:'Z Y=0,Z=1 S Y=(Y*100)/Z
..S BIX=BIX_$J(Y,12,0)_"%"
..;S BIX=BIX_$J(Y,$S(K=1:9,1:12),0)_"%"
.D WRITE(.BILINE,BIX)
.Q:BIDOSE=BIMAXD
.;
.;---> Write a dashed line to close off this Dose.
.S BIX=$$SP^BIUTL5(17)_"|"_$$SP^BIUTL5(62,"-")
.D WRITE(.BILINE,BIX)
;
;---> Write a final dashed line to close off this Vaccine Group (unless Tdap).
D
.I BIVGRP=221 S BIX=$$SP^BIUTL5(17)_"|"_$$SP^BIUTL5(62,"-") Q
.S BIX=$$SP^BIUTL5(79,"-")
D WRITE(.BILINE,BIX)
Q
;
;
;----------
VCOMB(BILINE,BICOMB,BIAGRPS,BITMP,BISEX,BIERR) ;EP
;---> Write Stats lines for each Vaccine Combination.
;---> Parameters:
; 1 - BILINE (req) Line number in ^TMP Listman array.
; 2 - BICOMB (req) Numeric code of Vaccine Combination.
; 3 - BIAGRPS (req) String of Age Groups ("1112,1313,1317").
; 4 - BITMP (ret) Stores Patient Totals by Age Group and Sex.
; 5 - BISEX (opt) F or M for HPV, or B (for "both").
; 6 - BIERR (ret) Error.
;
I '$G(BIAGRPS) D ERRCD^BIUTL2(677,.BIERR) Q
;
;---> Build the left-most cell that lists the vaccines for this combo.
;
;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR
;---> Include new "1-Td 1-Men 3-HPV" lines for both sexes combined.
N BIX,I,Q,X S Q=0 S:$G(BISEX)="" BISEX=""
F I=1:1:4 S BIX(I)=""
F I=1:1 S X=$P(BICOMB,U,I) Q:Q D
.;I ((X="")&(BICOMB'[17)) S Q=1 Q
.I ((X="")&((BICOMB'[17)!(BISEX="B"))) S Q=1 Q
.;**********
.S:(X="") X=$S(BISEX="F":"(females)",BISEX="M":"(males)",1:"???"),Q=1
.S:'Q X=$P(X,"|",2)_"-"_$$VGROUP^BIUTL2($P(X,"|"),5)
.I I<3 S BIX(1)=BIX(1)_" "_X Q
.I I<5 S BIX(2)=BIX(2)_" "_X Q
.I I<7 S BIX(3)=BIX(3)_" "_X Q
.S BIX(4)=BIX(4)_" "_X
;
;---> Write actual totals line for this Combo for each Age Group
;---> (loop through the Age Groups.
S BIX=BIX(1),BIX=$$PAD^BIUTL5(BIX,17)_"|"
N BIAGRP,K
F K=1:1 S BIAGRP=$P(BIAGRPS,",",K) Q:'BIAGRP D
.N Y D
..;---> If HPV (17), append sex to age group to retrieve HPV stats.
..I $G(BISEX)="F" S Y=+$G(BITMP("STATS",BICOMB,BIAGRP_"F")) Q
..I $G(BISEX)="M" S Y=+$G(BITMP("STATS",BICOMB,BIAGRP_"M")) Q
..S Y=+$G(BITMP("STATS",BICOMB,BIAGRP))
.;
.S BIX=BIX_$J(Y,12)_" "
D WRITE(.BILINE,BIX)
S I=3 S:BIX(3)]"" I=4 S:BIX(4)]"" I=5
D MARK^BIW(BILINE,I,"BIREPD1")
;
;---> Now write percentages line.
S BIX=BIX(2),BIX=$$PAD^BIUTL5(BIX,17)_"|"
F K=1:1 S BIAGRP=$P(BIAGRPS,",",K) Q:'BIAGRP D
.N Y D
..;---> If HPV (17), append sex to age group to retrieve HPV stats.
..I $G(BISEX)="F" S Y=$G(BITMP("STATS",BICOMB,BIAGRP_"F")) Q
..I $G(BISEX)="M" S Y=$G(BITMP("STATS",BICOMB,BIAGRP_"M")) Q
..S Y=$G(BITMP("STATS",BICOMB,BIAGRP))
.;
.I 'Y S BIX=BIX_$J("",12)_" " Q
.I '$G(BITMP("STATS","TOTLPTS")) S BIX=BIX_$J(Y,7)_" " Q
.;
.;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR
.;---> Use denominators for Both, Female, and Male.
.;N Z S Z=$G(BITMP("STATS",$S(BICOMB[17:"TOTLFPTS",1:"TOTLPTS"),BIAGRP))
.N Z D
..;---> If HPV (17), append sex to age group to retrieve denominator.
..I $G(BISEX)="F" S Z=$G(BITMP("STATS","TOTLFPTS",BIAGRP)) Q
..I $G(BISEX)="M" S Z=$G(BITMP("STATS","TOTLMPTS",BIAGRP)) Q
..S Z=$G(BITMP("STATS","TOTLPTS",BIAGRP))
.;**********
.;
.;---> To avoid bomb if Z=0/null.
.S:'Z Y=0,Z=1 S Y=(Y*100)/Z
.S BIX=BIX_$J(Y,12,0)_"%"
.;S BIX=BIX_$J(Y,$S(K=1:9,1:12),0)_"%"
D WRITE(.BILINE,BIX)
;
F I=3,4 D:BIX(I)]""
.S BIX=BIX(I),BIX=$$PAD^BIUTL5(BIX,17)_"|"
.D WRITE(.BILINE,BIX)
;
D WRITE(.BILINE,$$SP^BIUTL5(79,"-"))
Q
;
;
;----------
WRITE(BILINE,BIVAL,BIBLNK) ;EP
;---> Write lines to ^TMP (see documentation in ^BIW).
;---> Parameters:
; 1 - BILINE (ret) Last line# written.
; 2 - BIVAL (opt) Value/text of line (Null=blank line).
;
Q:'$D(BILINE)
D WL^BIW(.BILINE,"BIREPD1",$G(BIVAL),$G(BIBLNK))
;
;--->Set VALMCNT (Listman line count) for errors calls above.
S VALMCNT=BILINE
Q
BIREPD3 ;IHS/CMI/MWR - REPORT, ADOLESCENT RATES; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;**5**;JUL 01,2013
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; VIEW ADOLESCENT IMMUNIZATION RATES REPORT.
+4 ;; PATCH 3: Include new "1-Td 1-Men 3-HPV" lines. VCOMB+14
+5 ;; PATCH 5: Correct Male HPV percentage denominator. VGRP+60
+6 ;
+7 ;
+8 ;----------
GETDATA(BICC,BIHCF,BICM,BIBEN,BIQDT,BIDAR,BIAGRPS,BISITE,BIUP,BITMP,BIERR) ;EP
+1 ;---> Gather Immunization History data on selected patients.
+2 ;---> Parameters:
+3 ; 1 - BICC (req) Current Community array.
+4 ; 2 - BIHCF (req) Health Care Facility array.
+5 ; 3 - BICM (req) Case Manager array.
+6 ; 4 - BIBEN (req) Beneficiary Type array.
+7 ; 5 - BIQDT (req) Quarter Ending Date.
+8 ; 6 - BIDAR (opt) Adolescent Age Range: "11-18^1" (years).
+9 ; 7 - BIAGRPS (req) String of Age Groups ("1112,1313,1317").
+10 ; 8 - BISITE (req) Site IEN.
+11 ; 9 - BIUP (req) User Population/Group (All, Imm, User, Active).
+12 ; 10 - BITMP (ret) Stores Patient Totals by Age Group and Sex.
+13 ; 11 - BIERR (ret) Error.
+14 ;
+15 IF '$GET(BISITE)
SET BISITE=$GET(DUZ(2))
IF '$GET(BISITE)
SET BIERR=109
QUIT
+16 IF '$GET(BIQDT)
SET BIQDT=DT
+17 IF '$DATA(BIDAR)
SET BIDAR="11-18^1"
+18 IF $GET(BIUP)=""
SET BIUP="u"
+19 ;
+20 ;---> Get Begin and End Dates (DOB's).
+21 DO AGEDATE^BIAGE(BIDAR,BIQDT,.BIBEGDT,.BIENDDT,.BIERR)
+22 IF $GET(BIERR)]""
QUIT
+23 ;
+24 ;---> Gather and sort patients.
+25 DO GETPATS^BIREPD4(BIBEGDT,BIENDDT,.BICC,.BIHCF,.BICM,.BIBEN,BIQDT,BIAGRPS,BISITE,BIUP,.BITMP)
+26 QUIT
+27 ;
+28 ; Call from BIREPD2: F BIVGRP=4,6,7,8,9,16,10,17 D VGRP^BIREPD3(.BILINE,BIVGRP,BIAGRPS,BISEX,.BIERR)
+29 ;
+30 ;----------
VGRP(BILINE,BIVGRP,BIAGRPS,BITMP,BISEX,BIERR) ;EP
+1 ;---> Write Stats lines for each Vaccine Group.
+2 ;---> Parameters:
+3 ; 1 - BILINE (req) Line number in ^TMP Listman array.
+4 ; 2 - BIVGRP (req) IEN of Vaccine Group.
+5 ; 3 - BIAGRPS (req) String of Age Groups ("1112,1313,1317").
+6 ; 4 - BITMP (req) Stores Patient Totals by Age Group and Sex.
+7 ; 5 - BISEX (opt) F or M for HPV.
+8 ; 6 - BIERR (ret) Error.
+9 ;
+10 IF '$GET(BIVGRP)
DO ERRCD^BIUTL2(510,.BIERR)
QUIT
+11 IF '$GET(BIAGRPS)
DO ERRCD^BIUTL2(677,.BIERR)
QUIT
+12 ;
+13 ;---> Write two lines for each Dose of this Vaccine Group.
+14 NEW BIDOSE,BIMAXD
SET BIMAXD=$$VGROUP^BIUTL2(BIVGRP,7)
+15 ;
+16 ;---> Include exception here for Tdap.
+17 IF ((BIVGRP=132)!(BIVGRP=221))
SET BIMAXD=1
+18 ;
+19 FOR BIDOSE=1:1:BIMAXD
Begin DoDot:1
+20 ;---> BIX=text of the line to write.
+21 ;
+22 ;---> First, write the Dose#-Vaccine Group in left margin.
+23 NEW BIX
Begin DoDot:2
+24 ;---> Include exception here for Tdap.
+25 IF BIVGRP=132
SET BIX=" Hx of Chickenpox"
QUIT
+26 IF BIVGRP=221
SET BIX=" 1-Tdap"
QUIT
+27 IF BIVGRP=8
SET BIX=" 1-Tdap/Td"
QUIT
+28 SET BIX=" "_BIDOSE_"-"_$$VGROUP^BIUTL2(BIVGRP,5)
End DoDot:2
+29 ;
+30 SET BIX=$$PAD^BIUTL5(BIX,17)_"|"
+31 ;
+32 ;---> Write actual totals line for this dose for each Age Group
+33 ;---> (loop through the age groups, concating the totals horizontally).
+34 NEW BIAGRP,K
+35 FOR K=1:1
SET BIAGRP=$PIECE(BIAGRPS,",",K)
IF 'BIAGRP
QUIT
Begin DoDot:2
+36 NEW Y
Begin DoDot:3
+37 ;---> If HPV (17), append sex to age group to retrieve HPV stats.
+38 IF BIVGRP=17
SET Y=+$GET(BITMP("STATS",BIVGRP,BIDOSE,BIAGRP_BISEX))
QUIT
+39 SET Y=+$GET(BITMP("STATS",BIVGRP,BIDOSE,BIAGRP))
End DoDot:3
+40 ;
+41 SET BIX=BIX_$JUSTIFY(Y,12)_" "
End DoDot:2
+42 DO WRITE(.BILINE,BIX)
+43 DO MARK^BIW(BILINE,3,"BIREPD1")
+44 ;
+45 ;
+46 ;---> Now write Percentages line for each Age Group (under the actual totals).
+47 SET BIX=""
IF BIVGRP=132
SET BIX=" (Immune)"
+48 SET BIX=$$PAD^BIUTL5(BIX,17)_"|"
+49 FOR K=1:1
SET BIAGRP=$PIECE(BIAGRPS,",",K)
IF 'BIAGRP
QUIT
Begin DoDot:2
+50 ;N Y S Y=$G(BITMP("STATS",BIVGRP,BIDOSE,BIAGRP))
+51 NEW Y
Begin DoDot:3
+52 ;---> If HPV (17), append sex to age group to retrieve HPV stats.
+53 IF BIVGRP=17
SET Y=+$GET(BITMP("STATS",BIVGRP,BIDOSE,BIAGRP_BISEX))
QUIT
+54 SET Y=+$GET(BITMP("STATS",BIVGRP,BIDOSE,BIAGRP))
End DoDot:3
+55 ;
+56 IF 'Y
SET BIX=BIX_$JUSTIFY("",12)_" "
QUIT
+57 ;
+58 ;---> If Vaccine Group is HPV-17, use female denominators.
+59 ;
+60 ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
+61 ;---> Correct Male HPV percentage denominator.
+62 ;N Z S Z=$G(BITMP("STATS",$S(BIVGRP=17:"TOTLFPTS",1:"TOTLPTS"),BIAGRP))
+63 ;
+64 NEW BIDENOM
Begin DoDot:3
+65 IF (BIVGRP=17)&($GET(BISEX)="F")
SET BIDENOM="TOTLFPTS"
QUIT
+66 IF (BIVGRP=17)&($GET(BISEX)="M")
SET BIDENOM="TOTLMPTS"
QUIT
+67 SET BIDENOM="TOTLPTS"
QUIT
End DoDot:3
+68 NEW Z
SET Z=$GET(BITMP("STATS",BIDENOM,BIAGRP))
+69 ;**********
+70 ;
+71 ;---> To avoid bomb if Z=0/null.
+72 IF 'Z
SET Y=0
SET Z=1
SET Y=(Y*100)/Z
+73 SET BIX=BIX_$JUSTIFY(Y,12,0)_"%"
+74 ;S BIX=BIX_$J(Y,$S(K=1:9,1:12),0)_"%"
End DoDot:2
+75 DO WRITE(.BILINE,BIX)
+76 IF BIDOSE=BIMAXD
QUIT
+77 ;
+78 ;---> Write a dashed line to close off this Dose.
+79 SET BIX=$$SP^BIUTL5(17)_"|"_$$SP^BIUTL5(62,"-")
+80 DO WRITE(.BILINE,BIX)
End DoDot:1
+81 ;
+82 ;---> Write a final dashed line to close off this Vaccine Group (unless Tdap).
+83 Begin DoDot:1
+84 IF BIVGRP=221
SET BIX=$$SP^BIUTL5(17)_"|"_$$SP^BIUTL5(62,"-")
QUIT
+85 SET BIX=$$SP^BIUTL5(79,"-")
End DoDot:1
+86 DO WRITE(.BILINE,BIX)
+87 QUIT
+88 ;
+89 ;
+90 ;----------
VCOMB(BILINE,BICOMB,BIAGRPS,BITMP,BISEX,BIERR) ;EP
+1 ;---> Write Stats lines for each Vaccine Combination.
+2 ;---> Parameters:
+3 ; 1 - BILINE (req) Line number in ^TMP Listman array.
+4 ; 2 - BICOMB (req) Numeric code of Vaccine Combination.
+5 ; 3 - BIAGRPS (req) String of Age Groups ("1112,1313,1317").
+6 ; 4 - BITMP (ret) Stores Patient Totals by Age Group and Sex.
+7 ; 5 - BISEX (opt) F or M for HPV, or B (for "both").
+8 ; 6 - BIERR (ret) Error.
+9 ;
+10 IF '$GET(BIAGRPS)
DO ERRCD^BIUTL2(677,.BIERR)
QUIT
+11 ;
+12 ;---> Build the left-most cell that lists the vaccines for this combo.
+13 ;
+14 ;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR
+15 ;---> Include new "1-Td 1-Men 3-HPV" lines for both sexes combined.
+16 NEW BIX,I,Q,X
SET Q=0
IF $GET(BISEX)=""
SET BISEX=""
+17 FOR I=1:1:4
SET BIX(I)=""
+18 FOR I=1:1
SET X=$PIECE(BICOMB,U,I)
IF Q
QUIT
Begin DoDot:1
+19 ;I ((X="")&(BICOMB'[17)) S Q=1 Q
+20 IF ((X="")&((BICOMB'[17)!(BISEX="B")))
SET Q=1
QUIT
+21 ;**********
+22 IF (X="")
SET X=$SELECT(BISEX="F":"(females)",BISEX="M":"(males)",1:"???")
SET Q=1
+23 IF 'Q
SET X=$PIECE(X,"|",2)_"-"_$$VGROUP^BIUTL2($PIECE(X,"|"),5)
+24 IF I<3
SET BIX(1)=BIX(1)_" "_X
QUIT
+25 IF I<5
SET BIX(2)=BIX(2)_" "_X
QUIT
+26 IF I<7
SET BIX(3)=BIX(3)_" "_X
QUIT
+27 SET BIX(4)=BIX(4)_" "_X
End DoDot:1
+28 ;
+29 ;---> Write actual totals line for this Combo for each Age Group
+30 ;---> (loop through the Age Groups.
+31 SET BIX=BIX(1)
SET BIX=$$PAD^BIUTL5(BIX,17)_"|"
+32 NEW BIAGRP,K
+33 FOR K=1:1
SET BIAGRP=$PIECE(BIAGRPS,",",K)
IF 'BIAGRP
QUIT
Begin DoDot:1
+34 NEW Y
Begin DoDot:2
+35 ;---> If HPV (17), append sex to age group to retrieve HPV stats.
+36 IF $GET(BISEX)="F"
SET Y=+$GET(BITMP("STATS",BICOMB,BIAGRP_"F"))
QUIT
+37 IF $GET(BISEX)="M"
SET Y=+$GET(BITMP("STATS",BICOMB,BIAGRP_"M"))
QUIT
+38 SET Y=+$GET(BITMP("STATS",BICOMB,BIAGRP))
End DoDot:2
+39 ;
+40 SET BIX=BIX_$JUSTIFY(Y,12)_" "
End DoDot:1
+41 DO WRITE(.BILINE,BIX)
+42 SET I=3
IF BIX(3)]""
SET I=4
IF BIX(4)]""
SET I=5
+43 DO MARK^BIW(BILINE,I,"BIREPD1")
+44 ;
+45 ;---> Now write percentages line.
+46 SET BIX=BIX(2)
SET BIX=$$PAD^BIUTL5(BIX,17)_"|"
+47 FOR K=1:1
SET BIAGRP=$PIECE(BIAGRPS,",",K)
IF 'BIAGRP
QUIT
Begin DoDot:1
+48 NEW Y
Begin DoDot:2
+49 ;---> If HPV (17), append sex to age group to retrieve HPV stats.
+50 IF $GET(BISEX)="F"
SET Y=$GET(BITMP("STATS",BICOMB,BIAGRP_"F"))
QUIT
+51 IF $GET(BISEX)="M"
SET Y=$GET(BITMP("STATS",BICOMB,BIAGRP_"M"))
QUIT
+52 SET Y=$GET(BITMP("STATS",BICOMB,BIAGRP))
End DoDot:2
+53 ;
+54 IF 'Y
SET BIX=BIX_$JUSTIFY("",12)_" "
QUIT
+55 IF '$GET(BITMP("STATS","TOTLPTS"))
SET BIX=BIX_$JUSTIFY(Y,7)_" "
QUIT
+56 ;
+57 ;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR
+58 ;---> Use denominators for Both, Female, and Male.
+59 ;N Z S Z=$G(BITMP("STATS",$S(BICOMB[17:"TOTLFPTS",1:"TOTLPTS"),BIAGRP))
+60 NEW Z
Begin DoDot:2
+61 ;---> If HPV (17), append sex to age group to retrieve denominator.
+62 IF $GET(BISEX)="F"
SET Z=$GET(BITMP("STATS","TOTLFPTS",BIAGRP))
QUIT
+63 IF $GET(BISEX)="M"
SET Z=$GET(BITMP("STATS","TOTLMPTS",BIAGRP))
QUIT
+64 SET Z=$GET(BITMP("STATS","TOTLPTS",BIAGRP))
End DoDot:2
+65 ;**********
+66 ;
+67 ;---> To avoid bomb if Z=0/null.
+68 IF 'Z
SET Y=0
SET Z=1
SET Y=(Y*100)/Z
+69 SET BIX=BIX_$JUSTIFY(Y,12,0)_"%"
+70 ;S BIX=BIX_$J(Y,$S(K=1:9,1:12),0)_"%"
End DoDot:1
+71 DO WRITE(.BILINE,BIX)
+72 ;
+73 FOR I=3,4
IF BIX(I)]""
Begin DoDot:1
+74 SET BIX=BIX(I)
SET BIX=$$PAD^BIUTL5(BIX,17)_"|"
+75 DO WRITE(.BILINE,BIX)
End DoDot:1
+76 ;
+77 DO WRITE(.BILINE,$$SP^BIUTL5(79,"-"))
+78 QUIT
+79 ;
+80 ;
+81 ;----------
WRITE(BILINE,BIVAL,BIBLNK) ;EP
+1 ;---> Write lines to ^TMP (see documentation in ^BIW).
+2 ;---> Parameters:
+3 ; 1 - BILINE (ret) Last line# written.
+4 ; 2 - BIVAL (opt) Value/text of line (Null=blank line).
+5 ;
+6 IF '$DATA(BILINE)
QUIT
+7 DO WL^BIW(.BILINE,"BIREPD1",$GET(BIVAL),$GET(BIBLNK))
+8 ;
+9 ;--->Set VALMCNT (Listman line count) for errors calls above.
+10 SET VALMCNT=BILINE
+11 QUIT
