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

BIREP.m

Go to the documentation of this file. 
  1. BIREP ;IHS/CMI/MWR - REPORT, GENERIC DISPLAYS; MAY 10, 2010
  1.  ;;8.5;IMMUNIZATION;;SEP 01,2011
  1.  ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
  1.  ;;  GENERIC DISPLAY TEXT FOR REPORTS.
  1.  ;
  1.  ;
  1.  ;----------
  1. DISP(BILINE,BINOD,BIAR,BIITEM,BIMENU,BINDX,BIAL,BINDNT,BITAB2,BIITEM2,BIAPP) ;EP
  1.  ;---> Display Report Parameter Setting on report menu.
  1.  ;---> Parameters:
  1.  ;     1 - BILINE  (ret) Last line# written.
  1.  ;     2 - BINOD   (req) Node in ^TMP to store lines under.
  1.  ;     3 - BIAR    (opt) Local array of IEN's for this parameter
  1.  ;                       (BICC, BIHCF, etc.)
  1.  ;     4 - BIITEM  (req) Generic name of item.
  1.  ;     5 - BIMENU  (req) The Menu Number of this parameter.
  1.  ;     6 - BINDX   (req) The index of call (below) for text of a single entry.
  1.  ;     7 - BIAL    (opt) Add additional linefeeds after paramter
  1.  ;                       display. (Default is 1.)
  1.  ;     8 - BINDNT  (opt) Left indent (default=4).
  1.  ;     9 - BITAB2  (opt) Second tab postion where ":" occurs (default=36).
  1.  ;    10 - BIITEM2 (opt) Generic item name in "# Items Selected" prompt.
  1.  ;    11 - BIAPP   (opt) Text to append to display line (such as date range)
  1.  ;                       or on new line below at same ":" tab.
  1.  ;
  1.  I '$D(BILINE)!('$D(BINOD))!('$D(BIITEM))!('$D(BIMENU)) D  Q
  1.  .D ERRCD^BIUTL2(669,,1)
  1.  ;
  1.  N BIAR1,BIITEMS,I,X S BIAR1=""
  1.  S:'$G(BINDX) BINDX=0
  1.  S:'$G(BINDNT) BINDNT=4
  1.  S:'$G(BITAB2) BITAB2=36
  1.  ;---> Get plural form of item name.
  1.  D PLURAL^BISELECT(BIITEM,.BIITEMS)
  1.  D
  1.  .S:'$D(BIAR) BIAR("ALL")=""
  1.  .I $D(BIAR("ALL")) S BIAR1="ALL" Q
  1.  .N I,M,N,P S (N,P)=0
  1.  .F I=0:1 S N=$O(BIAR(N)) Q:'N  S M=N,P=P+1
  1.  .;---> If only one item, get the text of its name.
  1.  .I I=1&(BINDX=1) S BIAR1=$$CCTX^BIUTL6(M) Q
  1.  .I I=1&(BINDX=2) S BIAR1=$$INSTTX^BIUTL6(M) Q
  1.  .I I=1&(BINDX=3) S BIAR1=$$PERSON^BIUTL1(M) Q
  1.  .I I=1&(BINDX=4) S BIAR1=$$BENTX^BIUTL6(M) Q
  1.  .I I=1&(BINDX=5) S BIAR1=$$CCTX^BIUTL6(M) Q
  1.  .I I=1&(BINDX=6) S BIAR1=$$VNAME^BIUTL2(M) Q
  1.  .I I=1&(BINDX=7) S BIAR1=$$LOTTX^BIUTL6(M) Q
  1.  .;---> Prototype line for new calls:
  1.  .;I I=1&(BINDX=6) S BIAR1=$$CALL^ROUTINE(M) Q
  1.  .S BIAR1=P_" "_$S(I=1:BIITEM,$D(BIITEM2):BIITEM2,1:BIITEMS)_" selected."
  1.  ;
  1.  S X="" F I=1:1:BINDNT S X=X_" "
  1.  S X=X_$S(BIMENU>9:"",1:" ")_BIMENU_" - "_BIITEM
  1.  S X=$$PAD^BIUTL5(X,BITAB2,".")_": "_BIAR1
  1.  ;
  1.  ;---> If there's something to append and it fits, append it; if the resulting
  1.  ;---> line would be too long, then write the append on a second line after.
  1.  ;---> Killing BIAPP signals that it was appended and does not need another line.
  1.  I $G(BIAPP)]"",$L(X_BIAPP)<78 S X=X_BIAPP K BIAPP
  1.  ;
  1.  ;---> If additional blank lines were to be added, add them to the append.
  1.  I $G(BIAPP)]"",$G(BIAL) N BIAL1 S BIAL1=BIAL,BIAL=0
  1.  ;
  1.  D WL^BIW(.BILINE,BINOD,X,$S($D(BIAL):+BIAL,1:1))
  1.  ;---> If there's something to append and it did not fit, write a second line.
  1.  I $G(BIAPP)]"" S X=BIAPP,X=$$SP^BIUTL5(BITAB2+1)_X D WL^BIW(.BILINE,BINOD,X,$G(BIAL1))
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. DATE(BILINE,BINOD,BIMENU,BIDT,BIDTTX,BIAL,BINDNT,BITAB2,BISL) ;EP
  1.  ;---> Display Report Parameter Date Range.
  1.  ;---> Parameters:
  1.  ;     1 - BILINE  (ret) Last line# written.
  1.  ;     2 - BINOD   (req) Node in ^TMP to store lines under.
  1.  ;     3 - BIMENU  (req) The Menu Number of this parameter.
  1.  ;     4 - BIDT    (opt) Date.
  1.  ;     5 - BIDTTX  (opt) Text describing date.
  1.  ;     6 - BIAL    (opt) Add additional linefeeds after paramter
  1.  ;                       display. (Default is 1.)
  1.  ;     7 - BINDNT  (opt) Left indent (default=4).
  1.  ;     8 - BITAB2  (opt) Second tab postion where ":" occurs (default=36).
  1.  ;     9 - BISL    (opt) If BISL=1 return slash dates.
  1.  ;
  1.  I '$D(BILINE)!('$D(BINOD))!('$D(BIMENU)) D  Q
  1.  .D ERRCD^BIUTL2(669,,1)
  1.  ;
  1.  S:'$G(BINDNT) BINDNT=4 S:'$G(BITAB2) BITAB2=36
  1.  N X D WL^BIW(.BILINE,BINOD)
  1.  S X="" F I=1:1:BINDNT S X=X_" "
  1.  S X=X_$S(BIMENU>9:"",1:" ")_BIMENU_" - "_$G(BIDTTX)
  1.  S X=$$PAD^BIUTL5(X,BITAB2,".")_": "
  1.  S:$G(BIDT) X=X_$S($G(BISL):$$SLDT1^BIUTL5(BIDT),1:$$TXDT1^BIUTL5(BIDT))
  1.  D WL^BIW(.BILINE,BINOD,X,$S($D(BIAL):+BIAL,1:1))
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. DATERNG(BILINE,BINOD,BIMENU,BIBEGDT,BIENDDT,BIAL,BIONELN,BISL) ;EP
  1.  ;---> Display Report Parameter Date Range.
  1.  ;---> Parameters:
  1.  ;     1 - BILINE  (ret) Last line# written.
  1.  ;     2 - BINOD   (req) Node in ^TMP to store lines under.
  1.  ;     3 - BIMENU  (req) The Menu Number of this parameter.
  1.  ;     4 - BIBEGDT (opt) Begin date of report.
  1.  ;     5 - BIENDDT (opt) End date of report.
  1.  ;     6 - BIAL    (opt) Add additional linefeeds after paramter
  1.  ;                       display. (Default is 1.)
  1.  ;     7 - BIONELN (opt) Write beginning and end date on one line.
  1.  ;     8 - BISL    (opt) If BISL=1 return slash dates.
  1.  ;
  1.  I '$D(BILINE)!('$D(BINOD))!('$D(BIMENU)) D  Q
  1.  .D ERRCD^BIUTL2(669,,1)
  1.  ;
  1.  D WL^BIW(.BILINE,BINOD,,1)
  1.  S:'$G(BIBEGDT) BIBEGDT="" S:'$G(BIENDDT) BIENDDT=""
  1.  N X S X="    "_$S(BIMENU>9:"",1:" ")_BIMENU_" - Date Range............."
  1.  ;
  1.  ;---> If not "one line" display, split Date Range into two lines.
  1.  D
  1.  .I '$G(BIONELN) D  Q
  1.  ..S X=X_"from: "_$S($G(BISL):$$SLDT1^BIUTL5(BIBEGDT),1:$$TXDT1^BIUTL5(BIBEGDT))
  1.  ..D WL^BIW(.BILINE,BINOD,X)
  1.  ..S X="                                  to: "
  1.  .S X=X_"....: "_$S($G(BISL):$$SLDT1^BIUTL5(BIBEGDT),1:$$TXDT1^BIUTL5(BIBEGDT))
  1.  .S X=X_" - "
  1.  S X=X_$S($G(BISL):$$SLDT1^BIUTL5(BIENDDT),1:$$TXDT1^BIUTL5(BIENDDT))
  1.  D WL^BIW(.BILINE,BINOD,X,$S($D(BIAL):+BIAL,1:1))
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. VTYPE(BILINE,BINOD,BIAR,BIMENU,BIAL) ;EP
  1.  ;---> Display Report Parameter Visit Type.
  1.  ;---> Parameters:
  1.  ;     1 - BILINE  (ret) Last line# written.
  1.  ;     2 - BINOD   (req) Node in ^TMP to store lines under.
  1.  ;     3 - BIAR    (opt) Local array of pieces of Visit Type (set of codes).
  1.  ;     4 - BIMENU  (req) The Menu Number of this parameter.
  1.  ;     5 - BIAL    (opt) Add additional linefeeds after paramter
  1.  ;                       display. (Default is 1.)
  1.  ;
  1.  I '$D(BILINE)!('$D(BINOD)!('$D(BIMENU))) D  Q
  1.  .D ERRCD^BIUTL2(669,,1)
  1.  ;
  1.  N BIAR1,BIITEM,BIITEMS,X S BIAR1="",BIITEM="Visit Type"
  1.  ;---> Get plural form of item name.
  1.  D PLURAL^BISELECT(BIITEM,.BIITEMS)
  1.  D
  1.  .S:'$D(BIAR) BIAR("ALL")=""
  1.  .I $D(BIAR("ALL")) S BIAR1="ALL" Q
  1.  .N I,M,N,P
  1.  .S (N,P)=0
  1.  .F I=0:1 S N=$O(BIAR(N)) Q:N=""  S M=N,P=P+1
  1.  .I I=1 D  Q
  1.  ..N BISET S BISET=$P(^DD(9000010,.03,0),U,3)
  1.  ..S BIAR1=$P($P(BISET,M_":",2),";") Q
  1.  .S BIAR1=P_" "_$S(I=1:BIITEM,1:BIITEMS)_" selected."
  1.  ;
  1.  S X="    "_$S(BIMENU>9:"",1:" ")_BIMENU_" - "_BIITEM
  1.  S X=$$PAD^BIUTL5(X,36,".")_": "_BIAR1
  1.  D WL^BIW(.BILINE,BINOD,X,$S($D(BIAL):+BIAL,1:1))
  1.  Q
  1.  ;
  1.  ;
  1. EXAMPLES ;EP
  1.  ;---> Include Historical.
  1.  N BIHIST1 S BIHIST1=""
  1.  S:'$D(BIHIST) BIHIST=1
  1.  S BIHIST1=$S(BIHIST:"YES",1:"NO")
  1.  S X="     7 - Include Historical..: "_BIHIST1
  1.  D WRITE(.BILINE,X)
  1.  K X
  1.  ;
  1.  ;
  1.  ;---> Finish up Listmanager List Count.
  1.  S VALMCNT=BILINE
  1.  S BIRTN="BIREPA"
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. PPFILTR(BIDFN,BIHCF,BIQDT,BIUP) ;EP
  1.  ;---> Patient Population Filter.
  1.  ;---> Return 1 if Patient should be included; otherwise return 0.
  1.  ;---> Parameters:
  1.  ;     1 - BIDFN  (req) Patient IEN.
  1.  ;     2 - BIQDT  (req) Quarter Ending Date.
  1.  ;     3 - BIHCF  (req) Health Care Facility array.
  1.  ;     4 - BIUP   (req) User Population/Group (All, Imm, User, Active).
  1.  ;
  1.  ;---> Example:
  1.  ;---> Filter for standard Patient Population parameter.
  1.  ;Q:'$$PPFILTR^BIREP(BIDFN,.BIHCF,BIQDT,BIUP)
  1.  ;
  1.  ;
  1.  Q:'$G(BIDFN) 0
  1.  Q:'$G(BIQDT) 0
  1.  Q:'$D(BIHCF) 0
  1.  Q:'$D(BIUP) 0
  1.  ;
  1.  ;I BIDFN=4 X ^O
  1.  ;---> If patient died before the Quarter Ending Date, return 0.
  1.  N X S X=$$DECEASED^BIUTL1(BIDFN,1) I X Q:X<BIQDT 0
  1.  ;
  1.  ;---> If patient does not have an Active HRCN at one or more
  1.  ;---> of the Health Care Facilities selected (BIUP="r"), return 0.
  1.  Q:$$HRCN^BIEXPRT2(BIDFN,.BIHCF) 0
  1.  ;
  1.  ;---> If Patient Pop filter is for patients Active in the Imm Register,
  1.  ;---> and patient became Inactive before the Quarter Ending Date, return 0.
  1.  ;---> (Return 0 for patients whose "Inactive Date"="Not in Register.")
  1.  I BIUP="i" N X S X=$$INACT^BIUTL1(BIDFN) I X]"" Q:X<BIQDT 0
  1.  ;
  1.  ;---> Quit if patient is not in selected User Population Group.
  1.  ;---> Comment out next 2 lines for TESTING PURPOSES - MWRZZZ.
  1.  I BIUP="u" Q $$USERPOP^BIUTL6(BIDFN,BIQDT)
  1.  I BIUP="a" Q $$ACTCLIN^BIUTL6(BIDFN,BIQDT)
  1.  ;
  1.  ;---> No reason to exclude patient.
  1.  Q 1
  1.  ;
  1.  ;
  1.  ;----------
  1. WRITE(BILINE,BINOD,BIVAL,BIBLNK) ;EP
  1.  ;---> Write lines to ^TMP (see documentation in ^BIW).
  1.  ;---> Parameters:
  1.  ;     1 - BILINE (ret) Last line# written.
  1.  ;     2 - BINOD  (req) Node in ^TMP to store lines under.
  1.  ;     2 - BIVAL  (opt) Value/text of line (Null=blank line).
  1.  ;
  1.  Q:'$D(BILINE)  Q:'$D(BINOD)
  1.  D WL^BIW(.BILINE,BINOD,$G(BIVAL),$G(BIBLNK))
  1.  Q