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

BIREPL2.m

Go to the documentation of this file. 
  1. BIREPL2 ;IHS/CMI/MWR - REPORT, ADULT IMM; MAY 10, 2010
  1.  ;;8.5;IMMUNIZATION;**12**;MAY 01,2016
  1.  ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
  1.  ;;  VIEW ADULT IMMUNIZATION REPORT, GATHER DATA.
  1.  ;;  PATCH 3: Remove Date Range line (no longer relevant).  HEAD+33
  1.  ;;  PATCH 3: Set HPV upper limit display for males to 21 years. DISPLAY+69
  1.  ;;  PATCH 12: Add new Composite Measures.  DISPLAY+25
  1.  ;
  1.  ;
  1.  ;----------
  1.  ;---> Produce Header array for ADULT Immunization Report.
  1.  ;---> Parameters:
  1.  ;     1 - BIQDT  (req) Quarter Ending Date.
  1.  ;     2 - BICC   (req) Current Community array.
  1.  ;     3 - BIHCF  (req) Health Care Facility array.
  1.  ;     4 - BIBEN  (req) Beneficiary Type array.
  1.  ;     5 - BICPTI (req) 1=Include CPT Coded Visits, 0=Ignore CPT
  1.  ;     6 - BIUP    (req) User Population/Group (Registered, Imm, User, Active).
  1.  ;
  1.  ;---> Check for required Variables.
  1.  Q:'$G(BIQDT)
  1.  Q:'$D(BICC)
  1.  Q:'$D(BIHCF)
  1.  Q:'$D(BIBEN)
  1.  I '$D(BICPTI) S BICPTI=0
  1.  Q:'$D(BIUP)
  1.  ;
  1.  K VALMHDR
  1.  N BILINE,X S BILINE=0
  1.  ;
  1.  N X S X=""
  1.  ;---> If Header array is NOT being for Listmananger include version.
  1.  S:'$D(VALM("BM")) X=$$LMVER^BILOGO()
  1.  ;
  1.  D WH^BIW(.BILINE,X)
  1.  S X=$$REPHDR^BIUTL6(DUZ(2)) D CENTERT^BIUTL5(.X)
  1.  D WH^BIW(.BILINE,X)
  1.  ;
  1.  S X="*  Adult Immunization Report  *" D CENTERT^BIUTL5(.X)
  1.  D WH^BIW(.BILINE,X)
  1.  ;
  1.  S X=$$SP^BIUTL5(27)_"Report Date: "_$$SLDT1^BIUTL5(DT)
  1.  ;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR
  1.  ;---> Remove Date Range line (no longer relevant).
  1.  ;D WH^BIW(.BILINE,X)
  1.  D WH^BIW(.BILINE,X,1)
  1.  ;
  1.  ;S X=$$SP^BIUTL5(28)_"Date Range: "_$$SLDT1^BIUTL5(BIQDT-10000)_" - "_$$SLDT1^BIUTL5(BIQDT)
  1.  ;D WH^BIW(.BILINE,X,1)
  1.  ;**********
  1.  ;
  1.  S X=" "_$$BIUPTX^BIUTL6(BIUP)
  1.  I BICPTI S X=$$PAD^BIUTL5(X,52)_"* CPT Coded Visits Included"
  1.  D WH^BIW(.BILINE,X)
  1.  D WH^BIW(.BILINE,$$SP^BIUTL5(79,"-"))
  1.  ;
  1.  D
  1.  .;---> If specific Communities were selected (not ALL), then print
  1.  .;---> the Communities in a subheader at the top of the report.
  1.  .D SUBH^BIOUTPT5("BICC","Community",,"^AUTTCOM(",.BILINE,.BIERR,,13)
  1.  .I $G(BIERR) D ERRCD^BIUTL2(BIERR,.X) D WH^BIW(.BILINE,X) Q
  1.  .;
  1.  .;---> If specific Health Care Facilities, print subheader.
  1.  .D SUBH^BIOUTPT5("BIHCF","Facility",,"^DIC(4,",.BILINE,.BIERR,,13)
  1.  .I $G(BIERR) D ERRCD^BIUTL2(BIERR,.X) D WH^BIW(.BILINE,X) Q
  1.  .;
  1.  .;---> If specific Beneficiary Types, print Beneficiary Type subheader.
  1.  .D SUBH^BIOUTPT5("BIBEN","Beneficiary Type",,"^AUTTBEN(",.BILINE,.BIERR,,13)
  1.  .I $G(BIERR) D ERRCD^BIUTL2(BIERR,.X) D WH^BIW(.BILINE,X) Q
  1.  .;
  1.  .S X=$$SP^BIUTL5(59)_"Number   Percent"
  1.  .D WH^BIW(.BILINE,X)
  1.  ;
  1.  ;---> If Header array is being built for Listmananger,
  1.  ;---> reset display window margins for Communities, etc.
  1.  D:$D(VALM("BM"))
  1.  .S VALM("TM")=BILINE+3
  1.  .S VALM("LINES")=VALM("BM")-VALM("TM")+1
  1.  .;---> Safeguard to prevent divide/0 error.
  1.  .S:VALM("LINES")<1 VALM("LINES")=1
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. START(BIQDT,BICC,BIHCF,BIBEN,BICPTI,BIUP) ;EP
  1.  ;---> Produce array for ADULT Immunization Report.
  1.  ;---> Parameters:
  1.  ;     1 - BIQDT  (req) Quarter Ending Date.
  1.  ;     2 - BICC   (req) Current Community array.
  1.  ;     3 - BIHCF  (req) Health Care Facility array.
  1.  ;     4 - BIBEN  (req) Beneficiary Type array.
  1.  ;     5 - BICPTI (req) 1=Include CPT Coded Visits, 0=Ignore CPT (default).
  1.  ;     6 - BIUP    (req) User Population/Group (Registered, Imm, User, Active).
  1.  ;
  1.  N BILINE,BITMP,X S BILINE=0
  1.  K ^TMP("BIREPL1",$J)
  1.  ;
  1.  ;---> Check for required Variables.
  1.  ;---> Fix for v8.1 by adding .X to error calls below.
  1.  I '$G(BIQDT) D ERRCD^BIUTL2(623,.X) D WRITE(.BILINE,X) Q
  1.  I '$D(BICC) D ERRCD^BIUTL2(614,.X) D WRITE(.BILINE,X) Q
  1.  I '$D(BIHCF) D ERRCD^BIUTL2(625,.X) D WRITE(.BILINE,X) Q
  1.  I '$D(BIBEN) D ERRCD^BIUTL2(662,.X) D WRITE(.BILINE,X) Q
  1.  I '$D(BICPTI) S BICPTI=0
  1.  S:$G(BIUP)="" BIUP="u"
  1.  ;
  1.  D GETSTATS^BIREPL3(BIQDT,.BICC,.BIHCF,.BIBEN,BICPTI,BIUP,.BITOTS)
  1.  D DISPLAY(BITOTS,.BILINE)
  1.  S VALMCNT=BILINE
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. DISPLAY(BITOTS,BILINE) ;EP
  1.  ;---> Write Adult Stats for display.
  1.  ;---> Parameters:
  1.  ;     1 - BITOTS (req) Totals delimited by "^":
  1.  ;                      Pc   Variable
  1.  ;                       1 - BI19=Total over 19
  1.  ;                       2 - BIT19 = Number over 19 w/Tetanus past 10 years.
  1.  ;                       3 - BITDAP = Number over 19 w/Tdap past 10 years.
  1.  ;
  1.  ;                       4 - BIHPVF  = Total number of Females age 19-26
  1.  ;                       5 - BIHPVF1 = Number Females 19-26 w/HPV-1
  1.  ;                       6 - BIHPVF2 = Number Females 19-26 w/HPV-2
  1.  ;                       7 - BIHPVF3 = Number Females 19-26 w/HPV-3
  1.  ;                       8 - BIHPVF  = Total number of Males age 19-26
  1.  ;                       9 - BIHPVM1 = Number Males 19-26 w/HPV-1
  1.  ;                      10 - BIHPVM2 = Number Males 19-26 w/HPV-2
  1.  ;                      11 - BIHPVM3 = Number Males 19-26 w/HPV-3
  1.  ;
  1.  ;                      12 - BI60=Total over 60
  1.  ;                      13 - BIZ60 = Number over 60 w/Zoster ever.
  1.  ;                      14 - BI65=Total over 65
  1.  ;                      15 - BIT65 = Number over 65 w/Tetanus past 10 years.
  1.  ;                      16 - BIP65 = Number over 65 w/Pneumo at or after 65 years.
  1.  ;                      17 - BIP65E = Number over 65 w/Pneumo EVER.
  1.  ;
  1.  ;********** PATCH 12, v8.5, MAY 01,2016, IHS/CMI/MWR
  1.  ;---> New Composite Measure Variables.
  1.  ;                      18 - BIC19=Total >19 <60
  1.  ;                      19 - BIC191=Tdap ever
  1.  ;                      20 - BIC192=(Td or Tdap) <10 yrs
  1.  ;                      21 - BIC193=(Tdap ever) AND ((Tdap or Td) <10 yrs)
  1.  ;
  1.  ;                      22 - BIC60=Total >60 <65
  1.  ;                      23 - BIC601=Tdap ever
  1.  ;                      24 - BIC602=(Td or Tdap) <10 yrs
  1.  ;                      25 - BIC603=Zoster
  1.  ;                      26 - BIC604=(Tdap ever) AND ((Tdap or Td) <10 yrs) AND Zoster
  1.  ;
  1.  ;                      27 - BIC65=Total >65
  1.  ;                      28 - BIC651=Tdap ever
  1.  ;                      29 - BIC652=(Td or Tdap) <10 yrs
  1.  ;                      30 - BIC653=Zoster
  1.  ;                      31 - BIC654=Pneumo >65 yrs
  1.  ;                      32 - BIC655=(Tdap ever) AND ((Tdap or Td) <10 yrs) AND Zoster AND Pneumo
  1.  ;                      33 - BICUTDD=Overall UTD Denominator
  1.  ;                      34 - BICUTDN-Overall UTD Numerator
  1.  ;
  1.  ;
  1.  ;     1 - BILINE (ret) Number of lines written to Listman scroll area.
  1.  ;
  1.  I $G(BITOTS)="" D ERRCD^BIUTL2(667,.X) D WRITE(.BILINE,X) Q
  1.  ;
  1.  ;---> Set totals into BIV local array, 1-15.
  1.  ;**********
  1.  ;N BIV,I F I=1:1:17 S BIV(I)=$P(BITOTS,U,I)
  1.  N BIV,I F I=1:1:34 S BIV(I)=$P(BITOTS,U,I)
  1.  ;**********
  1.  ;
  1.  S X=$$PAD("  Total Number of Patients 19 years and older",56)_": "
  1.  S X=X_$$C(BIV(1),0,8) D WRITE(.BILINE,X,1)
  1.  ;
  1.  S X=$$PAD("    TETANUS: # patients w/Td in past 10 years",56)
  1.  S X=X_": "_$$C(BIV(2),0,8)
  1.  I BIV(1) S X=X_$J((BIV(2)/BIV(1))*100,7,1)
  1.  D WRITE(.BILINE,X)
  1.  ;
  1.  S X=$$PAD("    TETANUS: # patients w/Tdap in past 10 years",56)
  1.  S X=X_": "_$$C(BIV(3),0,8)
  1.  I BIV(1) S X=X_$J((BIV(3)/BIV(1))*100,7,1)
  1.  D WRITE(.BILINE,X,1)
  1.  ;
  1.  ;---> Females (pcs 4-7).
  1.  S X=$$PAD("    HPV: Total # Female patients age 19-26",56)
  1.  S X=X_": "_$$C(BIV(4),0,8)
  1.  I BIV(1) S X=X_$J((BIV(4)/BIV(1))*100,7,1)
  1.  D WRITE(.BILINE,X)
  1.  ;
  1.  S X=$$PAD("    HPV: # Female patients age 19-26 w/HPV1",56)
  1.  S X=X_": "_$$C(BIV(5),0,8)
  1.  I BIV(4) S X=X_$J((BIV(5)/BIV(4))*100,7,1)
  1.  D WRITE(.BILINE,X)
  1.  ;
  1.  S X=$$PAD("    HPV: # Female patients age 19-26 w/HPV2",56)
  1.  S X=X_": "_$$C(BIV(6),0,8)
  1.  I BIV(4) S X=X_$J((BIV(6)/BIV(4))*100,7,1)
  1.  D WRITE(.BILINE,X)
  1.  ;
  1.  S X=$$PAD("    HPV: # Female patients age 19-26 w/HPV3",56)
  1.  S X=X_": "_$$C(BIV(7),0,8)
  1.  I BIV(4) S X=X_$J((BIV(7)/BIV(4))*100,7,1)
  1.  D WRITE(.BILINE,X,1)
  1.  ;
  1.  ;---> Males (pcs 8-11).
  1.  ;
  1.  ;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR
  1.  ;---> Change male age to display "19-21".
  1.  S X=$$PAD("    HPV: Total # Male patients age 19-21",56)
  1.  S X=X_": "_$$C(BIV(8),0,8)
  1.  I BIV(1) S X=X_$J((BIV(8)/BIV(1))*100,7,1)
  1.  D WRITE(.BILINE,X)
  1.  ;
  1.  S X=$$PAD("    HPV: # Male patients age 19-21 w/HPV1",56)
  1.  S X=X_": "_$$C(BIV(9),0,8)
  1.  I BIV(8) S X=X_$J((BIV(9)/BIV(8))*100,7,1)
  1.  D WRITE(.BILINE,X)
  1.  ;
  1.  S X=$$PAD("    HPV: # Male patients age 19-21 w/HPV2",56)
  1.  S X=X_": "_$$C(BIV(10),0,8)
  1.  I BIV(8) S X=X_$J((BIV(10)/BIV(8))*100,7,1)
  1.  D WRITE(.BILINE,X)
  1.  ;
  1.  S X=$$PAD("    HPV: # Male patients age 19-21 w/HPV3",56)
  1.  ;**********
  1.  ;
  1.  S X=X_": "_$$C(BIV(11),0,8)
  1.  I BIV(8) S X=X_$J((BIV(11)/BIV(8))*100,7,1)
  1.  D WRITE(.BILINE,X,1)
  1.  ;
  1.  ;---> Total patients over 60 & Zoster. (pcs 12-13).
  1.  S X=$$PAD("  Total Number of Patients 60 years and older",56)
  1.  S X=X_": "_$$C(BIV(12),0,8)
  1.  I BIV(1) S X=X_$J((BIV(12)/BIV(1))*100,7,1)
  1.  D WRITE(.BILINE,X)
  1.  ;
  1.  S X=$$PAD("    ZOSTER: # patients w/Zostavax ever",56)
  1.  S X=X_": "_$$C(BIV(13),0,8)
  1.  I BIV(12) S X=X_$J((BIV(13)/BIV(12))*100,7,1)
  1.  D WRITE(.BILINE,X,1)
  1.  ;
  1.  ;
  1.  ;---> Total patients over 65 (pcs 14-16).
  1.  S X=$$PAD("  Total Number of Patients 65 years and older",56)
  1.  S X=X_": "_$$C(BIV(14),0,8)
  1.  I BIV(1) S X=X_$J((BIV(14)/BIV(1))*100,7,1)
  1.  D WRITE(.BILINE,X)
  1.  ;
  1.  S X=$$PAD("    TETANUS: # patients w/Td in past 10 years",56)
  1.  S X=X_": "_$$C(BIV(15),0,8)
  1.  I BIV(14) S X=X_$J((BIV(15)/BIV(14))*100,7,1)
  1.  D WRITE(.BILINE,X)
  1.  ;
  1.  ;S X=$$PAD("    INFLUENZA: # pts w/Influenza vaccine in past year",56)
  1.  ;S X=X_": "_$$C(BIV(9),0,8)
  1.  ;I BIV(7) S X=X_$J((BIV(9)/BIV(7))*100,7,1)
  1.  ;D WRITE(.BILINE,X,1)
  1.  ;
  1.  S X=$$PAD("    PNEUMOVAX: # patients w/Pneumovax at or over 65 yrs",56)
  1.  S X=X_": "_$$C(BIV(16),0,8)
  1.  I BIV(14) S X=X_$J((BIV(16)/BIV(14))*100,7,1)
  1.  D WRITE(.BILINE,X)
  1.  ;
  1.  S X=$$PAD("    PNEUMOVAX: # patients w/Pneumovax ever",56)
  1.  S X=X_": "_$$C(BIV(17),0,8)
  1.  I BIV(14) S X=X_$J((BIV(17)/BIV(14))*100,7,1)
  1.  D WRITE(.BILINE,X,1)
  1.  ;
  1.  ;---> Now write total patients considered who had refusals.
  1.  N M,N S (M,N)=0 F  S M=$O(BITMP("REFUSALS",M)) Q:'M  S N=N+1
  1.  S X="  Total Patients included who had Refusals on record....:"_$J(N,8)
  1.  D WRITE(.BILINE,X,2)
  1.  ;
  1.  ;
  1.  ;
  1.  ;********** PATCH 12, v8.5, MAY 01,2016, IHS/CMI/MWR
  1.  ;---> New Composite Measures display.
  1.  ;
  1.  S X=$$PAD("  * * * NEW GPRA COMPOSITE MEASURE SECTION * * *")
  1.  D WRITE(.BILINE,X,1)
  1.  ;
  1.  S X=$$PAD("  Total Number of Patients ages 19 through 59 years",56)_": "
  1.  S X=X_$$C(BIV(18),0,8) D WRITE(.BILINE,X)
  1.  ;
  1.  S X=$$PAD("    Received 1 dose of Tdap ever",56)
  1.  S X=X_": "_$$C(BIV(19),0,8)
  1.  I BIV(18) S X=X_$J((BIV(19)/BIV(18))*100,7,1)
  1.  D WRITE(.BILINE,X)
  1.  ;
  1.  S X=$$PAD("    Received 1 dose of Tdap or Td <10 years",56)
  1.  S X=X_": "_$$C(BIV(20),0,8)
  1.  I BIV(18) S X=X_$J((BIV(20)/BIV(18))*100,7,1)
  1.  D WRITE(.BILINE,X)
  1.  ;
  1.  S X=$$PAD("    Received 1 dose Tdap ever AND Tdap or Td <10 years",56)
  1.  S X=X_": "_$$C(BIV(21),0,8)
  1.  I BIV(1) S X=X_$J((BIV(21)/BIV(18))*100,7,1)
  1.  D WRITE(.BILINE,X,1)
  1.  ;
  1.  ;
  1.  S X=$$PAD("  Total Number of Patients ages 60 through 64 years",56)_": "
  1.  S X=X_$$C(BIV(22),0,8) D WRITE(.BILINE,X)
  1.  ;
  1.  S X=$$PAD("    Received 1 dose of Tdap ever",56)
  1.  S X=X_": "_$$C(BIV(23),0,8)
  1.  I BIV(22) S X=X_$J((BIV(23)/BIV(22))*100,7,1)
  1.  D WRITE(.BILINE,X)
  1.  ;
  1.  S X=$$PAD("    Received 1 dose of Tdap or Td <10 years",56)
  1.  S X=X_": "_$$C(BIV(24),0,8)
  1.  I BIV(22) S X=X_$J((BIV(24)/BIV(22))*100,7,1)
  1.  D WRITE(.BILINE,X)
  1.  ;
  1.  S X=$$PAD("    Received 1 dose of Zoster ever",56)
  1.  S X=X_": "_$$C(BIV(25),0,8)
  1.  I BIV(22) S X=X_$J((BIV(25)/BIV(22))*100,7,1)
  1.  D WRITE(.BILINE,X)
  1.  ;
  1.  S X=$$PAD("    Received Tdap ever AND Tdap/Td <10 yrs AND Zoster",56)
  1.  S X=X_": "_$$C(BIV(26),0,8)
  1.  I BIV(22) S X=X_$J((BIV(26)/BIV(22))*100,7,1)
  1.  D WRITE(.BILINE,X,1)
  1.  ;
  1.  ;
  1.  S X=$$PAD("  Total Number of Patients 65 years and older",56)_": "
  1.  S X=X_$$C(BIV(27),0,8) D WRITE(.BILINE,X)
  1.  ;
  1.  S X=$$PAD("    Received 1 dose of Tdap ever",56)
  1.  S X=X_": "_$$C(BIV(28),0,8)
  1.  I BIV(27) S X=X_$J((BIV(28)/BIV(27))*100,7,1)
  1.  D WRITE(.BILINE,X)
  1.  ;
  1.  S X=$$PAD("    Received 1 dose of Tdap or Td <10 years",56)
  1.  S X=X_": "_$$C(BIV(29),0,8)
  1.  I BIV(27) S X=X_$J((BIV(29)/BIV(27))*100,7,1)
  1.  D WRITE(.BILINE,X)
  1.  ;
  1.  S X=$$PAD("    Received 1 dose of Zoster ever",56)
  1.  S X=X_": "_$$C(BIV(30),0,8)
  1.  I BIV(27) S X=X_$J((BIV(30)/BIV(27))*100,7,1)
  1.  D WRITE(.BILINE,X)
  1.  ;
  1.  S X=$$PAD("    Received 1 dose of Pneumo after 65 yrs OR last 5yrs",56)
  1.  S X=X_": "_$$C(BIV(31),0,8)
  1.  I BIV(27) S X=X_$J((BIV(31)/BIV(27))*100,7,1)
  1.  D WRITE(.BILINE,X)
  1.  ;
  1.  S X=$$PAD("    Received Tdap AND Tdap/Td <10y AND Zoster AND Pneumo",56)
  1.  S X=X_": "_$$C(BIV(32),0,8)
  1.  I BIV(27) S X=X_$J((BIV(32)/BIV(27))*100,7,1)
  1.  D WRITE(.BILINE,X,1)
  1.  ;
  1.  ;
  1.  S X=$$PAD("  Total Number of Patients 19 years and older",56)_": "
  1.  S X=X_$$C(BIV(33),0,8) D WRITE(.BILINE,X)
  1.  ;
  1.  S X=$$PAD("    Total Patients 19 years and older appropriately ",52)
  1.  D WRITE(.BILINE,X)
  1.  S X=$$PAD("    vaccinated per age recommendations",56)
  1.  S X=X_": "_$$C(BIV(34),0,8)
  1.  I BIV(33) S X=X_$J((BIV(34)/BIV(33))*100,7,1)
  1.  D WRITE(.BILINE,X,1)
  1.  ;**********
  1.  ;
  1.  S VALMCNT=BILINE
  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.  ;     3 - BIBLNK (opt) Number of blank lines to add after line sent.
  1.  ;
  1.  Q:'$D(BILINE)
  1.  D WL^BIW(.BILINE,"BIREPL1",$G(BIVAL),$G(BIBLNK))
  1.  ;
  1.  ;--->Set VALMCNT (Listman line count) for errors calls above.
  1.  S VALMCNT=BILINE
  1.  Q
  1.  ;
  1.  ;
  1. C(X,X2,X3) ;
  1.  D COMMA^%DTC
  1.  Q X
  1.  ;
  1.  ;
  1.  ;----------
  1. PAD(D,L,C) ;EP
  1.  Q $$PAD^BIUTL5($G(D),$G(L),".")