Routine: BIOUTPT5

BIOUTPT5 ;IHS/CMI/MWR - WRITE SUBHEADERS.; AUG 10,2010

 ;;8.5;IMMUNIZATION;;SEP 01,2011

 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *

 ;;  WRITE SUBHEADER LINES TO ^TMP FOR REPORTS.

 ;;  v8.4 PATCH 1: Manage subheader Items more than 20.  SUBH+35

 ;----------

SUBH(BIAR,BITEM,BITEMS,BIGBL,BILINE,BIERR,BIPC,BITM,BIAPP) ;EP

 ;---> If specific Items were selected (not ALL), then list them

 ;---> in a subheader at the top of the report.

 ;---> Parameters:

 ;     1 - BIAR   (req) Array of Item IENs to be displayed.

 ;     2 - BITEM  (req) Categoric name of Items being displayed.

 ;     3 - BITEMS (opt) Plural form of Categoric Item name.

 ;                      Provide this only if it's an exception.

 ;     4 - BIGBL  (req) Item global OR File#-Field# for Set of Codes.

 ;     5 - BILINE (ret) Line number in ^TMP Listman array.

 ;     6 - BIERR  (ret) Error Code returned, if any.

 ;     7 - BIPC   (opt) Piece of Zero node to display as Item Name;

 ;                      default=1.

 ;     8 - BITM   (opt) Top Margin.

 ;     9 - BIAPP  (opt) Any text to be appended to the list, such as

 ;                      a date range.

 ;---> EXAMPLE:

 ;   D SUBH^BIOUTPT5("BICC","Community",,"^AUTTCOM(",.BILINE,.BIERR)

 ;---> Check/set required variables.

 S BIERR=""

 Q:$$CHECK(.BIERR)

 S:'$G(BITM) BITM=12

 ;---> Quit and don't write subheader if "ALL" Items were selected

 ;---> (or if NO Items were selected).

 Q:$O(@(BIAR_"(0)"))=""

 Q:$D(@(BIAR_"(""ALL"")"))

 ;---> Check/set plural form of Item Name.

 I $G(BITEMS)="" D PLURAL^BISELECT(BITEM,.BITEMS)

 ;********** PATCH 1, v8.4, AUG 01,2010, IHS/CMI/MWR

 ;---> If more than 20 subheader items and list is to the screen, simply

 ;---> state that and quit.

 N M,N S (M,N)=0

 F  S N=$O(@(BIAR_"(N)")) Q:'N  S M=M+1

 I M>20 I $G(IOSL)<25 D  Q

 .N X S X=" "_BITEMS_": More than 20; Print report or review "_BITEM_" parameter."

 .D WH^BIW(.BILINE,X)

 .D WH^BIW(.BILINE,$$SP^BIUTL5(79,"-"))

 ;**********

 ;---> If too much subheader text for screen, return error.

 I (BILINE>BITM)&($G(IOSL)<25) S BIERR=668 Q

 ;---> Alphabetize list.

 N BIAR1

 .I +BIGBL D  Q

 ..;---> Set of Codes.

 ..N BISET S BISET=$P($G(^DD($P(BIGBL,"-"),$P(BIGBL,"-",2),0)),U,3)

 ..N N S N=0

 ..F  S N=$O(@(BIAR_"(N)")) Q:N=""  D

 ...S BIAR1($P($P(BISET,N_":",2),";"))=""

.;

 .;---> Entries from a File.

 .S:'$G(BIPC) BIPC=1

 .N N S N=0

 .F  S N=$O(@(BIAR_"(N)")) Q:'N  D

 ..S BIAR1($$NAME(N,BIGBL,BIPC))=""

 ;---> Set X=string of Items, pieced by "; " (or Z).

 N BIHEAD,I,N,Y,Z

 S N=0,X="",Z="; "

 F I=1:1 S N=$O(BIAR1(N)) Q:N=""  D

 .S:I>1 X=X_Z S X=X_N

 ;---> Append any text such as date range.

 S:$G(BIAPP)]"" X=X_BIAPP

 S BIHEAD=" "_$S(I>2:BITEMS,1:BITEM)_": "

 ;---> Now write each line with as many Items as will fit on a line

 ;---> (hanging indent under the header "Item Name:").

 S N=1

 F  D  Q:$P(X,Z,I)=""  Q:$G(BIERR)

 .F I=N:1 S Y=$P(X,Z,N,I) Q:$L(Y)>63  Q:$P(X,Z,I)=""

 .I N>1 S BIHEAD=$$SP^BIUTL5($L(BIHEAD))

 .I (BILINE>BITM)&($G(IOSL)<25) S BIERR=668 Q

 .D WH^BIW(.BILINE,BIHEAD_$P(X,Z,N,I-1))

 .S N=I

 D WH^BIW(.BILINE,$$SP^BIUTL5(79,"-"))

 ;----------

