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

BIDU.m

Go to the documentation of this file. 
  1. BIDU ;IHS/CMI/MWR - DUE LIST/LETTERS, MAIN DRIVER; AUG 10,2010
  1.  ;;8.5;IMMUNIZATION;;SEP 01,2011
  1.  ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
  1.  ;;  LIST TEMPLATE CODE FOR DUE LISTS, VIEWING & PRINTING LETTERS.
  1.  ;;  PATCH 1: Fix so that user's DUZ(0) is not always included  INIT+86
  1.  ;
  1.  ;----------
  1. START ;EP
  1.  ;---> Listman Screen for printing Immunization Due Letters.
  1.  ;
  1.  ;---> If Vaccine Table is not standard, display Error Text and quit.
  1.  I $D(^BISITE(-1)) D ERRCD^BIUTL2(503,,1) Q
  1.  ;
  1.  D SETVARS^BIUTL5 N BIRTN
  1.  N BINFO
  1.  D ADDINFO
  1.  D EN
  1.  D EXIT,KILLALL^BIUTL8(1)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. EN ;EP
  1.  ;---> Main entry point for DUE LISTS & LETTERS.
  1.  D EN^VALM("BI DUE LISTS & LETTERS")
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. HDR ;EP
  1.  N BILINE,X,Y S BILINE=0 K VALMHDR
  1.  D WH^BIW(.BILINE)
  1.  S X=IOUON_"IMMUNIZATION LISTS & LETTERS" D CENTERT^BIUTL5(.X,42)
  1.  D WH^BIW(.BILINE,X_IOINORM)
  1.  ;D EN^VALM("BI DUE LISTS & LETTERS")
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. INIT ;EP
  1.  ;---> Initialize variables and list array.
  1.  ;---> Variables set by this Init and reside in the local symbol table
  1.  ;---> for use by other List Templates are defined as follows:
  1.  ;---> Variables:
  1.  ;     1 - BIAG   (req) Age Range^Mths/Yrs (See description in ^BIAGE.)
  1.  ;     2 - BIPG   (req) Patient Group Data; see PGRPOUP1^BIOUTPT4 for details.
  1.  ;     3 - BIFDT  (req) Forecast date.
  1.  ;     4 - BICC   (req) Current Community array.
  1.  ;     5 - BICM   (req) Case Manager array.
  1.  ;     6 - BIMMR  (req) Immunizations Received array.
  1.  ;     7 - BIMMD  (req) Immunizations Due array.
  1.  ;     8 - BIHCF  (req) Health Care Facility array.
  1.  ;     9 - BILOT  (req) Lot Number array.
  1.  ;    10 - BIORD  (req) Order of listing.
  1.  ;    11 - BINFO  (ret) Additional Information (not set here).
  1.  ;    12 - BIRDT  (opt) Date Range for Received Imms (form BEGDATE:ENDDATE).
  1.  ;    13 - BIDED  (opt) Include Deceased Patients (0=no, 1=yes).
  1.  ;    14 - BIT    (ret) Total Patients retrieved (not set here).
  1.  ;    15 - BIMD   (req) Minimum Interval days since last letter.
  1.  ;    16 - BIDPRV (req) Designated Provider array.
  1.  ;    17 - BIBEN  (req) Beneficiary Type array: either BIBEN(1) or BIBEN("ALL").
  1.  ;
  1.  ;---> NOTE: For programming work in any of the BIDU* routines,
  1.  ;--->       it is helpful to printscreen the comments (from INIT here)
  1.  ;--->       to use as a guide for the meaning of BI* variables.
  1.  ;
  1.  ;
  1.  S VALM("TITLE")=$$LMVER^BILOGO
  1.  S VALMSG="Select a left column number to change an item."
  1.  K ^TMP("BIDU",$J)
  1.  N BILINE,X S BILINE=0
  1.  ;
  1.  ;---> Date.
  1.  S:'$G(BIFDT) BIFDT=DT
  1.  D DATE^BIREP(.BILINE,"BIDU",1,$G(BIFDT),"Date of Forecast/Clinic",0,2,32)
  1.  ;
  1.  ;---> Age Range.
  1.  S:$G(BIAG)="" BIAG="1-72"
  1.  N BIAG1
  1.  D
  1.  .I +$G(BIPG)=8 S BIAG1="(set by Search Template)" Q
  1.  .I BIAG="ALL" S BIAG1="All Ages" Q
  1.  .S BIAG1=$$MTHYR^BIAGE(BIAG)
  1.  S X="   2 - Age Range................: "_BIAG1
  1.  D WRITE(.BILINE,X)
  1.  K X
  1.  ;
  1.  ;---> Patient Group.
  1.  N BIHEAD,BIPG1 S:'$G(BIPG) BIPG=3
  1.  D PGRP(BIPG,.BIPG1)
  1.  ;
  1.  ;---> If Beneficiary is undefined, default to Am Indian/AK Native.
  1.  S:'$D(BIBEN) BIBEN(1)=""
  1.  S BIHEAD="   3 - Patient Group ("_$S($D(BIBEN("ALL")):"all)",1:"01).")_"......: "
  1.  D
  1.  .I $L(BIHEAD_BIPG1)<46 S X=BIHEAD_BIPG1 D WRITE(.BILINE,X) Q
  1.  .N I,N,V,Z S N=1,V=",",X=""
  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)>46  Q:$P(BIPG1,V,I)=""
  1.  ..I N>1 S BIHEAD=$$SP^BIUTL5(33)
  1.  ..D WRITE(.BILINE,BIHEAD_$P(BIPG1,V,N,I-1))
  1.  ..S N=I
  1.  D WRITE(.BILINE)
  1.  K X
  1.  ;
  1.  ;---> Current Community.
  1.  D DISP^BIREP(.BILINE,"BIDU",.BICC,"Community",4,1,0,2,32)
  1.  K X
  1.  ;
  1.  ;---> Case Manager.
  1.  D DISP^BIREP(.BILINE,"BIDU",.BICM,"Case Manager",5,3,0,2,32)
  1.  ;
  1.  ;---> Designated Provider.
  1.  D DISP^BIREP(.BILINE,"BIDU",.BIDPRV,"Designated Provider",6,3,0,2,32)
  1.  ;
  1.  ;---> Immunization Received.
  1.  N A,B,C S A="Immunizations Received",B="Immunizations"
  1.  ;---> C=Date Range of Received Imms (form BEGDATE:ENDDATE).
  1.  I $G(BIRDT) S C=$$DATE(BIRDT,1)
  1.  D DISP^BIREP(.BILINE,"BIDU",.BIMMR,A,7,6,0,2,32,B,$G(C)) K A,B,C
  1.  ;
  1.  ;---> Immunization Due.
  1.  N A,B S A="Immunizations"_$S($P(BIPG,U)[2:" Past",1:"")_" Due",B="Immunizations"
  1.  D DISP^BIREP(.BILINE,"BIDU",.BIMMD,A,8,6,0,2,32,B) K A,B
  1.  ;
  1.  ;---> Health Care Facility.
  1.  N A,B S A="Health Care Facility",B="Facilities"
  1.  ;
  1.  ;********** PATCH 1, v8.4, AUG 01,2010, IHS/CMI/MWR
  1.  ;---> Fix so that user's DUZ(0) is not always included
  1.  ;S:$G(DUZ(2)) BIHCF(DUZ(2))=""
  1.  I '$O(BIHCF(0)),$G(DUZ(2)) S BIHCF(DUZ(2))=""
  1.  ;**********
  1.  ;
  1.  D DISP^BIREP(.BILINE,"BIDU",.BIHCF,A,9,2,0,2,32,B) K A,B
  1.  ;
  1.  ;---> Lot Number.
  1.  D DISP^BIREP(.BILINE,"BIDU",.BILOT,"Lot Number",10,7,1,2,32)
  1.  ;
  1.  ;
  1.  ;---> Additional Information.
  1.  N BINFO1
  1.  D
  1.  .N BIHEAD S BIHEAD="  11 - Additional Information...: "
  1.  .I $D(BINFO("ALL")) D WRITE(.BILINE,BIHEAD_"See list") Q
  1.  .I $O(BINFO(0))="" D WRITE(.BILINE,BIHEAD_"None") Q
  1.  .;
  1.  .;---> Display selections.
  1.  .N N S N=""
  1.  .F  S N=$O(BINFO(N)) Q:'N  D
  1.  ..Q:('$D(^BIADDIN(N,0)))
  1.  ..S BINFO1=$G(BINFO1)_$S($G(BINFO1)]"":", ",1:"")_$P(^BIADDIN(N,0),U,3)
  1.  .;
  1.  .;---> Now write the pieces up to 46 characters wide.
  1.  .N I,N,V,Z S N=1,V=",",X=""
  1.  .F  D  Q:$P(BINFO1,V,I)=""
  1.  ..F I=N:1 S X=$P(BINFO1,V,N,I) Q:$L(X)>46  Q:$P(BINFO1,V,I)=""
  1.  ..I N>1 S BIHEAD=$$SP^BIUTL5(33)
  1.  ..D WRITE(.BILINE,BIHEAD_$P(BINFO1,V,N,I-1))
  1.  ..S N=I
  1.  K X
  1.  ;
  1.  ;
  1.  ;---> Order of Listing.
  1.  S:'$G(BIORD) BIORD=1
  1.  ;
  1.  N X S X="Patient Age"
  1.  S X=X_"^Patient Name (alphabetically)"
  1.  S X=X_"^Patient Chart#"
  1.  S X=X_"^Case Manager"
  1.  S X=X_"^Case Manager, then Community"
  1.  S X=X_"^Community, then Case Manager"
  1.  S X=X_"^Community, then Patient Age"
  1.  S X=X_"^Community, then Patient Name"
  1.  S X=X_"^Community, then Patient Chart#"
  1.  S X=X_"^Zipcode, then Patient Name"
  1.  S X=X_"^Designated Provider"
  1.  ;
  1.  N BIORD1 S BIORD1="by "_$P(X,U,BIORD)
  1.  S X="  12 - Order of Listing.........: "_BIORD1
  1.  D WRITE(.BILINE,X)
  1.  K X
  1.  ;
  1.  ;---> Include Deceased.
  1.  N BIDED1 S BIDED1=""
  1.  S:'$D(BIDED) BIDED=0
  1.  S BIDED1=$S(BIDED:"Yes",1:"No")
  1.  S X="  13 - Include Deceased.........: "_BIDED1
  1.  D WRITE(.BILINE,X)
  1.  K X
  1.  ;
  1.  ;---> Finish up Listmanager List Count.
  1.  S VALMCNT=BILINE,BIRTN="BIDU"
  1.  S:VALMCNT>16 VALMSG="Scroll down to view more Parameters. Type ?? help."
  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,"BIDU",$G(BIVAL),$G(BIBLNK))
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. PGRP(BIPG,BIPG1) ;EP
  1.  ;---> Return text of Patient Group.
  1.  ;---> Parameters:
  1.  ;     1 - BIPG  (req) Patient Group Data; see PGRPOUP1^BIOUTPT4 for details.
  1.  ;     2 - BIPG1 (ret) Value/text of line (Null=blank line).
  1.  ;
  1.  ;---> If BIPG=null, return unknown.
  1.  I $G(BIPG)="" S BIPG1="Unknown" Q
  1.  ;
  1.  ;---> If BIPG="some text", simply return it.
  1.  I +BIPG=0 S BIPG1=BIPG Q
  1.  ;
  1.  I $P(BIPG,U)=8 S BIPG1="Search Template: "_$P($G(^DIBT(+$P(BIPG,U,8),0)),U) Q
  1.  ;
  1.  N I,X S BIPG1=""
  1.  S X="Due^Past Due^Active^Inactive^Auto-Activated^Refusals^Females Only^Search Template"
  1.  F I=1,2,3,4,5,6,7,8 D
  1.  .I $P(BIPG,U)[I S BIPG1=$G(BIPG1)_$S(BIPG1]"":", ",1:"")_$P(X,U,I)
  1.  .;---> If 2 - Past Due, add "months Past Due".
  1.  .I I=2,$P(BIPG,U)[2,$P(BIPG,U,2) S BIPG1=BIPG1_" ("_$P(BIPG,U,2)_" mths)" Q
  1.  .I I=4,$P(BIPG,U)[4,($P(BIPG,U,4)]"") S BIPG1=BIPG1_$$DATE(BIPG,4)
  1.  .I I=5,$P(BIPG,U)[5,($P(BIPG,U,5)]"") S BIPG1=BIPG1_$$DATE(BIPG,5)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. DATE(BIPG,BIGRP) ;EP
  1.  ;---> Return external form of date for Group Date Range in slash format.
  1.  ;---> Parameters:
  1.  ;     1 - BIPG  (req) Patient Group Data; see PGRPOUP1^BIOUTPT4 for details.
  1.  ;     2 - BIGRP (req) Patient Group.
  1.  ;
  1.  Q:'$G(BIPG) "NO DATE"  Q:'$G(BIGRP) "NO DATE"
  1.  N BIX,BIY,BIZ S BIX=""
  1.  S BIY=$P($P(BIPG,U,BIGRP),":",1)
  1.  S BIZ=$P($P(BIPG,U,BIGRP),":",2)
  1.  ;
  1.  ;---> If dates are default (1/1/1900 and TODAY), don't display date range.
  1.  Q:(BIY=2000101&(BIZ=$G(DT))) BIX
  1.  ;
  1.  S BIX=" ("_$$SLDT2^BIUTL5(BIY)_" to "
  1.  S BIX=BIX_$$SLDT2^BIUTL5(BIZ)_")"
  1.  Q BIX
  1.  ;
  1.  ;
  1.  ;----------
  1. ADDINFO ;EP
  1.  ;---> BIDUZF=User-File# identifier to store and retrieve
  1.  ;---> previous lists of selections from this file.
  1.  N BIDUZF S BIDUZF=+$G(DUZ)_"-"_9002084.82
  1.  ;
  1.  I $D(^BISELECT("B",BIDUZF)) D
  1.  .N BIDA S BIDA=$O(^BISELECT("B",BIDUZF,0))
  1.  .Q:'BIDA  Q:$G(^BISELECT(BIDA,0))=""
  1.  .Q:'$O(^BISELECT(BIDA,1,0))
  1.  .N Y S Y=0
  1.  .F  S Y=$O(^BISELECT(BIDA,1,Y)) Q:Y=""  D
  1.  ..S BINFO(Y)=""
  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. EXIT ;EP
  1.  ;---> EOJ cleanup.
  1.  K ^TMP("BIDU",$J)
  1.  D CLEAR^VALM1
  1.  D FULL^VALM1
  1.  Q