BIREPT3 ;IHS/CMI/MWR - REPORT, TWO-YR-OLD RATES; MAY 10, 2010
;;8.5;IMMUNIZATION;**3**;SEP 10,2012
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; VIEW TWO-YR-OLD IMMUNIZATION RATES REPORT.
;; PATCH 3: Add report line for Hx of Chickenpox. VGRP+19
;
;
;----------
GETDATA(BICC,BIHCF,BICM,BIBEN,BIQDT,BITAR,BIAGRPS,BISITE,BIUP,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 - BITAR (opt) Two-Yr-Old Age Range; default="19-35" (months).
; 7 - BIAGRPS (req) String of Age Groups (e.g., 3,5,7,16,19,24,36)
; 8 - BISITE (req) Site IEN.
; 9 - BIUP (req) User Population/Group (Registered, Imm, User, Active).
; 10 - BIERR (ret) Error.
;
S:'$G(BISITE) BISITE=$G(DUZ(2)) I '$G(BISITE) S BIERR=109 Q
S:'$G(BIQDT) BIQDT=DT
S:'$D(BITAR) BITAR="19-35"
S:$G(BIUP)="" BIUP="u"
;
;---> Get Begin and End Dates (DOB's).
D AGEDATE^BIAGE(BITAR,BIQDT,.BIBEGDT,.BIENDDT,.BIERR)
Q:$G(BIERR)]""
;
;---> Gather and sort patients.
D GETPATS^BIREPT4(BIBEGDT,BIENDDT,.BICC,.BIHCF,.BICM,.BIBEN,BIQDT,BIAGRPS,BISITE,BIUP)
Q
;
;
;----------
VGRP(BILINE,BIVGRP,BIAGRPS,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 (e.g., 3,5,7,16,19,24,36)
; 4 - 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,6)
;**********
S:'BIMAXD BIMAXD=1
;**********
F BIDOSE=1:1:BIMAXD D
.;---> BIX=text of the line to write.
.;
.;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR
.;---> Add report line for Hx of Chickenpox.
.;N BIX S BIX=" "_BIDOSE_"-"_$$VGROUP^BIUTL2(BIVGRP,5)
.N BIX D
..;---> Include exception here for Chickenpox.
..I BIVGRP=132 S BIX=" Hx of ChPox" Q
..;---> Write the Dose#-Vaccine Group in left margin.
..S BIX=" "_BIDOSE_"-"_$$VGROUP^BIUTL2(BIVGRP,5)
.;**********
.;
.S BIX=$$PAD^BIUTL5(BIX,13)_"|"
.;
.;---> Now loop through the 6 age groups, concating subtotals.
.N BIAGRP,K
.F K=1:1 S BIAGRP=$P(BIAGRPS,",",K) Q:'BIAGRP D
..N Y S Y=$G(BITMP("STATS",BIVGRP,BIDOSE,BIAGRP))
..S BIX=BIX_$J(Y,7)_" "
.D WRITE(.BILINE,BIX)
.D MARK^BIW(BILINE,3,"BIREPT1")
.;
.;---> Now write percentages line.
.;
.;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR
.;---> Add report line for Hx of Chickenpox.
.S BIX=$$SP^BIUTL5(13)_"|"
.S BIX="" S:BIVGRP=132 BIX=" (Immune)"
.S BIX=$$PAD^BIUTL5(BIX,13)_"|"
.;**********
.;
.F K=1:1 S BIAGRP=$P(BIAGRPS,",",K) Q:'BIAGRP D
..N Y S Y=$G(BITMP("STATS",BIVGRP,BIDOSE,BIAGRP))
..I 'Y S BIX=BIX_$J(Y,7)_" " Q
..I '$G(BITMP("STATS","TOTLPTS")) S BIX=BIX_$J(Y,7)_" " Q
..S Y=(Y*100)/$G(BITMP("STATS","TOTLPTS"))
..S BIX=BIX_$J(Y,7,0)_"% "
.D WRITE(.BILINE,BIX)
.Q:BIDOSE=BIMAXD
.S BIX=$$SP^BIUTL5(13)_"|"_$$SP^BIUTL5(65,"-")
.D WRITE(.BILINE,BIX)
D WRITE(.BILINE,$$SP^BIUTL5(79,"-"))
Q
;
;
;----------
VCOMB(BILINE,BICOMB,BIAGRPS,BIERR,BIUTD) ;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 (e.g., 3,5,7,16,19,24,36)
; 4 - BIERR (ret) Error.
; 5 - BIUTD (opt) If BIUTD=1, tack on text: "*UTD"
;
I '$G(BIVGRP) D ERRCD^BIUTL2(678,.BIERR) Q
I '$G(BIAGRPS) D ERRCD^BIUTL2(677,.BIERR) Q
; vvv83
;
N BIX,I,X
F I=1:1:5 S BIX(I)=""
F I=1:1 S X=$P(BICOMB,U,I) Q:X="" D
.S 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
.I I<9 S BIX(4)=BIX(4)_" "_X S:$G(BIUTD) BIX(4)=BIX(4)_" *UTD" Q
.S BIX(5)=BIX(5)_" "_X
;
;---> Now loop through the age groups, concating subtotals.
S BIX=BIX(1),BIX=$$PAD^BIUTL5(BIX,13)_"|"
N BIAGRP,K
F K=1:1 S BIAGRP=$P(BIAGRPS,",",K) Q:'BIAGRP D
.N Y S Y=$G(BITMP("STATS",BICOMB,BIAGRP))
.S BIX=BIX_$J(Y,7)_" "
D WRITE(.BILINE,BIX)
S I=3 S:BIX(3)]"" I=4 S:BIX(4)]"" I=5
D MARK^BIW(BILINE,I,"BIREPT1")
;
;---> Now write percentages line.
S BIX=BIX(2),BIX=$$PAD^BIUTL5(BIX,13)_"|"
F K=1:1 S BIAGRP=$P(BIAGRPS,",",K) Q:'BIAGRP D
.N Y S Y=$G(BITMP("STATS",BICOMB,BIAGRP))
.I 'Y S BIX=BIX_$J(Y,7)_" " Q
.I '$G(BITMP("STATS","TOTLPTS")) S BIX=BIX_$J(Y,7)_" " Q
.S Y=(Y*100)/$G(BITMP("STATS","TOTLPTS"))
.S BIX=BIX_$J(Y,7,0)_"% "
D WRITE(.BILINE,BIX)
;
F I=3,4,5 D:BIX(I)]""
.S BIX=BIX(I),BIX=$$PAD^BIUTL5(BIX,13)_"|"
.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,"BIREPT1",$G(BIVAL),$G(BIBLNK))
;
;--->Set VALMCNT (Listman line count) for errors calls above.
S VALMCNT=BILINE
Q
BIREPT3 ;IHS/CMI/MWR - REPORT, TWO-YR-OLD RATES; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;**3**;SEP 10,2012
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; VIEW TWO-YR-OLD IMMUNIZATION RATES REPORT.
+4 ;; PATCH 3: Add report line for Hx of Chickenpox. VGRP+19
+5 ;
+6 ;
+7 ;----------
GETDATA(BICC,BIHCF,BICM,BIBEN,BIQDT,BITAR,BIAGRPS,BISITE,BIUP,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 - BITAR (opt) Two-Yr-Old Age Range; default="19-35" (months).
+9 ; 7 - BIAGRPS (req) String of Age Groups (e.g., 3,5,7,16,19,24,36)
+10 ; 8 - BISITE (req) Site IEN.
+11 ; 9 - BIUP (req) User Population/Group (Registered, Imm, User, Active).
+12 ; 10 - BIERR (ret) Error.
+13 ;
+14 IF '$GET(BISITE)
SET BISITE=$GET(DUZ(2))
IF '$GET(BISITE)
SET BIERR=109
QUIT
+15 IF '$GET(BIQDT)
SET BIQDT=DT
+16 IF '$DATA(BITAR)
SET BITAR="19-35"
+17 IF $GET(BIUP)=""
SET BIUP="u"
+18 ;
+19 ;---> Get Begin and End Dates (DOB's).
+20 DO AGEDATE^BIAGE(BITAR,BIQDT,.BIBEGDT,.BIENDDT,.BIERR)
+21 IF $GET(BIERR)]""
QUIT
+22 ;
+23 ;---> Gather and sort patients.
+24 DO GETPATS^BIREPT4(BIBEGDT,BIENDDT,.BICC,.BIHCF,.BICM,.BIBEN,BIQDT,BIAGRPS,BISITE,BIUP)
+25 QUIT
+26 ;
+27 ;
+28 ;----------
VGRP(BILINE,BIVGRP,BIAGRPS,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 (e.g., 3,5,7,16,19,24,36)
+6 ; 4 - BIERR (ret) Error.
+7 ;
+8 IF '$GET(BIVGRP)
DO ERRCD^BIUTL2(510,.BIERR)
QUIT
+9 IF '$GET(BIAGRPS)
DO ERRCD^BIUTL2(677,.BIERR)
QUIT
+10 ;
+11 ;---> Write two lines for each Dose of this Vaccine Group.
+12 NEW BIDOSE,BIMAXD
SET BIMAXD=$$VGROUP^BIUTL2(BIVGRP,6)
+13 ;**********
+14 IF 'BIMAXD
SET BIMAXD=1
+15 ;**********
+16 FOR BIDOSE=1:1:BIMAXD
Begin DoDot:1
+17 ;---> BIX=text of the line to write.
+18 ;
+19 ;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR
+20 ;---> Add report line for Hx of Chickenpox.
+21 ;N BIX S BIX=" "_BIDOSE_"-"_$$VGROUP^BIUTL2(BIVGRP,5)
+22 NEW BIX
Begin DoDot:2
+23 ;---> Include exception here for Chickenpox.
+24 IF BIVGRP=132
SET BIX=" Hx of ChPox"
QUIT
+25 ;---> Write the Dose#-Vaccine Group in left margin.
+26 SET BIX=" "_BIDOSE_"-"_$$VGROUP^BIUTL2(BIVGRP,5)
End DoDot:2
+27 ;**********
+28 ;
+29 SET BIX=$$PAD^BIUTL5(BIX,13)_"|"
+30 ;
+31 ;---> Now loop through the 6 age groups, concating subtotals.
+32 NEW BIAGRP,K
+33 FOR K=1:1
SET BIAGRP=$PIECE(BIAGRPS,",",K)
IF 'BIAGRP
QUIT
Begin DoDot:2
+34 NEW Y
SET Y=$GET(BITMP("STATS",BIVGRP,BIDOSE,BIAGRP))
+35 SET BIX=BIX_$JUSTIFY(Y,7)_" "
End DoDot:2
+36 DO WRITE(.BILINE,BIX)
+37 DO MARK^BIW(BILINE,3,"BIREPT1")
+38 ;
+39 ;---> Now write percentages line.
+40 ;
+41 ;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR
+42 ;---> Add report line for Hx of Chickenpox.
+43 SET BIX=$$SP^BIUTL5(13)_"|"
+44 SET BIX=""
IF BIVGRP=132
SET BIX=" (Immune)"
+45 SET BIX=$$PAD^BIUTL5(BIX,13)_"|"
+46 ;**********
+47 ;
+48 FOR K=1:1
SET BIAGRP=$PIECE(BIAGRPS,",",K)
IF 'BIAGRP
QUIT
Begin DoDot:2
+49 NEW Y
SET Y=$GET(BITMP("STATS",BIVGRP,BIDOSE,BIAGRP))
+50 IF 'Y
SET BIX=BIX_$JUSTIFY(Y,7)_" "
QUIT
+51 IF '$GET(BITMP("STATS","TOTLPTS"))
SET BIX=BIX_$JUSTIFY(Y,7)_" "
QUIT
+52 SET Y=(Y*100)/$GET(BITMP("STATS","TOTLPTS"))
+53 SET BIX=BIX_$JUSTIFY(Y,7,0)_"% "
End DoDot:2
+54 DO WRITE(.BILINE,BIX)
+55 IF BIDOSE=BIMAXD
QUIT
+56 SET BIX=$$SP^BIUTL5(13)_"|"_$$SP^BIUTL5(65,"-")
+57 DO WRITE(.BILINE,BIX)
End DoDot:1
+58 DO WRITE(.BILINE,$$SP^BIUTL5(79,"-"))
+59 QUIT
+60 ;
+61 ;
+62 ;----------
VCOMB(BILINE,BICOMB,BIAGRPS,BIERR,BIUTD) ;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 (e.g., 3,5,7,16,19,24,36)
+6 ; 4 - BIERR (ret) Error.
+7 ; 5 - BIUTD (opt) If BIUTD=1, tack on text: "*UTD"
+8 ;
+9 IF '$GET(BIVGRP)
DO ERRCD^BIUTL2(678,.BIERR)
QUIT
+10 IF '$GET(BIAGRPS)
DO ERRCD^BIUTL2(677,.BIERR)
QUIT
+11 ; vvv83
+12 ;
+13 NEW BIX,I,X
+14 FOR I=1:1:5
SET BIX(I)=""
+15 FOR I=1:1
SET X=$PIECE(BICOMB,U,I)
IF X=""
QUIT
Begin DoDot:1
+16 SET X=$PIECE(X,"|",2)_"-"_$$VGROUP^BIUTL2($PIECE(X,"|"),5)
+17 IF I<3
SET BIX(1)=BIX(1)_" "_X
QUIT
+18 IF I<5
SET BIX(2)=BIX(2)_" "_X
QUIT
+19 IF I<7
SET BIX(3)=BIX(3)_" "_X
QUIT
+20 IF I<9
SET BIX(4)=BIX(4)_" "_X
IF $GET(BIUTD)
SET BIX(4)=BIX(4)_" *UTD"
QUIT
+21 SET BIX(5)=BIX(5)_" "_X
End DoDot:1
+22 ;
+23 ;---> Now loop through the age groups, concating subtotals.
+24 SET BIX=BIX(1)
SET BIX=$$PAD^BIUTL5(BIX,13)_"|"
+25 NEW BIAGRP,K
+26 FOR K=1:1
SET BIAGRP=$PIECE(BIAGRPS,",",K)
IF 'BIAGRP
QUIT
Begin DoDot:1
+27 NEW Y
SET Y=$GET(BITMP("STATS",BICOMB,BIAGRP))
+28 SET BIX=BIX_$JUSTIFY(Y,7)_" "
End DoDot:1
+29 DO WRITE(.BILINE,BIX)
+30 SET I=3
IF BIX(3)]""
SET I=4
IF BIX(4)]""
SET I=5
+31 DO MARK^BIW(BILINE,I,"BIREPT1")
+32 ;
+33 ;---> Now write percentages line.
+34 SET BIX=BIX(2)
SET BIX=$$PAD^BIUTL5(BIX,13)_"|"
+35 FOR K=1:1
SET BIAGRP=$PIECE(BIAGRPS,",",K)
IF 'BIAGRP
QUIT
Begin DoDot:1
+36 NEW Y
SET Y=$GET(BITMP("STATS",BICOMB,BIAGRP))
+37 IF 'Y
SET BIX=BIX_$JUSTIFY(Y,7)_" "
QUIT
+38 IF '$GET(BITMP("STATS","TOTLPTS"))
SET BIX=BIX_$JUSTIFY(Y,7)_" "
QUIT
+39 SET Y=(Y*100)/$GET(BITMP("STATS","TOTLPTS"))
+40 SET BIX=BIX_$JUSTIFY(Y,7,0)_"% "
End DoDot:1
+41 DO WRITE(.BILINE,BIX)
+42 ;
+43 FOR I=3,4,5
IF BIX(I)]""
Begin DoDot:1
+44 SET BIX=BIX(I)
SET BIX=$$PAD^BIUTL5(BIX,13)_"|"
+45 DO WRITE(.BILINE,BIX)
End DoDot:1
+46 ;
+47 DO WRITE(.BILINE,$$SP^BIUTL5(79,"-"))
+48 QUIT
+49 ;
+50 ;
+51 ;----------
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,"BIREPT1",$GET(BIVAL),$GET(BIBLNK))
+8 ;
+9 ;--->Set VALMCNT (Listman line count) for errors calls above.
+10 SET VALMCNT=BILINE
+11 QUIT