NAME(BIIEN,BIGBL,BIPC) ;EP

 ;---> Return the .01 for this IEN in BIGBL.

 ;---> Parameters:

 ;     1 - BIIEN  (req) IEN of Item.

 ;     2 - BIGBL  (req) Item global.

 ;     3 - BIPC   (opt) Piece of Zero node to display (default=1).

 Q:'$G(BIIEN) 0  Q:$G(BIGBL)="" 0

 N X S:'$G(BIPC) BIPC=1

 S X=$P(@(BIGBL_BIIEN_",0)"),U,BIPC)

 Q:X="" 0

Q X

 ;---> First, build array sorted by ItemName.

 N BIIEN S BIIEN=0

 F  S BIIEN=$O(@(BIARR1_"(BIIEN)")) Q:'BIIEN  D

.;

 .;---> If IEN passed does not really exist in the File,

 .;---> remove it from the Selection Array.

 .I '$D(@(BIGBL_"BIIEN,0)")) K @(BIARR1_"(BIIEN)") Q

.;

 .;---> If (previously stored) IEN does not pass the screen,

 .;---> then remove it from the Selection Array.

 .I BISCRN]"" N Y S Y=BIIEN X BISCRN I '$T K @(BIARR1_"(BIIEN)") Q

.;

 .N BI0,BINAME,BIIDTX

 .S BI0=@(BIGBL_"BIIEN,0)")

 .S BINAME=$P(BI0,U,BIPIECE)

 .Q:BINAME=""

 ;----------

CHECK(BIERR) ;EP

 ;---> Check required variables.

 ;---> Parameters:

 ;     1 - BIERR (ret) Error Code returned, if any.

 ;---> Check that Subheader Array name is present.

 I $G(BIAR)="" S BIERR=656 Q 1

 ;---> Check that Categoric Item name is present.

 I $G(BITEM)="" S BIERR=657 Q 1

 ;---> Check Item global.

 I $G(BIGBL)="" S BIERR=658 Q 1

 ;---> Check that the Global or Set of Codes is legitimate.

 S BIERR=""

 D  Q:BIERR 1

 .I +BIGBL D  Q

 ..;---> Test for Set of Codes.

 ..N X,Y S X=$P(BIGBL,"-"),Y=$P(BIGBL,"-",2)

 ..I 'Y S BIERR=665 Q

 ..I '$D(^DD(X,Y,0)) S BIERR=665 Q

.;

 .;---> Test for global (entries from a file).

 .I '$D(@(BIGBL_"0)")) S BIERR=659 Q

Q 0

 ;----------

RYEAR(BIYEAR,BIRTN) ;EP

 ;---> Ask the Report Year.

 ;---> Called by Protocol BI OUTPUT REPORT YEAR.

 ;---> Parameters:

 ;     1 - BIYEAR (ret) Report Year in yyyy format.

 ;                (opt) Default Year.

 ;     2 - BIRTN (req) Calling routine for reset.

 I $G(BIRTN)="" D ERRCD^BIUTL2(621,,1) Q

 N DIR,DIRA,DIRB,DIRQ,DIRNOW,BIPOP

 S:$G(BIYEAR) DIRB=+BIYEAR

 .I '$G(DT) S DIRNOW=2050 Q

 .S DIRNOW=1700+$E(DT,1,3)

 S DIRA="   Please enter a Report Year: "

 S:$G(BIYEAR) DIRB=+BIYEAR

 S DIRQ="   Enter a year between 1950 and the present, in the form yyyy"

 D FULL^VALM1

 D TITLE^BIUTL5("SELECT REPORT YEAR")

 D TEXT1 W !

 D DIR^BIFMAN("NAO^1950:"_DIRNOW,.Y,.BIPOP,DIRA,DIRB,DIRQ)

 I $G(BIPOP) D @("RESET^"_BIRTN) Q

 S BIYEAR=+Y

 I Y<1 D @("RESET^"_BIRTN) Q

 N DIR

 W !!?3,"You may select an End Date of either December 31, ",+BIYEAR

 W " or March 31, ",(+BIYEAR)+1,".",!

 S DIR("A")="   Select December or March: "

 S DIR("B")=$S($P(BIYEAR,U,2)="m":"March",1:"December")

 S DIR(0)="SAM^d:December;m:March"

 D ^DIR K DIR

 I Y=-1!($D(DIRUT)) D @("RESET^"_BIRTN) Q

 ;---> If Y="m" concate to BIYEAR to signify End Date of March 31.  Otherwise,

 ;---> default is 2nd "^"-piece of BIYEAR=""--which is End Date of Dec 31.

 I Y="m" S BIYEAR=BIYEAR_U_"m"

 D @("RESET^"_BIRTN)

 ;----------

