Routine: BISELEC1

BISELEC1 ;IHS/CMI/MWR - GENERIC SELETION UTILITY; MAY 10, 2010

 ;;8.5;IMMUNIZATION;;SEP 01,2011

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

 ;;  LISTMANAGER DRIVER ROUTINE FOR GENERIC SELECTION UTILITY.

 ;----------

START(BIARR1,BIGBL,BIITEMS,BITITEMS,BIPIECE,BISCRN,BIID,BICOL,BIFLD,BIPOP) ;EP

 ;---> Call Listmanager to select a list of Items.

 ;---> Parameters:

 ;     1 - BIARR1  (req) Selection Array (local).

 ;     2 - BIGBL   (req) Lookup global.

 ;     3 - BIITEMS (req) Catagoric name of Items being selected.

 ;     4 - BITITEMS (req) Title name of selected Items.

 ;     5 - BIPIECE (req) Piece of zero node to display as ItemName.

 ;     6 - BISCRN  (opt) Screen used in selection lookup.

 ;     7 - BIID    (opt) Identifier and code.

 ;     8 - BICOL   (opt) Column header text.

 ;     9 - BIFLD   (opt) Field# in BIFILE with Set of Codes to select.

 ;    10 - BIPOP   (ret) BIPOP, =1 if quit or error.

 ;---> New VALMQUIT so that quit from "ENTIRE1^BISELEC2" will work but

 ;---> will not cause the calling/parent instance of Listman to quit also.

 D SETVARS^BIUTL5 N VALMQUIT

 S BIPOP=0

 D EN^VALM("BI GENERIC SELECTION")

 D FULL^VALM1

 D EXIT

 ;----------

HDR ;EP

 ;---> Header code.

 N X,Y

 S VALMHDR(1)=""

 S X="   Select one or more "_BITITEMS_":"

 S VALMHDR(2)=X

 ;----------

INIT ;EP

 ;---> Initialize variables and list array.

 K ^TMP("BILMGS",$J),^TMP("BILMGS1",$J),^TMP("BILMGS2",$J)

 ;---> Check for necessary variables present.

 I $$CHECK^BISELECT() S BIPOP=1,VALMQUIT="" Q

 ;---> *** SET OF CODES

 ;---> If this is a Set of Codes, go to INIT1, then QUIT.

 I +$G(BIFLD) D INIT1 Q

 ;---> Continue with selection from a file.

 I '$O(@(BIARR1_"(0)")) S VALMCNT=0 Q

 ;---> Set Lower Frame Bar and Screen Title.

 S VALMSG="Type ?? for more actions."

 ;S VALM("TITLE")="Select "_BIITEMS

 ;---> Set Column Header line.

 D:$G(BICOL)]""

 .S VALMCAP=$$PAD^BIUTL5(BICOL,80)

 ;---> Convert IEN-sorted array to ItemName-sorted array.

 ;---> This will present Items in a numbered list, 1,2,3...,

 ;---> with the Item names in alphabetical order, so the user

 ;---> can search the list of Items in order.

 ;---> 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=""

.;

 .;---> Set Identifer if passed.

 .D:BIID]""

 ..;---> BIID Identifier: Three pieces delimited by ";".

 ..;                      1st piece = the "^" piece of 0 node to get X.

 ..;                      2nd piece = Code to set X=text of identifier.

 ..;                      3rd piece = Tab for identfier in Listman.

..;

 ..;---> Get piece (BIPC) of zero node that holds Identifier data.

 ..N BIPC,X S BIPC=$P(BIID,";")

 ..Q:'BIPC

 ..;---> Get Identifier data.

 ..S X=$P(BI0,U,BIPC)

 ..Q:X=""

 ..;---> Xecute code to process X (return ID text in X).

 ..;---> If there is no code, then value of X is displayed unchanged.

 ..X $P(BIID,";",2)

 ..S BIIDTX=X

 ..Q:BIIDTX=""

 ..;---> Tab out to specified column.

 ..N BITAB S BITAB=$P(BIID,";",3)

 ..N BIADD S BIADD=BITAB-($L(BINAME)+5)

 ..;---> Minimum of 2 spaces between Name and Identifier.

 ..S:BIADD<1 BIADD=2

 ..S BIIDTX=$$SP^BIUTL5(BIADD)_BIIDTX

