Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BISELECT

BISELECT.m

Go to the documentation of this file. 
  1. BISELECT ;IHS/CMI/MWR - GENERIC SELECTION UTILITY ; MAY 10, 2010
  1.  ;;8.5;IMMUNIZATION;;SEP 01,2011
  1.  ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
  1.  ;;  UTILITY TO PROMPT FOR MULTIPLE SELECTIONS FROM A FILE AND STORE
  1.  ;;  THEM IN A LOCAL ARRAY FOR CALLING PROGRAM.
  1.  ;
  1.  ;
  1.  ;---> Executable example selecting Entries from a File.
  1.  D SEL(9999999.14,"BIZZ")
  1.  Q
  1.  ;
  1.  ;---> Executable example selecting Codes from a Set of Codes in a Field.
  1.  ;---> Key element is 11th Parameter, the Field# (must be a Set of Codes).
  1.  N BINAM S BINAM="Visit Type"
  1.  N BICOL S BICOL="    #  Visit Type                     Code"
  1.  D SEL^BISELECT(9000010,"BIVT",BINAM,,,,,BICOL,.BIPOP,,".03")
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. SEL(BIFILE,BIARR1,BIITEM,BISCRN,BIDFLT,BIPC,BIID,BICOL,BIPOP,BINONE,BIFLD,BIDFA,BITITEM) ;EP
  1.  ;---> Generic utility to prompt user for selections from a file.
  1.  ;---> Returns local array with subscripts of IENs selected.
  1.  ;---> Parameters:
  1.  ;     1 - BIFILE  (req) File Number from which selection will be made.
  1.  ;
  1.  ;     2 - BIARR1  (req) Selection Array.
  1.  ;                       Local array in which selections will be stored.
  1.  ;                       May not be a global.
  1.  ;                       The Selection Array MUST BE UNSUBSCRIPTED--
  1.  ;                       may not contain "(", commas, or subscripts.
  1.  ;                       If ALL entries in the file are selected and
  1.  ;                       the array would be more than 300 entries, then
  1.  ;                       BIARR1_"(""ALL"")" is returned.
  1.  ;                       NOTE: This CANNOT be "BIARR1" or it will
  1.  ;                             kill the variable, BIARR1, that stores
  1.  ;                             the local array name!
  1.  ;
  1.  ;     3 - BIITEM  (opt) Catagoric name of Items being selected.
  1.  ;     4 - BISCRN  (opt) Screen used in selection lookup.
  1.  ;                       NO NAKED REFERENCES.  Use full global refs.
  1.  ;     5 - BIDFLT  (opt) Default first selection (if no previous).
  1.  ;     6 - BIPC    (opt) Piece of zero node to display as ItemName.
  1.  ;                       (Default is 1.)
  1.  ;
  1.  ;     7 - BIID    (opt) Identifier: Three pieces delimited by ";".
  1.  ;                       1st piece = the "^" piece of 0 node to get X.
  1.  ;                       2nd piece = Code to set X=text of identifier.
  1.  ;                                   If null, raw data in the piece of
  1.  ;                                   0 node (as specified above) will
  1.  ;                                   be displayed.
  1.  ;                       3rd piece = Tab for identfier.
  1.  ;
  1.  ;                       Examples:
  1.  ;                         Display 3rd pc of 0 node:  S BIID="3"
  1.  ;
  1.  ;                         Display 3rd pc of 0 node,
  1.  ;                                 tabbed out to 40:  S BIID="3;;40"
  1.  ;
  1.  ;                         Set X=3rd pc of 0 node, use it as an IEN in
  1.  ;                         the STATE file, set X=text of State, tab out
  1.  ;                         to column 25 in Listman display:
  1.  ;
  1.  ;                 S BIID="3;I $G(X) S:$D(^DIC(5,X,0)) X=$P(^(0),U);25"
  1.  ;
  1.  ;
  1.  ;     8 - BICOL   (opt) Line of text that will be column headers.
  1.  ;
  1.  ;     9 - BIPOP   (ret) BIPOP=1 if quit or error.
  1.  ;
  1.  ;    10 - BINONE  (opt) If BINONE=1 and NO selections were made,
  1.  ;                          do not return any BIARR1.
  1.  ;                       If '$G(BINONE) and NO selections were made,
  1.  ;                          return BIARR1_("ALL").
  1.  ;                       If user selects "Entire File", then "ALL" will
  1.  ;                          be returned regardless of BINONE.
  1.  ;
  1.  ;    11 - BIFLD   (opt) BIFLD=Field# If BIFLD has a value, it indicates
  1.  ;                       that this is NOT a selection from a file; rather
  1.  ;                       it is a selection of Codes from a field in BIFILE.
  1.  ;
  1.  ;    12 - BIDFA   (opt) BIDFA=Default Array of choices.
  1.  ;    13 - BITITEM (opt) Catagoric name of Title Items being selected.
  1.  ;                       This might be a specific name for the items chosen,
  1.  ;                       as opposed to the generic name (e.g,. "ER Doctors"
  1.  ;                       as opposed to "Doctors").
  1.  ;
  1.  ;
  1.  ;---> Examples of calls:
  1.  ;
  1.  ;  Simple call: Select one or more Vaccines and store
  1.  ;               in the local array BIZZ:
  1.  ;
  1.  ;   D SEL^BISELECT(9999999.14,"BIZZ")
  1.  ;
  1.  ;
  1.  ;  Complex call: Select one or more Active Vaccines and store
  1.  ;                in the local array BIZZ.  Also, display Current
  1.  ;                Lot Number, tabbed to column 20 in Listman display.
  1.  ;
  1.  ;   S SCRN="I '$P(^AUTTIMM(Y,0),U,7)"
  1.  ;   S IDEN="4;I $G(X) S:$D(^AUTTIML(X,0)) X=$P(^(0),U);20"
  1.  ;   D SEL^BISELECT(9999999.14,"BIZZ","Vaccine",SCRN,,2,IDEN,,.BIPOP)
  1.  ;
  1.  ;
  1.  ;---> Example use of Selection Array in calling routine:
  1.  ;       I '$D(BIARR("ALL")) Q:'$D(BIARR($P(Y,U,4)))
  1.  ;       "If not selecting all, then quit if the fourth piece of
  1.  ;        this entry (Y) is not one of the items selected."
  1.  ;
  1.  ;
  1.  N BIDUZF,BIGBL,BIITEMS,BITITEMS,DIC,DIK,DIR,I,X,Y,Z
  1.  S BIPOP=0
  1.  ;
  1.  ;---> Check/set required variables.
  1.  I $$CHECK() S BIPOP=1 Q
  1.  ;
  1.  ;---> BIDUZF=User-File# identifier to store and retrieve
  1.  ;---> previous lists of selections from this file.
  1.  S BIDUZF=DUZ_"-"_BIFILE
  1.  ;---> If this is a Set of Codes, concat Field#.
  1.  S:$G(BIFLD) BIDUZF=BIDUZF_"-"_BIFLD
  1.  ;
  1.  ;---> Clear "ALL" node.
  1.  K @(BIARR1_"(""ALL"")")
  1.  ;
  1.  ;---> If a Default Local Array of selections was passed, set them now.
  1.  ;---> NOTE: This passed default array will OVERRIDE a previously selected
  1.  ;---> and stored array in ^BISELECT.
  1.  D:$O(BIDFA(0))
  1.  .N N S N=0
  1.  .F  S N=$O(BIDFA(N)) Q:'N  S @(BIARR1_"(N)")=""
  1.  ;
  1.  ;---> If previously stored selections exist for this user,
  1.  ;---> pre-load these into the Selection Array that Listmanager
  1.  ;---> will be processing.
  1.  I $D(^BISELECT("B",BIDUZF)) D
  1.  .;---> Quit if a local array of selections already exists.
  1.  .Q:$O(@(BIARR1_"(0)"))
  1.  .N BIDA S BIDA=$O(^BISELECT("B",BIDUZF,0))
  1.  .Q:'BIDA  Q:$G(^BISELECT(BIDA,0))=""
  1.  .Q:'$O(^BISELECT(BIDA,1,0))
  1.  .N Y S Y=0
  1.  .F  S Y=$O(^BISELECT(BIDA,1,Y)) Q:Y=""  D
  1.  ..;---> If this is a Set of Codes, set the Value of the stored node
  1.  ..;---> (rather than the subscript) into the Selection Array.
  1.  ..I $G(BIFLD) D  Q
  1.  ...N Z S Z=^BISELECT(BIDA,1,Y,0),@(BIARR1_"(Z)")=""
  1.  ..S @(BIARR1_"(Y)")=""
  1.  ;
  1.  ;
  1.  ;---> If there are no previous selections and a default
  1.  ;---> was passed, load the default into the Selection Array.
  1.  I '$O(@(BIARR1_"(0)")) I BIDFLT S @(BIARR1_"(+BIDFLT)")=""
  1.  ;
  1.  ;
  1.  ;---> * Listmanager call to add/delete Items in the Selection Array.
  1.  D START^BISELEC1(.BIARR1,BIGBL,BIITEMS,BITITEMS,BIPC,BISCRN,BIID,BICOL,BIFLD,.BIPOP)
  1.  ;
  1.  ;---> If All were selected, remove any specific IENs from array.
  1.  ;---> Also leave intact user's previous selection (don't store "Entire").
  1.  I $D(@(BIARR1_"(""ALL"")")) K @(BIARR1) S @(BIARR1_"(""ALL"")")="" Q
  1.  ;
  1.  ;---> If none were selected BINONE'=1, Set (return) BIARR1_"ALL"
  1.  I '$D(@(BIARR1)),'$G(BINONE) S @(BIARR1_"(""ALL"")")=""
  1.  Q:BIPOP
  1.  ;
  1.  ;
  1.  ;---> Now store list of Items selected in this file for next time.
  1.  ;
  1.  ;---> If the user selected nothing or Entire, leave previous selection intact.
  1.  Q:$O(@(BIARR1_"(0)"))=""
  1.  ;
  1.  ;---> Clear any previous selection this user had for this file.
  1.  I $D(^BISELECT("B",BIDUZF)) D
  1.  .N DA,DIK S DA=$O(^BISELECT("B",BIDUZF,0)),DIK="^BISELECT("
  1.  .D ^DIK
  1.  .S $P(^BISELECT(0),U,3)=1
  1.  ;
  1.  ;---> Now store the selections for this user.
  1.  N Y
  1.  D FILE^BIFMAN(9002084.61,BIDUZF,"ML",,,.Y)
  1.  Q:Y<1
  1.  D
  1.  .;---> If this is a Set of Codes, assign IEN's.
  1.  .I +$G(BIFLD) D  Q
  1.  ..N I,N S N=0,Y=+Y
  1.  ..F I=1:1 S N=$O(@(BIARR1_"(N)")) Q:N=""  D
  1.  ...S ^BISELECT(Y,1,I,0)=N
  1.  .;
  1.  .;---> Store IEN's of a File.
  1.  .N N S N=0,Y=+Y
  1.  .F  S N=$O(@(BIARR1_"(N)")) Q:'N  D
  1.  ..S ^BISELECT(Y,1,N,0)=N
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. CHECK() ;EP
  1.  ;---> Check required variables.
  1.  ;
  1.  I $G(DUZ)="" D ERRCD^BIUTL2(106,,1) Q 1
  1.  ;
  1.  ;---> Check that the File Number was passed and is legitimate.
  1.  I '$G(BIFILE) D ERRCD^BIUTL2(607,,1) Q 1
  1.  I '$D(^DD(BIFILE)) D ERRCD^BIUTL2(608,,1) Q 1
  1.  I '$D(^DIC(BIFILE,0,"GL")) D ERRCD^BIUTL2(608,,1) Q 1
  1.  ;
  1.  ;---> Check that Selection Array name for Item storage is present.
  1.  I $G(BIARR1)="" D ERRCD^BIUTL2(602,,1) Q 1
  1.  ;---> Check valid form of Selection Array root.
  1.  I BIARR1["(" D ERRCD^BIUTL2(605,,1) Q 1
  1.  I $E(BIARR1)="^" D ERRCD^BIUTL2(606,,1) Q 1
  1.  ;
  1.  ;---> Set lookup global.
  1.  D:$G(BIGBL)=""
  1.  .S BIGBL=^DIC(BIFILE,0,"GL")
  1.  .;
  1.  .;---> If .01 field is a pointer, reset global to get text from
  1.  .;---> pointed-to global.
  1.  .I $P(^DD(BIFILE,.01,0),U,2)["P" S BIGBL="^"_$P(^(0),U,3)
  1.  ;
  1.  ;---> Check that the global for Item selection is legitimate.
  1.  I '$D(@(BIGBL_"0)")) D ERRCD^BIUTL2(601,,1) Q 1
  1.  ;
  1.  ;---> Check that variable for Item name is present.
  1.  I $G(BIITEM)="" S BIITEM=$P($G(^DD(BIFILE,.01,0)),U)
  1.  S:BIITEM="" BIITEM="Item"
  1.  S:'$D(BITITEM) BITITEM=BIITEM
  1.  ;
  1.  ;---> Check for plural form of Item Name.
  1.  I $G(BIITEMS)="" D PLURAL(BIITEM,.BIITEMS)
  1.  I $G(BITITEMS)="" D PLURAL(BITITEM,.BITITEMS)
  1.  ;
  1.  ;---> Check for existence and value of optional input parameters.
  1.  S:'$G(BIPC) BIPC=1
  1.  S:$G(BISCRN)="" BISCRN=""
  1.  S:'$G(BIDFLT) BIDFLT=""
  1.  S:$G(BIID)="" BIID=""
  1.  S:$G(BICOL)="" BICOL=""
  1.  S:$G(BIFLD)="" BIFLD=""
  1.  ;
  1.  Q 0
  1.  ;
  1.  ;
  1.  ;----------
  1. PLURAL(BIITEM,BIITEMS) ;EP
  1.  ;---> Add "s" for plural.
  1.  ;---> If necessary change "y" to "i" and add "es".
  1.  ;---> Parameters:
  1.  ;     1 - BIITEM  (req) Item name, singular form.
  1.  ;     2 - BIITEMS (ret) Item name, plural form.
  1.  ;
  1.  I $G(BIITEM)="" S BIITEMS="" Q
  1.  ;
  1.  I "Yy"[$E(BIITEM,$L(BIITEM)) D  Q
  1.  .S BIITEMS=$E(BIITEM,1,($L(BIITEM)-1))_"ies"
  1.  ;
  1.  I "Xx"[$E(BIITEM,$L(BIITEM)) D  Q
  1.  .S BIITEMS=BIITEM_"es"
  1.  ;
  1.  S BIITEMS=BIITEM_"s"
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. SELCODE(BIFILE,BIARR1,BIITEM,BISCRN,BIDFLT,BIPC,BIID,BICOL,BIPOP,BINONE) ;EP
  1.  ;---> Generic utility to prompt user for selections from a file.
  1.  ;---> Returns local array with subscripts of IENs selected.
  1.  ;---> Parameters:
  1.  ;     1 - BIFILE  (req) File Number from which selection will be made.
  1.  Q