TEXT1 ;EP

 ;;The "Report Year" represents the start of a particular influenza

 ;;season.  So, for example, 2011 will cover the influenza season from

 ;;September 1, 2011 until December 31, 2011 (or until March 31, 2012,

 ;;if that End Date is chosen).

;;

 ;;The patient ages in the report will be calculated as of 12/31 of the

 ;;Report Year you select (12/31/2011 in the above example).

;;

 D PRINTX("TEXT1")

 ;----------

PRINTX(BILINL,BITAB) ;EP

 Q:$G(BILINL)=""

 N I,T,X S T="" S:'$D(BITAB) BITAB=5 F I=1:1:BITAB S T=T_" "

 F I=1:1 S X=$T(@BILINL+I) Q:X'[";;"  W !,T,$P(X,";;",2)

 ;----------

TEXT11(BITEXT) ;EP

 ;;In producing lists and letters, you may select the group of patients

 ;;you wish to include by specifying attributes of this screen, such as

 ;;"DUE" or "ACTIVE."  These attributes may also be used in various

 ;;combinations in order to further specify your patient group.

 ;;(This group may be further limited by the other criteria you select

 ;;on the main IMMUNIZATION LISTS & LETTERS Main Screen, such as Age Range,

 ;;Communities, Lot Numbers, etc.)

;;

 ;;                               DUE

 ;;                              -----

 ;;"DUE" will list all Active patients who are DUE for immunizations,

 ;;subject to any other limitations on the Lists & Letters Main Screen,

 ;;such as Age Range, Community, etc..  "DUE" will also necessarily include

 ;;any patients who are "PAST DUE."  By default, "DUE" will only include

 ;;patients who are "ACTIVE" unless you specify "INACTIVE" as one of the

 ;;attributes.

;;

 ;;                             PAST DUE

 ;;                            ----------

 ;;"PAST DUE" will only include patients who are past their due dates

 ;;for one or more immunizations.  If you select this attribute, you

 ;;will be given the opportunity to specify how many months past due

 ;;you wish to check for.  By default, "PAST DUE" will only include

 ;;patients who are "ACTIVE" unless you specify "INACTIVE" as one of the

 ;;attributes.

;;

 ;;                        ACTIVE and INACTIVE

 ;;                       ---------------------

 ;;The choices of "ACTIVE" and "INACTIVE" will simply list patients in the

 ;;Immunization Database who have the Statuses of Active or Inactive.

 ;;"ACTIVE" and "INACTIVE" may also be used together to produce a list

 ;;of all patients in the Immunization database.

;;

;;

 ;;                      AUTOMATICALLY ACTIVATED

 ;;                     -------------------------

 ;;"AUTOMATICALLY ACTIVATED" will restrict the list to only those patients

 ;;who were Automatically Activated in the Immunization database.  You may

 ;;combine it with other attributes, such as ACTIVE or DUE, to produce a

 ;;list that is more specific.  For example, you could produce a list of

 ;;patients who were AUTOMATICALLY ACTIVATED and are now PAST DUE.

;;