.;

 .;---> Each node=IEN of Item_^_ItemName.

 .;---> The array will be sorted alphabetically by ItemName.

 .;---> Append IEN to ItemName to include legitimate duplicate names.

 .S ^TMP("BILMGS1",$J,BINAME_BIIEN)=BIIEN_U_BINAME_$G(BIIDTX)

 ;---> Now, convert ItemName-sorted array to Item-numbered array.

 N I,N S N=0

 F I=1:1 S N=$O(^TMP("BILMGS1",$J,N)) Q:N=""  D

 .S ^TMP("BILMGS2",$J,I)=^TMP("BILMGS1",$J,N)

 ;---> Insert blank line at the top of the List Region.

 S ^TMP("BILMGS",$J,1,0)=""

 S ^TMP("BILMGS",$J,"IDX",1,1)=""

 ;---> Set each Item (or previously) selected into the array.

 N N S N=0

 F  S N=$O(^TMP("BILMGS2",$J,N)) Q:'N  D

 .;---> Build display line for this Item.

 .N X

 .S X="  "_$J(N,3)_"  "_$P(^TMP("BILMGS2",$J,N),U,2)

.;

 .;---> Set formatted Item line and index in ^TMP.

 .S ^TMP("BILMGS",$J,N+1,0)=X

 .S ^TMP("BILMGS",$J,"IDX",N+1,N)=""

 ;---> Finish up Listmanager List Count.

 S VALMCNT=I

 I VALMCNT>13 D

 .S VALMSG="Scroll down to view more.  Type ?? for more actions."

 ;----------

INIT1 ;EP

 I $O(@(BIARR1_"(0)"))="" S VALMCNT=0 Q

 ;---> Set Lower Frame Bar and Screen Title.

 S VALMSG="Type ?? for more actions."

 ;S VALM("TITLE")="Select "_BIITEMS

 ;---> Set Column Header line.

 D:$G(BICOL)]""

 .S VALMCAP=$$PAD^BIUTL5(BICOL,80)

 ;---> Convert CODE-sorted array to CodeName-sorted array.

 ;---> This will present Items in a numbered list, 1,2,3...,

 ;---> with the Item names in alphabetical order, so the user

 ;---> can search the list of Items in order.

 Q:'$D(^DD(BIFILE,BIFLD,0))

 N BISET S BISET=$P(^DD(BIFILE,BIFLD,0),U,3)

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

 N BICODE S BICODE=0

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

.;

 .;---> If the Code does not really exist in the Set of Codes,

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

 .I BISET'[BICODE_":" K @(BIARR1_"(BICODE)") Q

.;

 .N BICODNM

 .S BICODNM=$P($P(BISET,BICODE_":",2),";")

.;

 .;---> The array will be sorted alphabetically by CodeName.

 .;---> Append Code to CodeName to include legitimate duplicate names.

 .S ^TMP("BILMGS1",$J,BICODNM_BICODE)=BICODE_U_BICODNM

 ;---> Now, convert ItemName-sorted array to Item-numbered array.

 N I,N S N=0

 F I=1:1 S N=$O(^TMP("BILMGS1",$J,N)) Q:N=""  D

 .S ^TMP("BILMGS2",$J,I)=^TMP("BILMGS1",$J,N)

 ;---> Insert blank line at the top of the List Region.

 S ^TMP("BILMGS",$J,1,0)=""

 S ^TMP("BILMGS",$J,"IDX",1,1)=""

 ;---> Set each Item (or previously) selected into the array.

 N N S N=0

 F  S N=$O(^TMP("BILMGS2",$J,N)) Q:'N  D

 .;---> Build display line for this Item.

 .N X,Y

 .S Y=^TMP("BILMGS2",$J,N)

 .S X="  "_$J(N,3)_"  "_$$PAD^BIUTL5($P(Y,U,2),32)_$P(Y,U)

.;

 .;---> Set formatted Item line and index in ^TMP.  Also, save

 .;---> "Left Column Number" and its corresponding Code, for deletions.

 .S ^TMP("BILMGS",$J,N+1,0)=X

 .S ^TMP("BILMGS",$J,"IDX",N+1,N)=""

 ;---> Finish up Listmanager List Count.

 S VALMCNT=I

 I VALMCNT>13 D

 .S VALMSG="Scroll down to view more.  Type ?? for more actions."

 ;----------

RESET ;EP

 ;---> Update partition for return to Listmanager.

 I $D(VALMQUIT) S VALMBCK="Q" Q

 D TERM^VALM0 S VALMBCK="R"

 D INIT,HDR

 ;----------

