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
Q
;
;
;----------
HDR ;EP
;---> Header code.
N X,Y
S VALMHDR(1)=""
S X=" Select one or more "_BITITEMS_":"
S VALMHDR(2)=X
Q
;
;
;----------
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."
Q
;
;
;----------
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."
Q
;
;
;----------
RESET ;EP
;---> Update partition for return to Listmanager.
I $D(VALMQUIT) S VALMBCK="Q" Q
D TERM^VALM0 S VALMBCK="R"
D INIT,HDR
Q
;
;
;----------
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
Q
;
;
;----------
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)
Q
;
;
;----------
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)
Q
;
;
;----------
EXIT ;EP
K ^TMP("BILMGS",$J),^TMP("BILMGS1",$J),^TMP("BILMGS2",$J),^TMP("BILMGS3",$J)
D CLEAR^VALM1
Q
;
;
;----------
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)
Q
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