;;

 ;;                            REFUSALS

 ;;                           ----------

 ;;"REFUSALS" will restrict the list to only those patients who at some

 ;;point refused an immunization (either the patient or the parent).

 ;;You may combine REFUSALS with other attributes in order to produce a

 ;;list that is more specific.  For example, you could produce a list of

 ;;patients who were both INACTIVE and had REFUSALS on record.

;;

;;

 ;;                          FEMALES ONLY

 ;;                         --------------

 ;;"FEMALES ONLY" will restrict the list to female patients only.

 ;;NOTE: The list will include both "ACTIVE" and "INACTIVE" female

 ;;patients unless you have specifically chosen Active or Inactive.

;;

;;

 ;;                        SEARCH TEMPLATES

 ;;                       ------------------

 ;;SEARCH TEMPLATEs are groups of individual patients that have been

 ;;produced and stored by other software, usually QMAN, and saved under

 ;;a Template Name.  If you choose this attribute, you will be asked to

 ;;select from a file of existing Search Templates.

;;

 ;;NOTE: A SEARCH TEMPLATE is a pre-defined group of patients and cannot

 ;;be combined with any of the other attributes.

 ;;For more information about Search Templates and how to create your

 ;;own, contact your computer support people for training.

;;

;;

 ;;Final note: The implications of combining too many restrictive attributes

 ;;can be difficult to predict and may produce few or no results.

 ;;It is best to limit a list to two or three combined attributes.

;;

 D LOADTX("TEXT11",,.BITEXT)

 ;----------

LOADTX(BILINL,BITAB,BITEXT) ;EP

 Q:$G(BILINL)=""

 N I,T,X S T="" S:'$D(BITAB) BITAB=5 F I=1:1:BITAB S T=T_" "

 F I=1:1 S X=$T(@BILINL+I) Q:X'[";;"  S BITEXT(I)=T_$P(X,";;",2)

BIOUTPT5  ;IHS/CMI/MWR - WRITE SUBHEADERS.; AUG 10,2010

 +1       ;;8.5;IMMUNIZATION;;SEP 01,2011

 +2       ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *

 +3       ;;  WRITE SUBHEADER LINES TO ^TMP FOR REPORTS.

 +4       ;;  v8.4 PATCH 1: Manage subheader Items more than 20.  SUBH+35

 +5       ;

 +6       ;

 +7       ;----------