HELP ;EP

 ;----> Help text display when "?" is entered.

 N BIXX S BIXX=$S($G(BIITEMS)="":"Items",1:BIITEMS)

 D EN^XBNEW("HELP1^BISELEC1","VALM*;IO*;BIXX")

 D RESET

 ;----------

HELP1 ;EP

 ;---> Display Help Text in Listmanager.

 ;---> Set Help Text into local array.

 N BITEXT D TEXT1(.BITEXT)

 ;---> Insert the passed Item Name into the Help Text array.

 N N S N=0

 F  S N=$O(BITEXT(N)) Q:'N  D

 .Q:BITEXT(N)'[" BIXX"

 .N X S X=$P(BITEXT(N),"BIXX")_BIXX_$P(BITEXT(N),"BIXX",2),BITEXT(N)=X

 D START^BIHELP("LIST SELECTION UTILITY - HELP",.BITEXT)

 ;----------

TEXT1(BITEXT) ;EP

 ;;This allows you to select and build a list of BIXX

 ;;for your report.  The following four actions are available:

;;

 ;;ADD...: Use this to select BIXX from the file of

 ;;        BIXX and add them to your list.

;;

 ;;DELETE: Use this to remove items from your list.

;;

 ;;ENTIRE: Use this to add ALL items from the file to your list.

 ;;        This may be useful if you want to select MOST of the items

 ;;        in the file by adding all and then deleting the few items

 ;;        you do not want.  This will only work for up to 300 items.

 ;;        If the file contains more than 300 items, it will simply add

 ;;        ALL items and quit.

;;

 ;;CLEAR.: Use this to remove all items from your list (and start over).

;;

 ;;Your personal list of BIXX will be saved each time

 ;;you build it.  Whenever you return to this list, the previous

 ;;list of BIXX you built will be presented as a

 ;;default list.

;;

 D LOADTX("TEXT1",,.BITEXT)

 ;----------

EXIT ;EP

 K ^TMP("BILMGS",$J),^TMP("BILMGS1",$J),^TMP("BILMGS2",$J),^TMP("BILMGS3",$J)

 D CLEAR^VALM1

 ;----------

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)

BISELEC1  ;IHS/CMI/MWR - GENERIC SELETION UTILITY; MAY 10, 2010

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

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

 +3       ;;  LISTMANAGER DRIVER ROUTINE FOR GENERIC SELECTION UTILITY.

 +4       ;

 +5       ;

 +6       ;----------

START(BIARR1,BIGBL,BIITEMS,BITITEMS,BIPIECE,BISCRN,BIID,BICOL,BIFLD,BIPOP) ;EP

 +1       ;---> Call Listmanager to select a list of Items.

 +2       ;---> Parameters:

 +3       ;     1 - BIARR1  (req) Selection Array (local).

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

 +5       ;     3 - BIITEMS (req) Catagoric name of Items being selected.

 +6       ;     4 - BITITEMS (req) Title name of selected Items.

 +7       ;     5 - BIPIECE (req) Piece of zero node to display as ItemName.

 +8       ;     6 - BISCRN  (opt) Screen used in selection lookup.

 +9       ;     7 - BIID    (opt) Identifier and code.

 +10      ;     8 - BICOL   (opt) Column header text.

 +11      ;     9 - BIFLD   (opt) Field# in BIFILE with Set of Codes to select.

 +12      ;    10 - BIPOP   (ret) BIPOP, =1 if quit or error.

 +13      ;

 +14      ;

 +15      ;---> New VALMQUIT so that quit from "ENTIRE1^BISELEC2" will work but

 +16      ;---> will not cause the calling/parent instance of Listman to quit also.

 +17       DO SETVARS^BIUTL5

           NEW VALMQUIT

 +18       SET BIPOP=0

 +19       DO EN^VALM("BI GENERIC SELECTION")

 +20       DO FULL^VALM1

 +21       DO EXIT

 +22       QUIT

 +23      ;

 +24      ;

 +25      ;----------

HDR       ;EP

 +1       ;---> Header code.

 +2        NEW X,Y

 +3        SET VALMHDR(1)=""

 +4        SET X="   Select one or more "_BITITEMS_":"

 +5        SET VALMHDR(2)=X

 +6        QUIT

 +7       ;

 +8       ;

 +9       ;----------

