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