SUBH(BIAR,BITEM,BITEMS,BIGBL,BILINE,BIERR,BIPC,BITM,BIAPP) ;EP

 +1       ;---> If specific Items were selected (not ALL), then list them

 +2       ;---> in a subheader at the top of the report.

 +3       ;---> Parameters:

 +4       ;     1 - BIAR   (req) Array of Item IENs to be displayed.

 +5       ;     2 - BITEM  (req) Categoric name of Items being displayed.

 +6       ;     3 - BITEMS (opt) Plural form of Categoric Item name.

 +7       ;                      Provide this only if it's an exception.

 +8       ;     4 - BIGBL  (req) Item global OR File#-Field# for Set of Codes.

 +9       ;     5 - BILINE (ret) Line number in ^TMP Listman array.

 +10      ;     6 - BIERR  (ret) Error Code returned, if any.

 +11      ;     7 - BIPC   (opt) Piece of Zero node to display as Item Name;

 +12      ;                      default=1.

 +13      ;     8 - BITM   (opt) Top Margin.

 +14      ;     9 - BIAPP  (opt) Any text to be appended to the list, such as

 +15      ;                      a date range.

 +16      ;

 +17      ;---> EXAMPLE:

 +18      ;   D SUBH^BIOUTPT5("BICC","Community",,"^AUTTCOM(",.BILINE,.BIERR)

 +19      ;

 +20      ;

 +21      ;---> Check/set required variables.

 +22       SET BIERR=""

 +23       IF $$CHECK(.BIERR)

               QUIT

 +24       IF '$GET(BITM)

               SET BITM=12

 +25      ;

 +26      ;---> Quit and don't write subheader if "ALL" Items were selected

 +27      ;---> (or if NO Items were selected).

 +28       IF $ORDER(@(BIAR_"(0)"))=""

               QUIT

 +29       IF $DATA(@(BIAR_"(""ALL"")"))

               QUIT

 +30      ;

 +31      ;---> Check/set plural form of Item Name.

 +32       IF $GET(BITEMS)=""

               DO PLURAL^BISELECT(BITEM,.BITEMS)

 +33      ;

 +34      ;

 +35      ;********** PATCH 1, v8.4, AUG 01,2010, IHS/CMI/MWR

 +36      ;---> If more than 20 subheader items and list is to the screen, simply

 +37      ;---> state that and quit.

 +38       NEW M,N

           SET (M,N)=0

 +39       FOR

               SET N=$ORDER(@(BIAR_"(N)"))

               IF 'N

                   QUIT

               SET M=M+1

 +40       IF M>20

               IF $GET(IOSL)<25

                   Begin DoDot:1

 +41                   NEW X

                       SET X=" "_BITEMS_": More than 20; Print report or review "_BITEM_" parameter."

 +42                   DO WH^BIW(.BILINE,X)

 +43                   DO WH^BIW(.BILINE,$$SP^BIUTL5(79,"-"))

                   End DoDot:1

                   QUIT

 +44      ;**********

 +45      ;

 +46      ;

 +47      ;---> If too much subheader text for screen, return error.

 +48       IF (BILINE>BITM)&($GET(IOSL)<25)

               SET BIERR=668

               QUIT

 +49      ;

 +50      ;---> Alphabetize list.

 +51       NEW BIAR1

 +52       Begin DoDot:1

 +53           IF +BIGBL

                   Begin DoDot:2

 +54      ;---> Set of Codes.

 +55                   NEW BISET

                       SET BISET=$PIECE($GET(^DD($PIECE(BIGBL,"-"),$PIECE(BIGBL,"-",2),0)),U,3)

 +56                   NEW N

                       SET N=0

 +57                   FOR

                           SET N=$ORDER(@(BIAR_"(N)"))

                           IF N=""

                               QUIT

                           Begin DoDot:3

 +58                           SET BIAR1($PIECE($PIECE(BISET,N_":",2),";"))=""

                           End DoDot:3

                   End DoDot:2

                   QUIT

 +59      ;

 +60      ;---> Entries from a File.

 +61           IF '$GET(BIPC)

                   SET BIPC=1

 +62           NEW N

               SET N=0

 +63           FOR

                   SET N=$ORDER(@(BIAR_"(N)"))

                   IF 'N

                       QUIT

                   Begin DoDot:2

 +64                   SET BIAR1($$NAME(N,BIGBL,BIPC))=""

                   End DoDot:2

           End DoDot:1

 +65      ;

 +66      ;---> Set X=string of Items, pieced by "; " (or Z).

 +67       NEW BIHEAD,I,N,Y,Z

 +68       SET N=0

           SET X=""

           SET Z="; "

 +69       FOR I=1:1

               SET N=$ORDER(BIAR1(N))

               IF N=""

                   QUIT

               Begin DoDot:1

 +70               IF I>1

                       SET X=X_Z

                   SET X=X_N

               End DoDot:1

 +71      ;---> Append any text such as date range.

 +72       IF $GET(BIAPP)]""

               SET X=X_BIAPP

 +73       SET BIHEAD=" "_$SELECT(I>2:BITEMS,1:BITEM)_": "

 +74      ;

 +75      ;---> Now write each line with as many Items as will fit on a line

 +76      ;---> (hanging indent under the header "Item Name:").

 +77       SET N=1

 +78       FOR

               Begin DoDot:1

 +79               FOR I=N:1

                       SET Y=$PIECE(X,Z,N,I)

                       IF $LENGTH(Y)>63

                           QUIT

                       IF $PIECE(X,Z,I)=""

                           QUIT

 +80               IF N>1

                       SET BIHEAD=$$SP^BIUTL5($LENGTH(BIHEAD))

 +81               IF (BILINE>BITM)&($GET(IOSL)<25)

                       SET BIERR=668

                       QUIT

 +82               DO WH^BIW(.BILINE,BIHEAD_$PIECE(X,Z,N,I-1))

 +83               SET N=I

               End DoDot:1

               IF $PIECE(X,Z,I)=""

                   QUIT

               IF $GET(BIERR)

                   QUIT

 +84      ;

 +85       DO WH^BIW(.BILINE,$$SP^BIUTL5(79,"-"))

 +86       QUIT

 +87      ;

 +88      ;

 +89      ;----------