INIT      ;EP

 +1       ;---> Initialize variables and list array.

 +2        KILL ^TMP("BILMGS",$JOB),^TMP("BILMGS1",$JOB),^TMP("BILMGS2",$JOB)

 +3       ;

 +4       ;---> Check for necessary variables present.

 +5        IF $$CHECK^BISELECT()

               SET BIPOP=1

               SET VALMQUIT=""

               QUIT

 +6       ;

 +7       ;---> *** SET OF CODES

 +8       ;---> If this is a Set of Codes, go to INIT1, then QUIT.

 +9        IF +$GET(BIFLD)

               DO INIT1

               QUIT

 +10      ;

 +11      ;---> Continue with selection from a file.

 +12       IF '$ORDER(@(BIARR1_"(0)"))

               SET VALMCNT=0

               QUIT

 +13      ;

 +14      ;---> Set Lower Frame Bar and Screen Title.

 +15       SET VALMSG="Type ?? for more actions."

 +16      ;S VALM("TITLE")="Select "_BIITEMS

 +17      ;

 +18      ;---> Set Column Header line.

 +19       IF $GET(BICOL)]""

               Begin DoDot:1

 +20               SET VALMCAP=$$PAD^BIUTL5(BICOL,80)

               End DoDot:1

 +21      ;

 +22      ;---> Convert IEN-sorted array to ItemName-sorted array.

 +23      ;---> This will present Items in a numbered list, 1,2,3...,

 +24      ;---> with the Item names in alphabetical order, so the user

 +25      ;---> can search the list of Items in order.

 +26      ;

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

 +28       NEW BIIEN

           SET BIIEN=0

 +29       FOR

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

               IF 'BIIEN

                   QUIT

               Begin DoDot:1

 +30      ;

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

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

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

                       KILL @(BIARR1_"(BIIEN)")

                       QUIT

 +34      ;

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

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

 +37               IF BISCRN]""

                       NEW Y

                       SET Y=BIIEN

                       XECUTE BISCRN

                       IF '$TEST

                           KILL @(BIARR1_"(BIIEN)")

                           QUIT

 +38      ;

 +39               NEW BI0,BINAME,BIIDTX

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

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

 +42               IF BINAME=""

                       QUIT

 +43      ;

 +44      ;---> Set Identifer if passed.

 +45               IF BIID]""

                       Begin DoDot:2

 +46      ;---> BIID Identifier: Three pieces delimited by ";".

 +47      ;                      1st piece = the "^" piece of 0 node to get X.

 +48      ;                      2nd piece = Code to set X=text of identifier.

 +49      ;                      3rd piece = Tab for identfier in Listman.

 +50      ;

 +51      ;---> Get piece (BIPC) of zero node that holds Identifier data.

 +52                       NEW BIPC,X

                           SET BIPC=$PIECE(BIID,";")

 +53                       IF 'BIPC

                               QUIT

 +54      ;---> Get Identifier data.

 +55                       SET X=$PIECE(BI0,U,BIPC)

 +56                       IF X=""

                               QUIT

 +57      ;---> Xecute code to process X (return ID text in X).

 +58      ;---> If there is no code, then value of X is displayed unchanged.

 +59                       XECUTE $PIECE(BIID,";",2)

 +60                       SET BIIDTX=X

 +61                       IF BIIDTX=""

                               QUIT

 +62      ;---> Tab out to specified column.

 +63                       NEW BITAB

                           SET BITAB=$PIECE(BIID,";",3)

 +64                       NEW BIADD

                           SET BIADD=BITAB-($LENGTH(BINAME)+5)

 +65      ;---> Minimum of 2 spaces between Name and Identifier.

 +66                       IF BIADD<1

                               SET BIADD=2

 +67                       SET BIIDTX=$$SP^BIUTL5(BIADD)_BIIDTX

                       End DoDot:2

 +68      ;

 +69      ;---> Each node=IEN of Item_^_ItemName.

 +70      ;---> The array will be sorted alphabetically by ItemName.

 +71      ;---> Append IEN to ItemName to include legitimate duplicate names.

 +72               SET ^TMP("BILMGS1",$JOB,BINAME_BIIEN)=BIIEN_U_BINAME_$GET(BIIDTX)

               End DoDot:1

 +73      ;

 +74      ;

 +75      ;---> Now, convert ItemName-sorted array to Item-numbered array.

 +76       NEW I,N

           SET N=0

 +77       FOR I=1:1

               SET N=$ORDER(^TMP("BILMGS1",$JOB,N))

               IF N=""

                   QUIT

               Begin DoDot:1

 +78               SET ^TMP("BILMGS2",$JOB,I)=^TMP("BILMGS1",$JOB,N)

               End DoDot:1

 +79      ;

 +80      ;---> Insert blank line at the top of the List Region.

 +81       SET ^TMP("BILMGS",$JOB,1,0)=""

 +82       SET ^TMP("BILMGS",$JOB,"IDX",1,1)=""

 +83      ;

 +84      ;---> Set each Item (or previously) selected into the array.

 +85       NEW N

           SET N=0

 +86       FOR

               SET N=$ORDER(^TMP("BILMGS2",$JOB,N))

               IF 'N

                   QUIT

               Begin DoDot:1

 +87      ;---> Build display line for this Item.

 +88               NEW X

 +89               SET X="  "_$JUSTIFY(N,3)_"  "_$PIECE(^TMP("BILMGS2",$JOB,N),U,2)

 +90      ;

 +91      ;---> Set formatted Item line and index in ^TMP.

 +92               SET ^TMP("BILMGS",$JOB,N+1,0)=X

 +93               SET ^TMP("BILMGS",$JOB,"IDX",N+1,N)=""

               End DoDot:1

 +94      ;

 +95      ;---> Finish up Listmanager List Count.

 +96       SET VALMCNT=I

 +97       IF VALMCNT>13

               Begin DoDot:1

 +98               SET VALMSG="Scroll down to view more.  Type ?? for more actions."

               End DoDot:1

 +99       QUIT

 +100     ;

 +101     ;

 +102     ;----------

