Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BIREPT3

BIREPT3.m

Go to the documentation of this file. 
  1. BIREPT3 ;IHS/CMI/MWR - REPORT, TWO-YR-OLD RATES; MAY 10, 2010
  1.  ;;8.5;IMMUNIZATION;**3**;SEP 10,2012
  1.  ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
  1.  ;;  VIEW TWO-YR-OLD IMMUNIZATION RATES REPORT.
  1.  ;;  PATCH 3: Add report line for Hx of Chickenpox.  VGRP+19
  1.  ;
  1.  ;
  1.  ;----------
  1. GETDATA(BICC,BIHCF,BICM,BIBEN,BIQDT,BITAR,BIAGRPS,BISITE,BIUP,BIERR) ;EP
  1.  ;---> Gather Immunization History data on selected patients.
  1.  ;---> Parameters:
  1.  ;     1 - BICC    (req) Current Community array.
  1.  ;     2 - BIHCF   (req) Health Care Facility array.
  1.  ;     3 - BICM    (req) Case Manager array.
  1.  ;     4 - BIBEN   (req) Beneficiary Type array.
  1.  ;     5 - BIQDT   (req) Quarter Ending Date.
  1.  ;     6 - BITAR   (opt) Two-Yr-Old Age Range; default="19-35" (months).
  1.  ;     7 - BIAGRPS (req) String of Age Groups (e.g., 3,5,7,16,19,24,36)
  1.  ;     8 - BISITE  (req) Site IEN.
  1.  ;     9 - BIUP    (req) User Population/Group (Registered, Imm, User, Active).
  1.  ;    10 - BIERR   (ret) Error.
  1.  ;
  1.  S:'$G(BISITE) BISITE=$G(DUZ(2)) I '$G(BISITE) S BIERR=109 Q
  1.  S:'$G(BIQDT) BIQDT=DT
  1.  S:'$D(BITAR) BITAR="19-35"
  1.  S:$G(BIUP)="" BIUP="u"
  1.  ;
  1.  ;---> Get Begin and End Dates (DOB's).
  1.  D AGEDATE^BIAGE(BITAR,BIQDT,.BIBEGDT,.BIENDDT,.BIERR)
  1.  Q:$G(BIERR)]""
  1.  ;
  1.  ;---> Gather and sort patients.
  1.  D GETPATS^BIREPT4(BIBEGDT,BIENDDT,.BICC,.BIHCF,.BICM,.BIBEN,BIQDT,BIAGRPS,BISITE,BIUP)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. VGRP(BILINE,BIVGRP,BIAGRPS,BIERR) ;EP
  1.  ;---> Write Stats lines for each Vaccine Group.
  1.  ;---> Parameters:
  1.  ;     1 - BILINE  (req) Line number in ^TMP Listman array.
  1.  ;     2 - BIVGRP  (req) IEN of Vaccine Group.
  1.  ;     3 - BIAGRPS (req) String of Age Groups (e.g., 3,5,7,16,19,24,36)
  1.  ;     4 - BIERR   (ret) Error.
  1.  ;
  1.  I '$G(BIVGRP) D ERRCD^BIUTL2(510,.BIERR) Q
  1.  I '$G(BIAGRPS) D ERRCD^BIUTL2(677,.BIERR) Q
  1.  ;
  1.  ;---> Write two lines for each Dose of this Vaccine Group.
  1.  N BIDOSE,BIMAXD S BIMAXD=$$VGROUP^BIUTL2(BIVGRP,6)
  1.  ;**********
  1.  S:'BIMAXD BIMAXD=1
  1.  ;**********
  1.  F BIDOSE=1:1:BIMAXD D
  1.  .;---> BIX=text of the line to write.
  1.  .;
  1.  .;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR
  1.  .;---> Add report line for Hx of Chickenpox.
  1.  .;N BIX S BIX="    "_BIDOSE_"-"_$$VGROUP^BIUTL2(BIVGRP,5)
  1.  .N BIX D
  1.  ..;---> Include exception here for Chickenpox.
  1.  ..I BIVGRP=132 S BIX=" Hx of ChPox" Q
  1.  ..;---> Write the Dose#-Vaccine Group in left margin.
  1.  ..S BIX="    "_BIDOSE_"-"_$$VGROUP^BIUTL2(BIVGRP,5)
  1.  .;**********
  1.  .;
  1.  .S BIX=$$PAD^BIUTL5(BIX,13)_"|"
  1.  .;
  1.  .;---> Now loop through the 6 age groups, concating subtotals.
  1.  .N BIAGRP,K
  1.  .F K=1:1 S BIAGRP=$P(BIAGRPS,",",K) Q:'BIAGRP  D
  1.  ..N Y S Y=$G(BITMP("STATS",BIVGRP,BIDOSE,BIAGRP))
  1.  ..S BIX=BIX_$J(Y,7)_"  "
  1.  .D WRITE(.BILINE,BIX)
  1.  .D MARK^BIW(BILINE,3,"BIREPT1")
  1.  .;
  1.  .;---> Now write percentages line.
  1.  .;
  1.  .;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR
  1.  .;---> Add report line for Hx of Chickenpox.
  1.  .S BIX=$$SP^BIUTL5(13)_"|"
  1.  .S BIX="" S:BIVGRP=132 BIX="   (Immune)"
  1.  .S BIX=$$PAD^BIUTL5(BIX,13)_"|"
  1.  .;**********
  1.  .;
  1.  .F K=1:1 S BIAGRP=$P(BIAGRPS,",",K) Q:'BIAGRP  D
  1.  ..N Y S Y=$G(BITMP("STATS",BIVGRP,BIDOSE,BIAGRP))
  1.  ..I 'Y S BIX=BIX_$J(Y,7)_"  " Q
  1.  ..I '$G(BITMP("STATS","TOTLPTS")) S BIX=BIX_$J(Y,7)_"  " Q
  1.  ..S Y=(Y*100)/$G(BITMP("STATS","TOTLPTS"))
  1.  ..S BIX=BIX_$J(Y,7,0)_"% "
  1.  .D WRITE(.BILINE,BIX)
  1.  .Q:BIDOSE=BIMAXD
  1.  .S BIX=$$SP^BIUTL5(13)_"|"_$$SP^BIUTL5(65,"-")
  1.  .D WRITE(.BILINE,BIX)
  1.  D WRITE(.BILINE,$$SP^BIUTL5(79,"-"))
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. VCOMB(BILINE,BICOMB,BIAGRPS,BIERR,BIUTD) ;EP
  1.  ;---> Write Stats lines for each Vaccine Combination.
  1.  ;---> Parameters:
  1.  ;     1 - BILINE  (req) Line number in ^TMP Listman array.
  1.  ;     2 - BICOMB  (req) Numeric code of Vaccine Combination.
  1.  ;     3 - BIAGRPS (req) String of Age Groups (e.g., 3,5,7,16,19,24,36)
  1.  ;     4 - BIERR   (ret) Error.
  1.  ;     5 - BIUTD   (opt) If BIUTD=1, tack on text: "*UTD"
  1.  ;
  1.  I '$G(BIVGRP) D ERRCD^BIUTL2(678,.BIERR) Q
  1.  I '$G(BIAGRPS) D ERRCD^BIUTL2(677,.BIERR) Q
  1.  ;     vvv83
  1.  ;
  1.  N BIX,I,X
  1.  F I=1:1:5 S BIX(I)=""
  1.  F I=1:1 S X=$P(BICOMB,U,I) Q:X=""  D
  1.  .S X=$P(X,"|",2)_"-"_$$VGROUP^BIUTL2($P(X,"|"),5)
  1.  .I I<3 S BIX(1)=BIX(1)_" "_X Q
  1.  .I I<5 S BIX(2)=BIX(2)_" "_X Q
  1.  .I I<7 S BIX(3)=BIX(3)_" "_X Q
  1.  .I I<9 S BIX(4)=BIX(4)_" "_X S:$G(BIUTD) BIX(4)=BIX(4)_"  *UTD" Q
  1.  .S BIX(5)=BIX(5)_" "_X
  1.  ;
  1.  ;---> Now loop through the age groups, concating subtotals.
  1.  S BIX=BIX(1),BIX=$$PAD^BIUTL5(BIX,13)_"|"
  1.  N BIAGRP,K
  1.  F K=1:1 S BIAGRP=$P(BIAGRPS,",",K) Q:'BIAGRP  D
  1.  .N Y S Y=$G(BITMP("STATS",BICOMB,BIAGRP))
  1.  .S BIX=BIX_$J(Y,7)_"  "
  1.  D WRITE(.BILINE,BIX)
  1.  S I=3 S:BIX(3)]"" I=4 S:BIX(4)]"" I=5
  1.  D MARK^BIW(BILINE,I,"BIREPT1")
  1.  ;
  1.  ;---> Now write percentages line.
  1.  S BIX=BIX(2),BIX=$$PAD^BIUTL5(BIX,13)_"|"
  1.  F K=1:1 S BIAGRP=$P(BIAGRPS,",",K) Q:'BIAGRP  D
  1.  .N Y S Y=$G(BITMP("STATS",BICOMB,BIAGRP))
  1.  .I 'Y S BIX=BIX_$J(Y,7)_"  " Q
  1.  .I '$G(BITMP("STATS","TOTLPTS")) S BIX=BIX_$J(Y,7)_"  " Q
  1.  .S Y=(Y*100)/$G(BITMP("STATS","TOTLPTS"))
  1.  .S BIX=BIX_$J(Y,7,0)_"% "
  1.  D WRITE(.BILINE,BIX)
  1.  ;
  1.  F I=3,4,5 D:BIX(I)]""
  1.  .S BIX=BIX(I),BIX=$$PAD^BIUTL5(BIX,13)_"|"
  1.  .D WRITE(.BILINE,BIX)
  1.  ;
  1.  D WRITE(.BILINE,$$SP^BIUTL5(79,"-"))
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. WRITE(BILINE,BIVAL,BIBLNK) ;EP
  1.  ;---> Write lines to ^TMP (see documentation in ^BIW).
  1.  ;---> Parameters:
  1.  ;     1 - BILINE (ret) Last line# written.
  1.  ;     2 - BIVAL  (opt) Value/text of line (Null=blank line).
  1.  ;
  1.  Q:'$D(BILINE)
  1.  D WL^BIW(.BILINE,"BIREPT1",$G(BIVAL),$G(BIBLNK))
  1.  ;
  1.  ;--->Set VALMCNT (Listman line count) for errors calls above.
  1.  S VALMCNT=BILINE
  1.  Q