NAME(BIIEN,BIGBL,BIPC) ;EP

 +1       ;---> Return the .01 for this IEN in BIGBL.

 +2       ;---> Parameters:

 +3       ;     1 - BIIEN  (req) IEN of Item.

 +4       ;     2 - BIGBL  (req) Item global.

 +5       ;     3 - BIPC   (opt) Piece of Zero node to display (default=1).

 +6       ;

 +7        IF '$GET(BIIEN)

               QUIT 0

           IF $GET(BIGBL)=""

               QUIT 0

 +8        NEW X

           IF '$GET(BIPC)

               SET BIPC=1

 +9        SET X=$PIECE(@(BIGBL_BIIEN_",0)"),U,BIPC)

 +10       IF X=""

               QUIT 0

 +11       QUIT X

 +12      ;

 +13      ;

 +14      ;---> First, build array sorted by ItemName.

 +15       NEW BIIEN

           SET BIIEN=0

 +16       FOR

               SET BIIEN=$ORDER(@(BIARR1_"(BIIEN)"))

               IF 'BIIEN

                   QUIT

               Begin DoDot:1

 +17      ;

 +18      ;---> If IEN passed does not really exist in the File,

 +19      ;---> remove it from the Selection Array.

 +20               IF '$DATA(@(BIGBL_"BIIEN,0)"))

                       KILL @(BIARR1_"(BIIEN)")

                       QUIT

 +21      ;

 +22      ;---> If (previously stored) IEN does not pass the screen,

 +23      ;---> then remove it from the Selection Array.

 +24               IF BISCRN]""

                       NEW Y

                       SET Y=BIIEN

                       XECUTE BISCRN

                       IF '$TEST

                           KILL @(BIARR1_"(BIIEN)")

                           QUIT

 +25      ;

 +26               NEW BI0,BINAME,BIIDTX

 +27               SET BI0=@(BIGBL_"BIIEN,0)")

 +28               SET BINAME=$PIECE(BI0,U,BIPIECE)

 +29               IF BINAME=""

                       QUIT

               End DoDot:1

 +30       QUIT

 +31      ;

 +32      ;

 +33      ;----------

CHECK(BIERR) ;EP

 +1       ;---> Check required variables.

 +2       ;---> Parameters:

 +3       ;     1 - BIERR (ret) Error Code returned, if any.

 +4       ;

 +5       ;---> Check that Subheader Array name is present.

 +6        IF $GET(BIAR)=""

               SET BIERR=656

               QUIT 1

 +7       ;

 +8       ;---> Check that Categoric Item name is present.

 +9        IF $GET(BITEM)=""

               SET BIERR=657

               QUIT 1

 +10      ;

 +11      ;---> Check Item global.

 +12       IF $GET(BIGBL)=""

               SET BIERR=658

               QUIT 1

 +13      ;

 +14      ;---> Check that the Global or Set of Codes is legitimate.

 +15       SET BIERR=""

 +16       Begin DoDot:1

 +17           IF +BIGBL

                   Begin DoDot:2

 +18      ;---> Test for Set of Codes.

 +19                   NEW X,Y

                       SET X=$PIECE(BIGBL,"-")

                       SET Y=$PIECE(BIGBL,"-",2)

 +20                   IF 'Y

                           SET BIERR=665

                           QUIT

 +21                   IF '$DATA(^DD(X,Y,0))

                           SET BIERR=665

                           QUIT

                   End DoDot:2

                   QUIT

 +22      ;

 +23      ;---> Test for global (entries from a file).

 +24           IF '$DATA(@(BIGBL_"0)"))

                   SET BIERR=659

                   QUIT

           End DoDot:1

           IF BIERR

               QUIT 1

 +25      ;

 +26       QUIT 0

 +27      ;

 +28      ;

 +29      ;----------