INIT1     ;EP

 +1       ;

 +2        IF $ORDER(@(BIARR1_"(0)"))=""

               SET VALMCNT=0

               QUIT

 +3       ;

 +4       ;---> Set Lower Frame Bar and Screen Title.

 +5        SET VALMSG="Type ?? for more actions."

 +6       ;S VALM("TITLE")="Select "_BIITEMS

 +7       ;

 +8       ;---> Set Column Header line.

 +9        IF $GET(BICOL)]""

               Begin DoDot:1

 +10               SET VALMCAP=$$PAD^BIUTL5(BICOL,80)

               End DoDot:1

 +11      ;

 +12      ;---> Convert CODE-sorted array to CodeName-sorted array.

 +13      ;---> This will present Items in a numbered list, 1,2,3...,

 +14      ;---> with the Item names in alphabetical order, so the user

 +15      ;---> can search the list of Items in order.

 +16      ;

 +17       IF '$DATA(^DD(BIFILE,BIFLD,0))

               QUIT

 +18       NEW BISET

           SET BISET=$PIECE(^DD(BIFILE,BIFLD,0),U,3)

 +19      ;

 +20      ;---> First, build array sorted by Code.

 +21       NEW BICODE

           SET BICODE=0

 +22       FOR

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

               IF BICODE=""

                   QUIT

               Begin DoDot:1

 +23      ;

 +24      ;---> If the Code does not really exist in the Set of Codes,

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

 +26               IF BISET'[BICODE_":"

                       KILL @(BIARR1_"(BICODE)")

                       QUIT

 +27      ;

 +28               NEW BICODNM

 +29               SET BICODNM=$PIECE($PIECE(BISET,BICODE_":",2),";")

 +30      ;

 +31      ;---> The array will be sorted alphabetically by CodeName.

 +32      ;---> Append Code to CodeName to include legitimate duplicate names.

 +33               SET ^TMP("BILMGS1",$JOB,BICODNM_BICODE)=BICODE_U_BICODNM

               End DoDot:1

 +34      ;

 +35      ;---> Now, convert ItemName-sorted array to Item-numbered array.

 +36       NEW I,N

           SET N=0

 +37       FOR I=1:1

               SET N=$ORDER(^TMP("BILMGS1",$JOB,N))

               IF N=""

                   QUIT

               Begin DoDot:1

 +38               SET ^TMP("BILMGS2",$JOB,I)=^TMP("BILMGS1",$JOB,N)

               End DoDot:1

 +39      ;

 +40      ;---> Insert blank line at the top of the List Region.

 +41       SET ^TMP("BILMGS",$JOB,1,0)=""

 +42       SET ^TMP("BILMGS",$JOB,"IDX",1,1)=""

 +43      ;

 +44      ;---> Set each Item (or previously) selected into the array.

 +45       NEW N

           SET N=0

 +46       FOR

               SET N=$ORDER(^TMP("BILMGS2",$JOB,N))

               IF 'N

                   QUIT

               Begin DoDot:1

 +47      ;---> Build display line for this Item.

 +48               NEW X,Y

 +49               SET Y=^TMP("BILMGS2",$JOB,N)

 +50               SET X="  "_$JUSTIFY(N,3)_"  "_$$PAD^BIUTL5($PIECE(Y,U,2),32)_$PIECE(Y,U)

 +51      ;

 +52      ;---> Set formatted Item line and index in ^TMP.  Also, save

 +53      ;---> "Left Column Number" and its corresponding Code, for deletions.

 +54               SET ^TMP("BILMGS",$JOB,N+1,0)=X

 +55               SET ^TMP("BILMGS",$JOB,"IDX",N+1,N)=""

               End DoDot:1

 +56      ;

 +57      ;---> Finish up Listmanager List Count.

 +58       SET VALMCNT=I

 +59       IF VALMCNT>13

               Begin DoDot:1

 +60               SET VALMSG="Scroll down to view more.  Type ?? for more actions."

               End DoDot:1

 +61       QUIT

 +62      ;

 +63      ;

 +64      ;----------

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

           DO HDR

 +5        QUIT

 +6       ;

 +7       ;

 +8       ;----------

