BIDU ;IHS/CMI/MWR - DUE LIST/LETTERS, MAIN DRIVER; AUG 10,2010
;;8.5;IMMUNIZATION;;SEP 01,2011
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; LIST TEMPLATE CODE FOR DUE LISTS, VIEWING & PRINTING LETTERS.
;; PATCH 1: Fix so that user's DUZ(0) is not always included INIT+86
;
;----------
START ;EP
;---> Listman Screen for printing Immunization Due Letters.
;
;---> If Vaccine Table is not standard, display Error Text and quit.
I $D(^BISITE(-1)) D ERRCD^BIUTL2(503,,1) Q
;
D SETVARS^BIUTL5 N BIRTN
N BINFO
D ADDINFO
D EN
D EXIT,KILLALL^BIUTL8(1)
Q
;
;
;----------
EN ;EP
;---> Main entry point for DUE LISTS & LETTERS.
D EN^VALM("BI DUE LISTS & LETTERS")
Q
;
;
;----------
HDR ;EP
N BILINE,X,Y S BILINE=0 K VALMHDR
D WH^BIW(.BILINE)
S X=IOUON_"IMMUNIZATION LISTS & LETTERS" D CENTERT^BIUTL5(.X,42)
D WH^BIW(.BILINE,X_IOINORM)
;D EN^VALM("BI DUE LISTS & LETTERS")
Q
;
;
;----------
INIT ;EP
;---> Initialize variables and list array.
;---> Variables set by this Init and reside in the local symbol table
;---> for use by other List Templates are defined as follows:
;---> Variables:
; 1 - BIAG (req) Age Range^Mths/Yrs (See description in ^BIAGE.)
; 2 - BIPG (req) Patient Group Data; see PGRPOUP1^BIOUTPT4 for details.
; 3 - BIFDT (req) Forecast date.
; 4 - BICC (req) Current Community array.
; 5 - BICM (req) Case Manager array.
; 6 - BIMMR (req) Immunizations Received array.
; 7 - BIMMD (req) Immunizations Due array.
; 8 - BIHCF (req) Health Care Facility array.
; 9 - BILOT (req) Lot Number array.
; 10 - BIORD (req) Order of listing.
; 11 - BINFO (ret) Additional Information (not set here).
; 12 - BIRDT (opt) Date Range for Received Imms (form BEGDATE:ENDDATE).
; 13 - BIDED (opt) Include Deceased Patients (0=no, 1=yes).
; 14 - BIT (ret) Total Patients retrieved (not set here).
; 15 - BIMD (req) Minimum Interval days since last letter.
; 16 - BIDPRV (req) Designated Provider array.
; 17 - BIBEN (req) Beneficiary Type array: either BIBEN(1) or BIBEN("ALL").
;
;---> NOTE: For programming work in any of the BIDU* routines,
;---> it is helpful to printscreen the comments (from INIT here)
;---> to use as a guide for the meaning of BI* variables.
;
;
S VALM("TITLE")=$$LMVER^BILOGO
S VALMSG="Select a left column number to change an item."
K ^TMP("BIDU",$J)
N BILINE,X S BILINE=0
;
;---> Date.
S:'$G(BIFDT) BIFDT=DT
D DATE^BIREP(.BILINE,"BIDU",1,$G(BIFDT),"Date of Forecast/Clinic",0,2,32)
;
;---> Age Range.
S:$G(BIAG)="" BIAG="1-72"
N BIAG1
D
.I +$G(BIPG)=8 S BIAG1="(set by Search Template)" Q
.I BIAG="ALL" S BIAG1="All Ages" Q
.S BIAG1=$$MTHYR^BIAGE(BIAG)
S X=" 2 - Age Range................: "_BIAG1
D WRITE(.BILINE,X)
K X
;
;---> Patient Group.
N BIHEAD,BIPG1 S:'$G(BIPG) BIPG=3
D PGRP(BIPG,.BIPG1)
;
;---> If Beneficiary is undefined, default to Am Indian/AK Native.
S:'$D(BIBEN) BIBEN(1)=""
S BIHEAD=" 3 - Patient Group ("_$S($D(BIBEN("ALL")):"all)",1:"01).")_"......: "
D
.I $L(BIHEAD_BIPG1)<46 S X=BIHEAD_BIPG1 D WRITE(.BILINE,X) Q
.N I,N,V,Z S N=1,V=",",X=""
.F D Q:$P(BIPG1,V,I)="" Q:$G(BIERR)
..F I=N:1 S X=$P(BIPG1,V,N,I) Q:$L(X)>46 Q:$P(BIPG1,V,I)=""
..I N>1 S BIHEAD=$$SP^BIUTL5(33)
..D WRITE(.BILINE,BIHEAD_$P(BIPG1,V,N,I-1))
..S N=I
D WRITE(.BILINE)
K X
;
;---> Current Community.
D DISP^BIREP(.BILINE,"BIDU",.BICC,"Community",4,1,0,2,32)
K X
;
;---> Case Manager.
D DISP^BIREP(.BILINE,"BIDU",.BICM,"Case Manager",5,3,0,2,32)
;
;---> Designated Provider.
D DISP^BIREP(.BILINE,"BIDU",.BIDPRV,"Designated Provider",6,3,0,2,32)
;
;---> Immunization Received.
N A,B,C S A="Immunizations Received",B="Immunizations"
;---> C=Date Range of Received Imms (form BEGDATE:ENDDATE).
I $G(BIRDT) S C=$$DATE(BIRDT,1)
D DISP^BIREP(.BILINE,"BIDU",.BIMMR,A,7,6,0,2,32,B,$G(C)) K A,B,C
;
;---> Immunization Due.
N A,B S A="Immunizations"_$S($P(BIPG,U)[2:" Past",1:"")_" Due",B="Immunizations"
D DISP^BIREP(.BILINE,"BIDU",.BIMMD,A,8,6,0,2,32,B) K A,B
;
;---> Health Care Facility.
N A,B S A="Health Care Facility",B="Facilities"
;
;********** PATCH 1, v8.4, AUG 01,2010, IHS/CMI/MWR
;---> Fix so that user's DUZ(0) is not always included
;S:$G(DUZ(2)) BIHCF(DUZ(2))=""
I '$O(BIHCF(0)),$G(DUZ(2)) S BIHCF(DUZ(2))=""
;**********
;
D DISP^BIREP(.BILINE,"BIDU",.BIHCF,A,9,2,0,2,32,B) K A,B
;
;---> Lot Number.
D DISP^BIREP(.BILINE,"BIDU",.BILOT,"Lot Number",10,7,1,2,32)
;
;
;---> Additional Information.
N BINFO1
D
.N BIHEAD S BIHEAD=" 11 - Additional Information...: "
.I $D(BINFO("ALL")) D WRITE(.BILINE,BIHEAD_"See list") Q
.I $O(BINFO(0))="" D WRITE(.BILINE,BIHEAD_"None") Q
.;
.;---> Display selections.
.N N S N=""
.F S N=$O(BINFO(N)) Q:'N D
..Q:('$D(^BIADDIN(N,0)))
..S BINFO1=$G(BINFO1)_$S($G(BINFO1)]"":", ",1:"")_$P(^BIADDIN(N,0),U,3)
.;
.;---> Now write the pieces up to 46 characters wide.
.N I,N,V,Z S N=1,V=",",X=""
.F D Q:$P(BINFO1,V,I)=""
..F I=N:1 S X=$P(BINFO1,V,N,I) Q:$L(X)>46 Q:$P(BINFO1,V,I)=""
..I N>1 S BIHEAD=$$SP^BIUTL5(33)
..D WRITE(.BILINE,BIHEAD_$P(BINFO1,V,N,I-1))
..S N=I
K X
;
;
;---> Order of Listing.
S:'$G(BIORD) BIORD=1
;
N X S X="Patient Age"
S X=X_"^Patient Name (alphabetically)"
S X=X_"^Patient Chart#"
S X=X_"^Case Manager"
S X=X_"^Case Manager, then Community"
S X=X_"^Community, then Case Manager"
S X=X_"^Community, then Patient Age"
S X=X_"^Community, then Patient Name"
S X=X_"^Community, then Patient Chart#"
S X=X_"^Zipcode, then Patient Name"
S X=X_"^Designated Provider"
;
N BIORD1 S BIORD1="by "_$P(X,U,BIORD)
S X=" 12 - Order of Listing.........: "_BIORD1
D WRITE(.BILINE,X)
K X
;
;---> Include Deceased.
N BIDED1 S BIDED1=""
S:'$D(BIDED) BIDED=0
S BIDED1=$S(BIDED:"Yes",1:"No")
S X=" 13 - Include Deceased.........: "_BIDED1
D WRITE(.BILINE,X)
K X
;
;---> Finish up Listmanager List Count.
S VALMCNT=BILINE,BIRTN="BIDU"
S:VALMCNT>16 VALMSG="Scroll down to view more Parameters. Type ?? help."
Q
;
;
;----------
WRITE(BILINE,BIVAL,BIBLNK) ;EP
;---> Write lines to ^TMP (see documentation in ^BIW).
;---> Parameters:
; 1 - BILINE (ret) Last line# written.
; 2 - BIVAL (opt) Value/text of line (Null=blank line).
; 3 - BIBLNK (opt) Number of blank lines to add after line sent.
;
Q:'$D(BILINE)
D WL^BIW(.BILINE,"BIDU",$G(BIVAL),$G(BIBLNK))
Q
;
;
;----------
PGRP(BIPG,BIPG1) ;EP
;---> Return text of Patient Group.
;---> Parameters:
; 1 - BIPG (req) Patient Group Data; see PGRPOUP1^BIOUTPT4 for details.
; 2 - BIPG1 (ret) Value/text of line (Null=blank line).
;
;---> If BIPG=null, return unknown.
I $G(BIPG)="" S BIPG1="Unknown" Q
;
;---> If BIPG="some text", simply return it.
I +BIPG=0 S BIPG1=BIPG Q
;
I $P(BIPG,U)=8 S BIPG1="Search Template: "_$P($G(^DIBT(+$P(BIPG,U,8),0)),U) Q
;
N I,X S BIPG1=""
S X="Due^Past Due^Active^Inactive^Auto-Activated^Refusals^Females Only^Search Template"
F I=1,2,3,4,5,6,7,8 D
.I $P(BIPG,U)[I S BIPG1=$G(BIPG1)_$S(BIPG1]"":", ",1:"")_$P(X,U,I)
.;---> If 2 - Past Due, add "months Past Due".
.I I=2,$P(BIPG,U)[2,$P(BIPG,U,2) S BIPG1=BIPG1_" ("_$P(BIPG,U,2)_" mths)" Q
.I I=4,$P(BIPG,U)[4,($P(BIPG,U,4)]"") S BIPG1=BIPG1_$$DATE(BIPG,4)
.I I=5,$P(BIPG,U)[5,($P(BIPG,U,5)]"") S BIPG1=BIPG1_$$DATE(BIPG,5)
Q
;
;
;----------
DATE(BIPG,BIGRP) ;EP
;---> Return external form of date for Group Date Range in slash format.
;---> Parameters:
; 1 - BIPG (req) Patient Group Data; see PGRPOUP1^BIOUTPT4 for details.
; 2 - BIGRP (req) Patient Group.
;
Q:'$G(BIPG) "NO DATE" Q:'$G(BIGRP) "NO DATE"
N BIX,BIY,BIZ S BIX=""
S BIY=$P($P(BIPG,U,BIGRP),":",1)
S BIZ=$P($P(BIPG,U,BIGRP),":",2)
;
;---> If dates are default (1/1/1900 and TODAY), don't display date range.
Q:(BIY=2000101&(BIZ=$G(DT))) BIX
;
S BIX=" ("_$$SLDT2^BIUTL5(BIY)_" to "
S BIX=BIX_$$SLDT2^BIUTL5(BIZ)_")"
Q BIX
;
;
;----------
ADDINFO ;EP
;---> BIDUZF=User-File# identifier to store and retrieve
;---> previous lists of selections from this file.
N BIDUZF S BIDUZF=+$G(DUZ)_"-"_9002084.82
;
I $D(^BISELECT("B",BIDUZF)) D
.N BIDA S BIDA=$O(^BISELECT("B",BIDUZF,0))
.Q:'BIDA Q:$G(^BISELECT(BIDA,0))=""
.Q:'$O(^BISELECT(BIDA,1,0))
.N Y S Y=0
.F S Y=$O(^BISELECT(BIDA,1,Y)) Q:Y="" D
..S BINFO(Y)=""
Q
;
;
;----------
RESET ;EP
;---> Update partition for return to Listmanager.
I $D(VALMQUIT) S VALMBCK="Q" Q
D TERM^VALM0 S VALMBCK="R"
D INIT Q
;
;
;----------
EXIT ;EP
;---> EOJ cleanup.
K ^TMP("BIDU",$J)
D CLEAR^VALM1
D FULL^VALM1
Q
BIDU ;IHS/CMI/MWR - DUE LIST/LETTERS, MAIN DRIVER; AUG 10,2010
+1 ;;8.5;IMMUNIZATION;;SEP 01,2011
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; LIST TEMPLATE CODE FOR DUE LISTS, VIEWING & PRINTING LETTERS.
+4 ;; PATCH 1: Fix so that user's DUZ(0) is not always included INIT+86
+5 ;
+6 ;----------
START ;EP
+1 ;---> Listman Screen for printing Immunization Due Letters.
+2 ;
+3 ;---> If Vaccine Table is not standard, display Error Text and quit.
+4 IF $DATA(^BISITE(-1))
DO ERRCD^BIUTL2(503,,1)
QUIT
+5 ;
+6 DO SETVARS^BIUTL5
NEW BIRTN
+7 NEW BINFO
+8 DO ADDINFO
+9 DO EN
+10 DO EXIT
DO KILLALL^BIUTL8(1)
+11 QUIT
+12 ;
+13 ;
+14 ;----------
EN ;EP
+1 ;---> Main entry point for DUE LISTS & LETTERS.
+2 DO EN^VALM("BI DUE LISTS & LETTERS")
+3 QUIT
+4 ;
+5 ;
+6 ;----------
HDR ;EP
+1 NEW BILINE,X,Y
SET BILINE=0
KILL VALMHDR
+2 DO WH^BIW(.BILINE)
+3 SET X=IOUON_"IMMUNIZATION LISTS & LETTERS"
DO CENTERT^BIUTL5(.X,42)
+4 DO WH^BIW(.BILINE,X_IOINORM)
+5 ;D EN^VALM("BI DUE LISTS & LETTERS")
+6 QUIT
+7 ;
+8 ;
+9 ;----------
INIT ;EP
+1 ;---> Initialize variables and list array.
+2 ;---> Variables set by this Init and reside in the local symbol table
+3 ;---> for use by other List Templates are defined as follows:
+4 ;---> Variables:
+5 ; 1 - BIAG (req) Age Range^Mths/Yrs (See description in ^BIAGE.)
+6 ; 2 - BIPG (req) Patient Group Data; see PGRPOUP1^BIOUTPT4 for details.
+7 ; 3 - BIFDT (req) Forecast date.
+8 ; 4 - BICC (req) Current Community array.
+9 ; 5 - BICM (req) Case Manager array.
+10 ; 6 - BIMMR (req) Immunizations Received array.
+11 ; 7 - BIMMD (req) Immunizations Due array.
+12 ; 8 - BIHCF (req) Health Care Facility array.
+13 ; 9 - BILOT (req) Lot Number array.
+14 ; 10 - BIORD (req) Order of listing.
+15 ; 11 - BINFO (ret) Additional Information (not set here).
+16 ; 12 - BIRDT (opt) Date Range for Received Imms (form BEGDATE:ENDDATE).
+17 ; 13 - BIDED (opt) Include Deceased Patients (0=no, 1=yes).
+18 ; 14 - BIT (ret) Total Patients retrieved (not set here).
+19 ; 15 - BIMD (req) Minimum Interval days since last letter.
+20 ; 16 - BIDPRV (req) Designated Provider array.
+21 ; 17 - BIBEN (req) Beneficiary Type array: either BIBEN(1) or BIBEN("ALL").
+22 ;
+23 ;---> NOTE: For programming work in any of the BIDU* routines,
+24 ;---> it is helpful to printscreen the comments (from INIT here)
+25 ;---> to use as a guide for the meaning of BI* variables.
+26 ;
+27 ;
+28 SET VALM("TITLE")=$$LMVER^BILOGO
+29 SET VALMSG="Select a left column number to change an item."
+30 KILL ^TMP("BIDU",$JOB)
+31 NEW BILINE,X
SET BILINE=0
+32 ;
+33 ;---> Date.
+34 IF '$GET(BIFDT)
SET BIFDT=DT
+35 DO DATE^BIREP(.BILINE,"BIDU",1,$GET(BIFDT),"Date of Forecast/Clinic",0,2,32)
+36 ;
+37 ;---> Age Range.
+38 IF $GET(BIAG)=""
SET BIAG="1-72"
+39 NEW BIAG1
+40 Begin DoDot:1
+41 IF +$GET(BIPG)=8
SET BIAG1="(set by Search Template)"
QUIT
+42 IF BIAG="ALL"
SET BIAG1="All Ages"
QUIT
+43 SET BIAG1=$$MTHYR^BIAGE(BIAG)
End DoDot:1
+44 SET X=" 2 - Age Range................: "_BIAG1
+45 DO WRITE(.BILINE,X)
+46 KILL X
+47 ;
+48 ;---> Patient Group.
+49 NEW BIHEAD,BIPG1
IF '$GET(BIPG)
SET BIPG=3
+50 DO PGRP(BIPG,.BIPG1)
+51 ;
+52 ;---> If Beneficiary is undefined, default to Am Indian/AK Native.
+53 IF '$DATA(BIBEN)
SET BIBEN(1)=""
+54 SET BIHEAD=" 3 - Patient Group ("_$SELECT($DATA(BIBEN("ALL")):"all)",1:"01).")_"......: "
+55 Begin DoDot:1
+56 IF $LENGTH(BIHEAD_BIPG1)<46
SET X=BIHEAD_BIPG1
DO WRITE(.BILINE,X)
QUIT
+57 NEW I,N,V,Z
SET N=1
SET V=","
SET X=""
+58 FOR
Begin DoDot:2
+59 FOR I=N:1
SET X=$PIECE(BIPG1,V,N,I)
IF $LENGTH(X)>46
QUIT
IF $PIECE(BIPG1,V,I)=""
QUIT
+60 IF N>1
SET BIHEAD=$$SP^BIUTL5(33)
+61 DO WRITE(.BILINE,BIHEAD_$PIECE(BIPG1,V,N,I-1))
+62 SET N=I
End DoDot:2
IF $PIECE(BIPG1,V,I)=""
QUIT
IF $GET(BIERR)
QUIT
End DoDot:1
+63 DO WRITE(.BILINE)
+64 KILL X
+65 ;
+66 ;---> Current Community.
+67 DO DISP^BIREP(.BILINE,"BIDU",.BICC,"Community",4,1,0,2,32)
+68 KILL X
+69 ;
+70 ;---> Case Manager.
+71 DO DISP^BIREP(.BILINE,"BIDU",.BICM,"Case Manager",5,3,0,2,32)
+72 ;
+73 ;---> Designated Provider.
+74 DO DISP^BIREP(.BILINE,"BIDU",.BIDPRV,"Designated Provider",6,3,0,2,32)
+75 ;
+76 ;---> Immunization Received.
+77 NEW A,B,C
SET A="Immunizations Received"
SET B="Immunizations"
+78 ;---> C=Date Range of Received Imms (form BEGDATE:ENDDATE).
+79 IF $GET(BIRDT)
SET C=$$DATE(BIRDT,1)
+80 DO DISP^BIREP(.BILINE,"BIDU",.BIMMR,A,7,6,0,2,32,B,$GET(C))
KILL A,B,C
+81 ;
+82 ;---> Immunization Due.
+83 NEW A,B
SET A="Immunizations"_$SELECT($PIECE(BIPG,U)[2:" Past",1:"")_" Due"
SET B="Immunizations"
+84 DO DISP^BIREP(.BILINE,"BIDU",.BIMMD,A,8,6,0,2,32,B)
KILL A,B
+85 ;
+86 ;---> Health Care Facility.
+87 NEW A,B
SET A="Health Care Facility"
SET B="Facilities"
+88 ;
+89 ;********** PATCH 1, v8.4, AUG 01,2010, IHS/CMI/MWR
+90 ;---> Fix so that user's DUZ(0) is not always included
+91 ;S:$G(DUZ(2)) BIHCF(DUZ(2))=""
+92 IF '$ORDER(BIHCF(0))
IF $GET(DUZ(2))
SET BIHCF(DUZ(2))=""
+93 ;**********
+94 ;
+95 DO DISP^BIREP(.BILINE,"BIDU",.BIHCF,A,9,2,0,2,32,B)
KILL A,B
+96 ;
+97 ;---> Lot Number.
+98 DO DISP^BIREP(.BILINE,"BIDU",.BILOT,"Lot Number",10,7,1,2,32)
+99 ;
+100 ;
+101 ;---> Additional Information.
+102 NEW BINFO1
+103 Begin DoDot:1
+104 NEW BIHEAD
SET BIHEAD=" 11 - Additional Information...: "
+105 IF $DATA(BINFO("ALL"))
DO WRITE(.BILINE,BIHEAD_"See list")
QUIT
+106 IF $ORDER(BINFO(0))=""
DO WRITE(.BILINE,BIHEAD_"None")
QUIT
+107 ;
+108 ;---> Display selections.
+109 NEW N
SET N=""
+110 FOR
SET N=$ORDER(BINFO(N))
IF 'N
QUIT
Begin DoDot:2
+111 IF ('$DATA(^BIADDIN(N,0)))
QUIT
+112 SET BINFO1=$GET(BINFO1)_$SELECT($GET(BINFO1)]"":", ",1:"")_$PIECE(^BIADDIN(N,0),U,3)
End DoDot:2
+113 ;
+114 ;---> Now write the pieces up to 46 characters wide.
+115 NEW I,N,V,Z
SET N=1
SET V=","
SET X=""
+116 FOR
Begin DoDot:2
+117 FOR I=N:1
SET X=$PIECE(BINFO1,V,N,I)
IF $LENGTH(X)>46
QUIT
IF $PIECE(BINFO1,V,I)=""
QUIT
+118 IF N>1
SET BIHEAD=$$SP^BIUTL5(33)
+119 DO WRITE(.BILINE,BIHEAD_$PIECE(BINFO1,V,N,I-1))
+120 SET N=I
End DoDot:2
IF $PIECE(BINFO1,V,I)=""
QUIT
End DoDot:1
+121 KILL X
+122 ;
+123 ;
+124 ;---> Order of Listing.
+125 IF '$GET(BIORD)
SET BIORD=1
+126 ;
+127 NEW X
SET X="Patient Age"
+128 SET X=X_"^Patient Name (alphabetically)"
+129 SET X=X_"^Patient Chart#"
+130 SET X=X_"^Case Manager"
+131 SET X=X_"^Case Manager, then Community"
+132 SET X=X_"^Community, then Case Manager"
+133 SET X=X_"^Community, then Patient Age"
+134 SET X=X_"^Community, then Patient Name"
+135 SET X=X_"^Community, then Patient Chart#"
+136 SET X=X_"^Zipcode, then Patient Name"
+137 SET X=X_"^Designated Provider"
+138 ;
+139 NEW BIORD1
SET BIORD1="by "_$PIECE(X,U,BIORD)
+140 SET X=" 12 - Order of Listing.........: "_BIORD1
+141 DO WRITE(.BILINE,X)
+142 KILL X
+143 ;
+144 ;---> Include Deceased.
+145 NEW BIDED1
SET BIDED1=""
+146 IF '$DATA(BIDED)
SET BIDED=0
+147 SET BIDED1=$SELECT(BIDED:"Yes",1:"No")
+148 SET X=" 13 - Include Deceased.........: "_BIDED1
+149 DO WRITE(.BILINE,X)
+150 KILL X
+151 ;
+152 ;---> Finish up Listmanager List Count.
+153 SET VALMCNT=BILINE
SET BIRTN="BIDU"
+154 IF VALMCNT>16
SET VALMSG="Scroll down to view more Parameters. Type ?? help."
+155 QUIT
+156 ;
+157 ;
+158 ;----------
WRITE(BILINE,BIVAL,BIBLNK) ;EP
+1 ;---> Write lines to ^TMP (see documentation in ^BIW).
+2 ;---> Parameters:
+3 ; 1 - BILINE (ret) Last line# written.
+4 ; 2 - BIVAL (opt) Value/text of line (Null=blank line).
+5 ; 3 - BIBLNK (opt) Number of blank lines to add after line sent.
+6 ;
+7 IF '$DATA(BILINE)
QUIT
+8 DO WL^BIW(.BILINE,"BIDU",$GET(BIVAL),$GET(BIBLNK))
+9 QUIT
+10 ;
+11 ;
+12 ;----------
PGRP(BIPG,BIPG1) ;EP
+1 ;---> Return text of Patient Group.
+2 ;---> Parameters:
+3 ; 1 - BIPG (req) Patient Group Data; see PGRPOUP1^BIOUTPT4 for details.
+4 ; 2 - BIPG1 (ret) Value/text of line (Null=blank line).
+5 ;
+6 ;---> If BIPG=null, return unknown.
+7 IF $GET(BIPG)=""
SET BIPG1="Unknown"
QUIT
+8 ;
+9 ;---> If BIPG="some text", simply return it.
+10 IF +BIPG=0
SET BIPG1=BIPG
QUIT
+11 ;
+12 IF $PIECE(BIPG,U)=8
SET BIPG1="Search Template: "_$PIECE($GET(^DIBT(+$PIECE(BIPG,U,8),0)),U)
QUIT
+13 ;
+14 NEW I,X
SET BIPG1=""
+15 SET X="Due^Past Due^Active^Inactive^Auto-Activated^Refusals^Females Only^Search Template"
+16 FOR I=1,2,3,4,5,6,7,8
Begin DoDot:1
+17 IF $PIECE(BIPG,U)[I
SET BIPG1=$GET(BIPG1)_$SELECT(BIPG1]"":", ",1:"")_$PIECE(X,U,I)
+18 ;---> If 2 - Past Due, add "months Past Due".
+19 IF I=2
IF $PIECE(BIPG,U)[2
IF $PIECE(BIPG,U,2)
SET BIPG1=BIPG1_" ("_$PIECE(BIPG,U,2)_" mths)"
QUIT
+20 IF I=4
IF $PIECE(BIPG,U)[4
IF ($PIECE(BIPG,U,4)]"")
SET BIPG1=BIPG1_$$DATE(BIPG,4)
+21 IF I=5
IF $PIECE(BIPG,U)[5
IF ($PIECE(BIPG,U,5)]"")
SET BIPG1=BIPG1_$$DATE(BIPG,5)
End DoDot:1
+22 QUIT
+23 ;
+24 ;
+25 ;----------
DATE(BIPG,BIGRP) ;EP
+1 ;---> Return external form of date for Group Date Range in slash format.
+2 ;---> Parameters:
+3 ; 1 - BIPG (req) Patient Group Data; see PGRPOUP1^BIOUTPT4 for details.
+4 ; 2 - BIGRP (req) Patient Group.
+5 ;
+6 IF '$GET(BIPG)
QUIT "NO DATE"
IF '$GET(BIGRP)
QUIT "NO DATE"
+7 NEW BIX,BIY,BIZ
SET BIX=""
+8 SET BIY=$PIECE($PIECE(BIPG,U,BIGRP),":",1)
+9 SET BIZ=$PIECE($PIECE(BIPG,U,BIGRP),":",2)
+10 ;
+11 ;---> If dates are default (1/1/1900 and TODAY), don't display date range.
+12 IF (BIY=2000101&(BIZ=$GET(DT)))
QUIT BIX
+13 ;
+14 SET BIX=" ("_$$SLDT2^BIUTL5(BIY)_" to "
+15 SET BIX=BIX_$$SLDT2^BIUTL5(BIZ)_")"
+16 QUIT BIX
+17 ;
+18 ;
+19 ;----------
ADDINFO ;EP
+1 ;---> BIDUZF=User-File# identifier to store and retrieve
+2 ;---> previous lists of selections from this file.
+3 NEW BIDUZF
SET BIDUZF=+$GET(DUZ)_"-"_9002084.82
+4 ;
+5 IF $DATA(^BISELECT("B",BIDUZF))
Begin DoDot:1
+6 NEW BIDA
SET BIDA=$ORDER(^BISELECT("B",BIDUZF,0))
+7 IF 'BIDA
QUIT
IF $GET(^BISELECT(BIDA,0))=""
QUIT
+8 IF '$ORDER(^BISELECT(BIDA,1,0))
QUIT
+9 NEW Y
SET Y=0
+10 FOR
SET Y=$ORDER(^BISELECT(BIDA,1,Y))
IF Y=""
QUIT
Begin DoDot:2
+11 SET BINFO(Y)=""
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
+14 ;
+15 ;----------
RESET ;EP
+1 ;---> Update partition for return to Listmanager.
+2 IF $DATA(VALMQUIT)
SET VALMBCK="Q"
QUIT
+3 DO TERM^VALM0
SET VALMBCK="R"
+4 DO INIT
QUIT
+5 ;
+6 ;
+7 ;----------
EXIT ;EP
+1 ;---> EOJ cleanup.
+2 KILL ^TMP("BIDU",$JOB)
+3 DO CLEAR^VALM1
+4 DO FULL^VALM1
+5 QUIT
