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

BIDUVLS1.m

Go to the documentation of this file. 
  1. BIDUVLS1 ;IHS/CMI/MWR - VIEW DUE LIST.; MAY 10, 2010
  1.  ;;8.5;IMMUNIZATION;;SEP 01,2011
  1.  ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
  1.  ;;  LIST TEMPLATE CODE FOR VIEWING PATIENTS.
  1.  ;;  PATCH 1: Corrects Patient Group for not displaying Age Range.  HDR+21
  1.  ;
  1.  ;
  1.  ;----------
  1. START(BIFDT,BINFO,BIPG,BIAG,BIT,BIVAL,BIDASH,BITITL,BIRPDT,BIBEN) ;EP
  1.  ;---> Display Immunizations Due List via Listman.
  1.  ;---> Parameters:
  1.  ;     1 - BIFDT  (req) Forecast/Clinic Date.
  1.  ;     2 - BINFO  (req) Array of Additional Information elements for each patient.
  1.  ;     3 - BIPG   (req) Patient Group Data; see PGRPOUP1^BIOUTPT4 for details.
  1.  ;     4 - BIAG   (opt) Age Range.  If 2nd ^-piece=1, display "years."
  1.  ;     5 - BIT    (req) Total Patients retrieved.
  1.  ;     6 - BIVAL  (opt) Value indicates which patients:
  1.  ;                      0=All, 1=Rejects only, 2=Appropriate only.
  1.  ;     7 - BIDASH (opt) 1=Omit Dash line between records; 0=include it.
  1.  ;     8 - BITITL (opt) Report Name, if present will replace "Clinic Date"
  1.  ;                      in report header.
  1.  ;     9 - BIRPDT (opt) Report Date: Today unless passed from reports
  1.  ;                                   (e.g., Quarterly Report).
  1.  ;    10 - BIBEN  (req) Beneficiary Type array: either BIBEN(1) or BIBEN("ALL").
  1.  ;
  1.  ;----------
  1. MAIN ;EP
  1.  ;---> Listman Screen for printing Immunization Due Letters.
  1.  D SETVARS^BIUTL5
  1.  S:'$G(BIFDT) BIFDT=DT
  1.  S:'$G(BIRPDT) BIRPDT=DT
  1.  N VALMCNT
  1.  D EN
  1.  D EXIT
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. EN ;EP
  1.  ;---> Main entry point.
  1.  D EN^VALM("BI DUE LIST VIEW")
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. HDR ;EP
  1.  ;---> Header code
  1.  I '$D(BIPG) D ERRCD^BIUTL2(620,,1) S VALMQUIT="" Q
  1.  K VALMHDR
  1.  N BIDASH,BILINE,X,Y,Z S BILINE=0
  1.  S:'$G(BIRPDT) BIRPDT=DT
  1.  ;
  1.  S X="WARNING: Confidential Patient Information, Privacy Act applies."
  1.  D CENTERT^BIUTL5(.X)
  1.  D WH^BIW(.BILINE,X,1)
  1.  ;
  1.  S X=$$REPHDR^BIUTL6(DUZ(2)),BIDASH=$L(X)+2 D CENTERT^BIUTL5(.X)
  1.  D WH^BIW(.BILINE,X)
  1.  S X=$$SP^BIUTL5(BIDASH,"-") D CENTERT^BIUTL5(.X)
  1.  D WH^BIW(.BILINE,X)
  1.  ;
  1.  S X="       Report Date: "_$$TXDT1^BIUTL5(BIRPDT)
  1.  S X=X_"        Total Patients: "_$G(BIT)
  1.  ;
  1.  D:$G(BIAG)]""
  1.  .;---> For Patient Group (8=Search Template) to not display Age Range.
  1.  .Q:(+BIPG=8)
  1.  .I BIAG="ALL" S X=X_"  (All Ages)" Q
  1.  .S X=X_" ("_$$MTHYR^BIAGE(BIAG)_")"
  1.  I +BIPG'=8 S X=X_" *"_$S($D(BIBEN("ALL")):"All",1:"01")
  1.  D WH^BIW(.BILINE,X)
  1.  ;
  1.  D
  1.  .I $G(BITITL)]"" S X="      Report Title: "_$$PAD^BIUTL5(BITITL,11) Q
  1.  .I $G(BINFO)["5," S X="       Clinic Date: "_$$TXDT1^BIUTL5(BIFDT) Q
  1.  .S X=""
  1.  ;
  1.  N BIHEAD,BIPG1
  1.  D PGRP^BIDU(BIPG,.BIPG1)
  1.  S BIHEAD="Patient Group: "
  1.  D
  1.  .I X]"",$L(BIHEAD_BIPG1)<41 D  Q
  1.  ..S X=X_$$SP^BIUTL5(9)_BIHEAD_BIPG1 D WH^BIW(.BILINE,X)
  1.  .;---> If Clinic Date & Patient Group won't fit, write Clinic Date and go on.
  1.  .I X]"" D WH^BIW(.BILINE,X)
  1.  .;---> Now write Patient Group info on the next line(s).
  1.  .N I,N,V,Z S N=1,V=",",X="",BIHEAD="     "_BIHEAD
  1.  .F  D  Q:$P(BIPG1,V,I)=""  Q:$G(BIERR)
  1.  ..F I=N:1 S X=$P(BIPG1,V,N,I) Q:$L(X)>60  Q:$P(BIPG1,V,I)=""
  1.  ..I N>1 S BIHEAD=$$SP^BIUTL5(19)
  1.  ..D WH^BIW(.BILINE,BIHEAD_$P(BIPG1,V,N,I-1))
  1.  ..S N=I
  1.  ;
  1.  ;---> If necessary, write a dashed line for subheader,
  1.  ;---> otherwise write a blank line.
  1.  N I K X
  1.  F I="CC","CM","DPRV","MMR","MMD","HCF","LOT" D
  1.  .I $O(@("BI"_I_"(0)")) S X=1
  1.  D WH^BIW(.BILINE,$S($G(X):$$SP^BIUTL5(79,"-"),1:""))
  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,,11)
  1.  .I $G(BIERR) D ERRCD^BIUTL2(BIERR,.X) D WH^BIW(.BILINE,X) Q
  1.  .;
  1.  .;---> If specific Case Managers, print Case Manager subheader.
  1.  .D SUBH^BIOUTPT5("BICM","Case Manager",,"^VA(200,",.BILINE,.BIERR,,11)
  1.  .I $G(BIERR) D ERRCD^BIUTL2(BIERR,.X) D WH^BIW(.BILINE,X) Q
  1.  .;
  1.  .;---> If specific Designated Providers, print Designated Provider subheader.
  1.  .D SUBH^BIOUTPT5("BIDPRV","Designated Provider",,"^VA(200,",.BILINE,.BIERR,,11)
  1.  .I $G(BIERR) D ERRCD^BIUTL2(BIERR,.X) D WH^BIW(.BILINE,X) Q
  1.  .;
  1.  .;---> If specific Immunizations Received, print subheader.
  1.  .S X="Immunization Rcvd",Y="Immunizations Rcvd"
  1.  .I $G(BIRDT) N Z S Z=" "_$$DATE^BIDU(BIRDT,1)
  1.  .D SUBH^BIOUTPT5("BIMMR",X,Y,"^AUTTIMM(",.BILINE,.BIERR,2,11,$G(Z))
  1.  .I $G(BIERR) D ERRCD^BIUTL2(BIERR,.X) D WH^BIW(.BILINE,X) Q
  1.  .;
  1.  .;---> If specific Immunizations Due, print subheader.
  1.  .S X="Immunization Due",Y="Immunizations Due"
  1.  .D SUBH^BIOUTPT5("BIMMD",X,Y,"^AUTTIMM(",.BILINE,.BIERR,2,11)
  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,,11)
  1.  .I $G(BIERR) D ERRCD^BIUTL2(BIERR,.X) D WH^BIW(.BILINE,X) Q
  1.  .;
  1.  .;---> If specific Lot Numbers, print subheader.
  1.  .D SUBH^BIOUTPT5("BILOT","Lot Number",,"^AUTTIML(",.BILINE,.BIERR,,11)
  1.  .I $G(BIERR) D ERRCD^BIUTL2(BIERR,.X) D WH^BIW(.BILINE,X) Q
  1.  ;
  1.  ;
  1.  ;---> Build Column Headers.
  1.  N BICOL S BICOL="  Name                HRCN#     DOB"
  1.  D
  1.  .I BIFDT'=DT D  Q
  1.  ..S BICOL=BICOL_" & Age on "_$$TXDT1^BIUTL5(BIFDT)_"  Current Community"
  1.  .;"Age Today" vvv83
  1.  .S BICOL=BICOL_"        Age Today  Sex Current Community"
  1.  S BICOL=$$PAD^BIUTL5(BICOL,80)
  1.  ;
  1.  ;---> Set Column Headers for Listman.
  1.  S:$D(VALMCAP) VALMCAP=BICOL
  1.  ;
  1.  ;---> If Header array is being built for Listmananger,
  1.  ;---> reset display window margins for Communities, etc. and quit.
  1.  I $D(VALM("BM")) D  Q
  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.  ;
  1.  ;---> If Header array is being built for a printout, write
  1.  ;---> in the column headers.
  1.  D WH^BIW(.BILINE,BICOL)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. INIT ;EP
  1.  ;---> Initialize variables and list array.
  1.  S VALM("TITLE")=$$LMVER^BILOGO
  1.  N BILINE,BI31,X S BILINE=0,BI31=$C(31)_$C(31)
  1.  S:'$D(BINFO) BINFO(0)=0
  1.  I '$D(BIPG) D ERRCD^BIUTL2(620,,1) S VALMQUIT="" Q
  1.  ;
  1.  ;
  1.  ;---> Loop through ^TMP("BIDUL",$J,...,BIDFN) adding patients to list.
  1.  ;---> Seed loops with -1 to pick up entries with a subscript of 0. Imm v8.5.
  1.  N BIDFN,N,M,P
  1.  S N=-1
  1.  F  S N=$O(^TMP("BIDUL",$J,N)) Q:N=""  D
  1.  .S M=-1
  1.  .F  S M=$O(^TMP("BIDUL",$J,N,M)) Q:M=""  D
  1.  ..S P=-1
  1.  ..F  S P=$O(^TMP("BIDUL",$J,N,M,P)) Q:P=""  D
  1.  ...N BIVAL1
  1.  ...S BIDFN=0
  1.  ...F  S BIDFN=$O(^TMP("BIDUL",$J,N,M,P,BIDFN)) Q:'BIDFN  S BIVAL1=^(BIDFN) D
  1.  ....;---> BIVAL=0=All (no filter), 1=Rejects, 2=Appropriate.
  1.  ....I $G(BIVAL) Q:BIVAL'=BIVAL1
  1.  ....N N,M,P
  1.  ....;---> Write line to ^TMP("BIDULV",$J,BILINE,0)=BIVAL global.
  1.  ....D PATIENT^BIDUVLS2(.BILINE,BIDFN,.BINFO,$G(BIDASH),.BIMMRF,.BIMMLF)
  1.  ;
  1.  ;---> If no records were found to match, report it.
  1.  D:'$G(BIT)
  1.  .D WRITE^BIDUVLS2(.BILINE)
  1.  .N X S X="     No Patient Records match the selected criteria."
  1.  .D WRITE^BIDUVLS2(.BILINE,X)
  1.  ;
  1.  ;---> Finish up Listmanager List Count.
  1.  S VALMCNT=BILINE
  1.  D ZSAVES^BIUTL3
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. RESET ;EP
  1.  ;---> Update partition for return to Listmanager.
  1.  I $D(VALMQUIT) S VALMBCK="Q" Q
  1.  D TERM^VALM0 S VALMBCK="R"
  1.  D INIT Q
  1.  ;
  1.  ;
  1.  ;----------
  1. PRINTVW ;EP
  1.  ;---> Print Due List from View Screen.  (No queueing.)
  1.  ;---> Called by Protocol BI DUE LIST VIEW PRINT from
  1.  ;---> Menu Protocol BI MENU DUE LIST VIEW.
  1.  ;
  1.  D
  1.  .N BIPOP W !?3,"Printout may not be queued at this point."
  1.  .D ZIS^BIUTL2(.BIPOP)
  1.  .Q:$G(BIPOP)
  1.  .D PRTLST^BIUTL8("BIDULV")
  1.  S VALMBCK="R"
  1.  D RE^VALM4
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. HELP ;EP
  1.  ;---> Help code.
  1.  N BIX S BIX=X
  1.  D FULL^VALM1
  1.  W !!?5,"Use arrow keys to scroll up and down through the list, or"
  1.  W !?5,"type ""??"" for more actions, such as Search and Print List."
  1.  D DIRZ^BIUTL3("","     Press ENTER/RETURN to continue")
  1.  D:BIX'="??" RE^VALM4
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. EXIT ;EP
  1.  ;---> Cleanup, EOJ.
  1.  K ^TMP("BIDULV",$J)
  1.  Q