HELP      ;EP

 +1       ;----> Help text display when "?" is entered.

 +2        NEW BIXX

           SET BIXX=$SELECT($GET(BIITEMS)="":"Items",1:BIITEMS)

 +3        DO EN^XBNEW("HELP1^BISELEC1","VALM*;IO*;BIXX")

 +4        DO RESET

 +5        QUIT

 +6       ;

 +7       ;

 +8       ;----------

HELP1     ;EP

 +1       ;---> Display Help Text in Listmanager.

 +2       ;

 +3       ;---> Set Help Text into local array.

 +4        NEW BITEXT

           DO TEXT1(.BITEXT)

 +5       ;---> Insert the passed Item Name into the Help Text array.

 +6        NEW N

           SET N=0

 +7        FOR

               SET N=$ORDER(BITEXT(N))

               IF 'N

                   QUIT

               Begin DoDot:1

 +8                IF BITEXT(N)'[" BIXX"

                       QUIT

 +9                NEW X

                   SET X=$PIECE(BITEXT(N),"BIXX")_BIXX_$PIECE(BITEXT(N),"BIXX",2)

                   SET BITEXT(N)=X

               End DoDot:1

 +10      ;

 +11       DO START^BIHELP("LIST SELECTION UTILITY - HELP",.BITEXT)

 +12       QUIT

 +13      ;

 +14      ;

 +15      ;----------

TEXT1(BITEXT) ;EP

 +1       ;;This allows you to select and build a list of BIXX

 +2       ;;for your report.  The following four actions are available:

 +3       ;;

 +4       ;;ADD...: Use this to select BIXX from the file of

 +5       ;;        BIXX and add them to your list.

 +6       ;;

 +7       ;;DELETE: Use this to remove items from your list.

 +8       ;;

 +9       ;;ENTIRE: Use this to add ALL items from the file to your list.

 +10      ;;        This may be useful if you want to select MOST of the items

 +11      ;;        in the file by adding all and then deleting the few items

 +12      ;;        you do not want.  This will only work for up to 300 items.

 +13      ;;        If the file contains more than 300 items, it will simply add

 +14      ;;        ALL items and quit.

 +15      ;;

 +16      ;;CLEAR.: Use this to remove all items from your list (and start over).

 +17      ;;

 +18      ;;Your personal list of BIXX will be saved each time

 +19      ;;you build it.  Whenever you return to this list, the previous

 +20      ;;list of BIXX you built will be presented as a

 +21      ;;default list.

 +22      ;;

 +23       DO LOADTX("TEXT1",,.BITEXT)

 +24       QUIT

 +25      ;

 +26      ;

 +27      ;----------

EXIT      ;EP

 +1        KILL ^TMP("BILMGS",$JOB),^TMP("BILMGS1",$JOB),^TMP("BILMGS2",$JOB),^TMP("BILMGS3",$JOB)

 +2        DO CLEAR^VALM1

 +3        QUIT

 +4       ;

 +5       ;

 +6       ;----------

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

BISELEC1.m