RYEAR(BIYEAR,BIRTN) ;EP

 +1       ;---> Ask the Report Year.

 +2       ;---> Called by Protocol BI OUTPUT REPORT YEAR.

 +3       ;---> Parameters:

 +4       ;     1 - BIYEAR (ret) Report Year in yyyy format.

 +5       ;                (opt) Default Year.

 +6       ;     2 - BIRTN (req) Calling routine for reset.

 +7       ;

 +8        IF $GET(BIRTN)=""

               DO ERRCD^BIUTL2(621,,1)

               QUIT

 +9       ;

 +10       NEW DIR,DIRA,DIRB,DIRQ,DIRNOW,BIPOP

 +11       IF $GET(BIYEAR)

               SET DIRB=+BIYEAR

 +12       Begin DoDot:1

 +13           IF '$GET(DT)

                   SET DIRNOW=2050

                   QUIT

 +14           SET DIRNOW=1700+$EXTRACT(DT,1,3)

           End DoDot:1

 +15       SET DIRA="   Please enter a Report Year: "

 +16       IF $GET(BIYEAR)

               SET DIRB=+BIYEAR

 +17       SET DIRQ="   Enter a year between 1950 and the present, in the form yyyy"

 +18       DO FULL^VALM1

 +19       DO TITLE^BIUTL5("SELECT REPORT YEAR")

 +20       DO TEXT1

           WRITE !

 +21       DO DIR^BIFMAN("NAO^1950:"_DIRNOW,.Y,.BIPOP,DIRA,DIRB,DIRQ)

 +22       IF $GET(BIPOP)

               DO @("RESET^"_BIRTN)

               QUIT

 +23       SET BIYEAR=+Y

 +24       IF Y<1

               DO @("RESET^"_BIRTN)

               QUIT

 +25      ;

 +26       NEW DIR

 +27       WRITE !!?3,"You may select an End Date of either December 31, ",+BIYEAR

 +28       WRITE " or March 31, ",(+BIYEAR)+1,".",!

 +29       SET DIR("A")="   Select December or March: "

 +30       SET DIR("B")=$SELECT($PIECE(BIYEAR,U,2)="m":"March",1:"December")

 +31       SET DIR(0)="SAM^d:December;m:March"

 +32       DO ^DIR

           KILL DIR

 +33       IF Y=-1!($DATA(DIRUT))

               DO @("RESET^"_BIRTN)

               QUIT

 +34      ;---> If Y="m" concate to BIYEAR to signify End Date of March 31.  Otherwise,

 +35      ;---> default is 2nd "^"-piece of BIYEAR=""--which is End Date of Dec 31.

 +36       IF Y="m"

               SET BIYEAR=BIYEAR_U_"m"

 +37      ;

 +38       DO @("RESET^"_BIRTN)

 +39      ;

 +40       QUIT

 +41      ;

 +42      ;

 +43      ;----------

TEXT1     ;EP

 +1       ;;The "Report Year" represents the start of a particular influenza

 +2       ;;season.  So, for example, 2011 will cover the influenza season from

 +3       ;;September 1, 2011 until December 31, 2011 (or until March 31, 2012,

 +4       ;;if that End Date is chosen).

 +5       ;;

 +6       ;;The patient ages in the report will be calculated as of 12/31 of the

 +7       ;;Report Year you select (12/31/2011 in the above example).

 +8       ;;

 +9        DO PRINTX("TEXT1")

 +10       QUIT

 +11      ;

 +12      ;

 +13      ;----------

PRINTX(BILINL,BITAB) ;EP

 +1        IF $GET(BILINL)=""

               QUIT

 +2        NEW I,T,X

           SET T=""

           IF '$DATA(BITAB)

               SET BITAB=5

           FOR I=1:1:BITAB

               SET T=T_" "

 +3        FOR I=1:1

               SET X=$TEXT(@BILINL+I)

               IF X'[";;"

                   QUIT

               WRITE !,T,$PIECE(X,";;",2)

 +4        QUIT

 +5       ;

 +6       ;

 +7       ;----------

TEXT11(BITEXT) ;EP

 +1       ;;In producing lists and letters, you may select the group of patients

 +2       ;;you wish to include by specifying attributes of this screen, such as

 +3       ;;"DUE" or "ACTIVE."  These attributes may also be used in various

 +4       ;;combinations in order to further specify your patient group.

 +5       ;;(This group may be further limited by the other criteria you select

 +6       ;;on the main IMMUNIZATION LISTS & LETTERS Main Screen, such as Age Range,

 +7       ;;Communities, Lot Numbers, etc.)

 +8       ;;

 +9       ;;                               DUE

 +10      ;;                              -----

 +11      ;;"DUE" will list all Active patients who are DUE for immunizations,

 +12      ;;subject to any other limitations on the Lists & Letters Main Screen,

 +13      ;;such as Age Range, Community, etc..  "DUE" will also necessarily include

 +14      ;;any patients who are "PAST DUE."  By default, "DUE" will only include

 +15      ;;patients who are "ACTIVE" unless you specify "INACTIVE" as one of the

 +16      ;;attributes.

 +17      ;;

 +18      ;;                             PAST DUE

 +19      ;;                            ----------

 +20      ;;"PAST DUE" will only include patients who are past their due dates

 +21      ;;for one or more immunizations.  If you select this attribute, you

 +22      ;;will be given the opportunity to specify how many months past due

 +23      ;;you wish to check for.  By default, "PAST DUE" will only include

 +24      ;;patients who are "ACTIVE" unless you specify "INACTIVE" as one of the

 +25      ;;attributes.

 +26      ;;

 +27      ;;                        ACTIVE and INACTIVE

 +28      ;;                       ---------------------

 +29      ;;The choices of "ACTIVE" and "INACTIVE" will simply list patients in the

 +30      ;;Immunization Database who have the Statuses of Active or Inactive.

 +31      ;;"ACTIVE" and "INACTIVE" may also be used together to produce a list

 +32      ;;of all patients in the Immunization database.

 +33      ;;

 +34      ;;

 +35      ;;                      AUTOMATICALLY ACTIVATED

 +36      ;;                     -------------------------

 +37      ;;"AUTOMATICALLY ACTIVATED" will restrict the list to only those patients

 +38      ;;who were Automatically Activated in the Immunization database.  You may

 +39      ;;combine it with other attributes, such as ACTIVE or DUE, to produce a

 +40      ;;list that is more specific.  For example, you could produce a list of

 +41      ;;patients who were AUTOMATICALLY ACTIVATED and are now PAST DUE.

 +42      ;;

 +43      ;;

 +44      ;;                            REFUSALS

 +45      ;;                           ----------

 +46      ;;"REFUSALS" will restrict the list to only those patients who at some

 +47      ;;point refused an immunization (either the patient or the parent).

 +48      ;;You may combine REFUSALS with other attributes in order to produce a

 +49      ;;list that is more specific.  For example, you could produce a list of

 +50      ;;patients who were both INACTIVE and had REFUSALS on record.

 +51      ;;

 +52      ;;

 +53      ;;                          FEMALES ONLY

 +54      ;;                         --------------

 +55      ;;"FEMALES ONLY" will restrict the list to female patients only.

 +56      ;;NOTE: The list will include both "ACTIVE" and "INACTIVE" female

 +57      ;;patients unless you have specifically chosen Active or Inactive.

 +58      ;;

 +59      ;;

 +60      ;;                        SEARCH TEMPLATES

 +61      ;;                       ------------------

 +62      ;;SEARCH TEMPLATEs are groups of individual patients that have been

 +63      ;;produced and stored by other software, usually QMAN, and saved under

 +64      ;;a Template Name.  If you choose this attribute, you will be asked to

 +65      ;;select from a file of existing Search Templates.

 +66      ;;

 +67      ;;NOTE: A SEARCH TEMPLATE is a pre-defined group of patients and cannot

 +68      ;;be combined with any of the other attributes.

 +69      ;;For more information about Search Templates and how to create your

 +70      ;;own, contact your computer support people for training.

 +71      ;;

 +72      ;;

 +73      ;;Final note: The implications of combining too many restrictive attributes

 +74      ;;can be difficult to predict and may produce few or no results.

 +75      ;;It is best to limit a list to two or three combined attributes.

 +76      ;;

 +77       DO LOADTX("TEXT11",,.BITEXT)

 +78       QUIT

 +79      ;

 +80      ;

 +81      ;----------

LOADTX(BILINL,BITAB,BITEXT) ;EP

 +1        IF $GET(BILINL)=""

               QUIT

 +2        NEW I,T,X

           SET T=""

           IF '$DATA(BITAB)

               SET BITAB=5

           FOR I=1:1:BITAB

               SET T=T_" "

 +3        FOR I=1:1

               SET X=$TEXT(@BILINL+I)

               IF X'[";;"

                   QUIT

               SET BITEXT(I)=T_$PIECE(X,";;",2)

 +4        QUIT

BIOUTPT5.m