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

IBCNILK.m

Go to the documentation of this file. 
  1. IBCNILK ;ALB/FA - Insurance Company Selection ; 02-OCT-2015
  1.  ;;2.0;INTEGRATED BILLING;**549,713,737,763**;21-MAR-94;Build 29
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;;
  1.  ;
  1. EN(WHICH,PIEN,FILTER) ;EP
  1.  ; Main entry point for the Insurance Company Selection template
  1.  ; Input:   WHICH     - 1 - Only Show Active Insurance Companies
  1.  ;                      0 - Only Show Inactive Insurance Companies
  1.  ;                      2 - Show Both Active and Inactive Insurance Companies
  1.  ;          PIEN      - IEN of the Payer to use to filter Insurance Company
  1.  ;                      lookups. Optional, defaults to "".
  1.  ;          FILTER    - A^B^C Where:
  1.  ;                       A - 1 - Search for Insurance Companies that begin with
  1.  ;                               the specified text (case insensitive)
  1.  ;                           2 - Search for Insurance Companies that contain
  1.  ;                               the specified text (case insensitive)
  1.  ;                           3 - Search for Insurance Companies in a specified
  1.  ;                               range (inclusive, case insensitive)
  1.  ;                           4 - Search for Name(s) that are blank (null)
  1.  ;                           5 - Filter by Selected Payer only
  1.  ;IB*737/CKB - changed what was Filter '4' to '5' and updated '4'. When the Coverage Limitations Report was added,
  1.  ; it uses '4' to 'search for Name(s) that are blank (null)' when calling $$FILTER^IBCNINSU.
  1.  ;
  1.  ;                       B - Begin with text if A=1, Contains Text if A=2 or
  1.  ;                            the range start if A=3
  1.  ;                       C - Range End text (only present when A=3)
  1.  ;                      Optional, if not passed, user is prompted for filter
  1.  ;                      selection
  1.  ; Output:  ^TMP("IBCNILKA,$J,IIEN)    - Array of selected insurance companies
  1.  N NUMSEL
  1.  S:'$D(PIEN) PIEN=""
  1.  S:'$D(FILTER) FILTER=$$GETFILT()
  1.  ;IB*713/CKB - allow user to exit
  1.  I $G(FILTER)="^" Q
  1.  Q:FILTER=""
  1.  S NUMSEL=0
  1.  K ^TMP("IBCNILKA",$J)
  1.  D EN^VALM("IBCN INS CO SELECTOR")
  1.  Q
  1.  ;
  1. NEWSRCH() ; EP
  1.  ; Protocol action to get new filter criteria and redisplay the listman
  1.  ; template body and header
  1.  ; Input:   FILTER      - Current Insurance Company Filter (See EN for details)
  1.  ; Output:  FILTER      - Update Insurance Company Filter (See EN for details)
  1.  N XX
  1.  S VALMBCK="R"
  1.  ;IB*713/CKB - reset VALMBG so the New Search (Insurance Company Lookup) will start on Page 1
  1.  S VALMBG=1
  1.  D FULL^VALM1
  1.  ;IB*713/CKB&TAZ - added clean up of TMP, removed it from below
  1.  K ^TMP("IBCNILK",$J),^TMP("IBCNILKIX",$J)
  1.  W !!
  1.  S XX=$$GETFILT()
  1.  ;IB*713/CKB - allow user to exit, preventing 'jumping'
  1.  I XX="^" D PAUSE^VALM1 Q
  1.  I XX=-1 D  Q
  1.  . W *7,"Invalid Filter - nothing done"
  1.  . D PAUSE^VALM1
  1.  S FILTER=XX
  1.  ;K ^TMP("IBCNILK",$J),^TMP("IBCNILKIX",$J)
  1.  D BLD,HDR
  1.  Q
  1.  ;
  1. GETFILT() ; Gets the Insurance company filter
  1.  ; Input:   None
  1.  ; Returns: A^B^C Where:
  1.  ;           A - 1 - Search for Insurance Companies that begin with
  1.  ;                   the specified text (case insensitive)
  1.  ;               2 - Search for Insurance Companies that contain
  1.  ;                   the specified text (case insensitive)
  1.  ;               3 - Search for Insurance Companies in a specified
  1.  ;                   range (inclusive, case insensitive)
  1.  ;           B - Begin with text if A=1, Contains Text if A=2 or
  1.  ;               the range start if A=3
  1.  ;           C - Range End text (only present when A=3)
  1.  ;         -1 if a valid filter was not selected
  1.  ;          ^ if user wants to exit
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,FILTER,X,XX,Y
  1.  ;
  1.  ; First ask what kind of filter to use
  1.  ;IB*763/CKB - 'Select' was modified to 'SELECT' in several places below
  1.  ;
  1.  W !
  1.  S DIR(0)="SA^1:Begins with;2:Contains;3:Range"
  1.  S DIR("A")="     SELECT 1, 2 or 3: "  ;IB*763/CKB
  1.  S DIR("A",1)=" 1 - Select Insurance Companies that Begin with: XXX"
  1.  S DIR("A",2)=" 2 - Select Insurance Companies that Contain: XXX"
  1.  S DIR("A",3)=" 3 - Select Insurance Companies in Range: XXX - YYY"
  1.  S DIR("B")=1
  1.  S DIR("?",1)="Select the type of filter to determine what Insurance Companies"
  1.  S DIR("?",2)="will be displayed as follows:"
  1.  S DIR("?",3)="   Begins with - Displays all insurance companies that begin with"
  1.  S DIR("?",4)="                 the specified text (inclusive, case insensitive)"
  1.  S DIR("?",5)="   Contains    - Displays all insurance companies that contain"
  1.  S DIR("?",6)="                 the specified text (inclusive, case insensitive)"
  1.  S DIR("?",7)="   Range       - Displays all insurance companies within the "
  1.  S DIR("?")="                 the specified range (inclusive, case insensitive)"
  1.  S XX="1:Begins with;2:Contains;3:Range"
  1.  D ^DIR
  1.  I Y="^" Q Y ;IB*713/CKB - allow user to exit
  1.  I $D(DTOUT)!$D(DUOUT) Q -1                 ; No valid search selected
  1.  S FILTER=Y
  1.  ;
  1.  ; Next ask for 'Begin with', 'Contains' or 'Range Start' text
  1.  W !
  1.  K DIR
  1.  S DIR(0)="F^1;30"
  1.  S XX=$S(FILTER=1:"that begin with",FILTER=2:"that contain",1:"Start of Range")
  1.  S DIR("A")="     SELECT Insurance Companies "_XX   ;IB*763/CKB
  1.  I FILTER=1 D
  1.  . S DIR("?")="Enter the text the each Insurance Company will begin with"
  1.  I FILTER=2 D
  1.  . S DIR("?")="Enter the text the each Insurance Company will contains"
  1.  I FILTER=3 D
  1.  . S DIR("?")="Enter the starting range text"
  1.  D ^DIR K DIR
  1.  I Y="^" Q Y ;IB*713/CKB - allow user to exit
  1.  I $D(DTOUT)!$D(DUOUT) Q -1                 ; No valid search selected
  1.  S $P(FILTER,"^",2)=Y
  1.  Q:$P(FILTER,"^",1)'=3 FILTER
  1.  ;
  1.  ; Finally, ask for 'Range End' text if using a range filter
  1.  W !
  1.  K DIR
  1.  S DIR(0)="F^1;30"
  1.  S DIR("A")="     SELECT Insurance Companies End of Range"   ;IB*763/CKB
  1.  S DIR("B")=$P(FILTER,"^",2)
  1.  S DIR("?")="Enter the ending Range text"
  1.  D ^DIR
  1.  I Y="^" Q Y ;IB*713/CKB - allow user to exit
  1.  I $D(DTOUT)!$D(DUOUT) Q -1                 ; No valid search selected
  1.  S $P(FILTER,"^",3)=Y
  1.  Q FILTER
  1.  ;
  1. HDR(SELECTED) ;EP
  1.  ; Header code for the Insurance Company Selection template
  1.  ; Input:   SELECTED        - 1 - Showing header for selected listman
  1.  ;                                Optional, defaults to 0
  1.  ;          NUMSEL          - Current # of Insurance Companies Selected
  1.  ;          FILTER          - Current Insurance Company Filter (See EN for details)
  1.  ;          WHICH           - Active/Inactive/Both filter option
  1.  ; Output:  VALMHDR         - Header information to display
  1.  N PNM,XX
  1.  S:'$D(SELECTED) SELECTED=0
  1.  I 'SELECTED D
  1.  . I $P(FILTER,"^",1)=4 S VALMHDR(1)="" Q
  1.  . I $P(FILTER,"^",1)=1 D  Q
  1.  . . S VALMHDR(1)="Insurance Companies that begin with: "_$P(FILTER,"^",2)
  1.  . I $P(FILTER,"^",1)=2 D  Q
  1.  . . S VALMHDR(1)="Insurance Companies that contain: "_$P(FILTER,"^",2)
  1.  . S XX=$P(FILTER,"^",2)_" - "_$P(FILTER,"^",3)
  1.  . S VALMHDR(1)="Insurance Companies in range: "_XX
  1.  S XX=$S(WHICH=1:"Active ",WHICH=0:"Inactive ",1:"All ")
  1.  S XX="Showing "_XX_"Insurance Companies"
  1.  ;
  1.  ; Add Payer filter, if present
  1.  I PIEN'="" D
  1.  . S PNM=$E($$GET1^DIQ(365.12,PIEN_",",.01),1,30)
  1.  . S PNM="Payer: "_PNM
  1.  . S XX=$$SETSTR^VALM1(PNM,XX,40,40)        ; Payer Name
  1.  S VALMHDR(2)=XX
  1.  S VALMHDR(3)=NUMSEL_" Insurance Companies selected"
  1.  Q
  1.  ;
  1. INIT ;EP
  1.  ; Initialize variables and list array
  1.  ; Input: None
  1.  ; Output:  ^TMP("IBCNILK",$J) - Body lines to display
  1.  K ^TMP("IBCNILK",$J),^TMP("IBCNILKIX",$J),^TMP("IBCNILKA",$J)
  1.  D BLD
  1.  Q
  1.  ;
  1. BLD ; Build listman body
  1.  ; Input:   FILTER    - Current Insurance Company Filter (See EN for details)
  1.  ;          WHICH     - 1 - Only Show Active Insurance Companies
  1.  ;                      0 - Only Show Inactive Insurance Companies
  1.  ;                      2 - Show Both Active and Inactive Insurance Companies
  1.  ; Output:  VALMCNT   - Total number of lines displayed in the body
  1.  ;          ^TMP("IBCNILK",$J)   - Body lines to display
  1.  ;          ^TMP("IBCNILKIX",$J) - Index of Entry IENs by display line
  1.  N FTEXT1,FTEXT2,FTYPE,ICTR,IIEN,INACT,INM,INMU,LINE,PLEN,SKIP,START,STOP,XX
  1.  N PLA ; IB*713/DTG
  1.  S FTYPE=$P(FILTER,"^",1)
  1.  S FTEXT1=$P(FILTER,"^",2),FTEXT1=$$UP^XLFSTR(FTEXT1)
  1.  S FTEXT2=$P(FILTER,"^",3),FTEXT2=$$UP^XLFSTR(FTEXT2)
  1.  ;IB*737/CKB - changed FTYPE from '4' to '5'. FTYPE=5 is only used by GETCOMPS^IBCNERPF.
  1.  S:FTYPE=5 FTEXT1="A"
  1.  S:FTYPE=1 PLEN=$L(FTEXT1)
  1.  S:FTYPE=3 PLEN=$L(FTEXT2)
  1.  S (ICTR,STOP,VALMCNT)=0,INM=""
  1.  ;IB*713/DTG start allow all searches to use full index
  1.  ;S:FTYPE'=2 INM=$O(^DIC(36,"B",FTEXT1),-1)
  1.  F  D  Q:(INM="")!STOP
  1.  . S INM=$O(^DIC(36,"B",INM))
  1.  . Q:INM=""
  1.  . S INMU=$$UP^XLFSTR(INM)
  1.  . ;IB*713/TAZ&CKB - use utility to check Begins, Contains, and Range
  1.  . I '$$FILTER^IBCNINSU(INM,FILTER) Q
  1.  . ;IB*713/DTG start allow search to cycle through lower case and upper case insurance company names
  1.  . S IIEN=""
  1.  . F  D  Q:IIEN=""
  1.  . . S IIEN=$O(^DIC(36,"B",INM,IIEN))
  1.  . . Q:IIEN=""
  1.  . . Q:'$D(^DIC(36,IIEN))                   ; Corrupt data index, skip
  1.  . . S SKIP=0
  1.  . . I PIEN'="" D  Q:SKIP                   ; Wrong payer
  1.  . . . S XX=$$GET1^DIQ(36,IIEN_",",3.1,"I")
  1.  . . . S:XX'=PIEN SKIP=1
  1.  . . S INACT=+$$GET1^DIQ(36,IIEN_",",.05,"I")
  1.  . . I WHICH=1,INACT=1 Q                    ; Not Active
  1.  . . I WHICH=0,INACT=0 Q                    ; Not Inactive
  1.  . . S ICTR=ICTR+1
  1.  . . S LINE=$$BLDLN(ICTR,IIEN)
  1.  . . S VALMCNT=VALMCNT+1
  1.  . . D SET^VALM10(VALMCNT,LINE,LINE)
  1.  . . S ^TMP("IBCNILKIX",$J,ICTR)=IIEN
  1.  ;
  1.  I VALMCNT=0 D
  1.  . S ^TMP("IBCNILK",$J,1,0)="No Insurance Companies matching filter criteria were found."
  1.  Q
  1.  ;
  1. BLDLN(ICTR,IIEN) ;EP
  1.  ; Builds a line to display one insurance company
  1.  ; Input:   ICTR                        - Selection Number
  1.  ;          IIEN                        - IEN of the insurance company to be
  1.  ;                                        displayed
  1.  ;          ^TMP("IBCNILKA",$J,IIEN)   - Array of currently selected
  1.  ;                                        Insurance Companies
  1.  ; Output:  LINE    - Formatted for setting into the list display
  1.  N LINE,LINEI,XX
  1.  S:$D(^TMP("IBCNILKA",$J,IIEN)) ICTR=ICTR_">"       ; Mark as selected
  1.  S LINE=$$SETSTR^VALM1(ICTR,"",1,4)                 ; Selection #
  1.  S XX=$$GET1^DIQ(36,IIEN_",",.01)
  1.  S LINE=$$SETSTR^VALM1(XX,LINE,7,30)                ; Ins Co Name
  1.  S XX=+$$GET1^DIQ(36,IIEN_",",.05,"I")
  1.  S XX=$S(XX:"I",1:"A")
  1.  S LINE=$$SETSTR^VALM1(XX,LINE,41,1)                ; Active/Inactive
  1.  S XX=$$GET1^DIQ(36,IIEN_",",.111)
  1.  S LINE=$$SETSTR^VALM1(XX,LINE,46,35)               ; Street Address
  1.  S XX=$$GET1^DIQ(36,IIEN_",",.114)
  1.  S LINE=$$SETSTR^VALM1(XX,LINE,84,25)               ; City
  1.  S XX=$$GET1^DIQ(36,IIEN_",",.115,"I")
  1.  S XX=$$GET1^DIQ(5,XX_",",1)
  1.  S LINE=$$SETSTR^VALM1(XX,LINE,111,2)               ; State
  1.  S XX=$$GET1^DIQ(36,IIEN_",",.116)
  1.  S LINE=$$SETSTR^VALM1(XX,LINE,116,20)              ; Zip Code
  1.  Q LINE
  1.  ;
  1. HELP ;EP
  1.  ; Help code
  1.  ; Input: None
  1.  D FULL^VALM1
  1.  S VALMBCK="R"
  1.  W @IOF,"A '>' after the Insurance Company Selection number indicates that this Insurance"
  1.  W !,"Company has already been selected."
  1.  Q
  1.  ;
  1. EXIT ;EP
  1.  ; Exit code
  1.  ; Input: None
  1.  K ^TMP("IBCNILK",$J),^TMP("IBCNILKIX",$J)
  1.  D CLEAR^VALM1
  1.  Q
  1.  ;
  1. SEL ;EP
  1.  ; Protocol Action to de-select an already selected insurance company
  1.  ; Input:   NUMSEL                  - Current number of selected insurance
  1.  ;                                    companies
  1.  ;          ^TMP("IBCNILK",$J)     - Current Array of displayed Ins Cos
  1.  ;          ^TMP("IBCNILKIX",$J)   - Current Index of displayed Ins Cos
  1.  ;          ^TMP("IBCNILKA,$J,IIEN)- Current Array of selected Ins Cos
  1.  ; Output:  NUMSEL                  - Updated number of selected insurance
  1.  ;                                    companies
  1.  ;          ^TMP("IBCNILKA,$J,IIEN)- Updated Array of selected Ins Cos
  1.  ;          Selected Insurance Company is removed from the worklist 
  1.  ;          Error message displayed (potentially)
  1.  N DIR,DIROUT,DIRUT,DLINE,DTOUT,DUOUT,ERROR,IEN,IIENS,IX,LINE,PROMPT
  1.  S VALMBCK="R",ERROR=0
  1.  ; 
  1.  ; First select the Insurance Company(s) to be selected
  1.  S PROMPT="SELECT Insurance Company(s)"     ;IB*763/CKB
  1.  S IIENS=$$SELINS(1,PROMPT,.DLINE,1,"IBCNILKIX")
  1.  I IIENS="" S VALMBCK="R" Q                 ; None Selected
  1.  F IX=1:1:$L(IIENS,",") D
  1.  . S IIEN=$P(IIENS,",",IX)
  1.  . S LINE=$P(DLINE,",",IX)
  1.  . ;
  1.  . ; If currently selected, display an error message
  1.  . I $D(^TMP("IBCNILKA",$J,IIEN)) D  Q
  1.  . . W !,*7,">>>> # ",LINE," is currently selected."
  1.  . . S ERROR=1
  1.  . D MARK(1,IIEN,LINE,.NUMSEL)              ; Show the selection mark
  1.  D HDR                                      ; Update the header
  1.  D:ERROR PAUSE^VALM1
  1.  Q
  1.  ;
  1. UNSEL(SELECTED) ;EP
  1.  ; Protocol Action to deselect an already selected insurance company
  1.  ; Input:   SELECTED                - 1 - Called from IBCN INS CO ACTIVE UNSELECT
  1.  ;                                    0 - Called from IBCN INS CO UNSELECT
  1.  ;                                    Optional, defaults to 0
  1.  ;          NUMSEL                  - Current number of selected insurance
  1.  ;                                    companies
  1.  ;          ^TMP("IBCNILK",$J)     - Current Array of displayed Ins Cos
  1.  ;          ^TMP("IBCNILKS",$J)    - Current Array of selecte Ins Cos
  1.  ;          ^TMP("IBCNILKIX",$J)   - Current Index of displayed Ins Cos
  1.  ;          ^TMP("IBCNILKA,$J,IIEN)- Current Array of selected Ins Cos
  1.  ; Output:  NUMSEL                  - Current number of selected insurance
  1.  ;                                    companies
  1.  ;          ^TMP("IBCNILKA,$J,IIEN)- Updated Array of selected Ins Cos
  1.  ;          Selected Insurance Company is removed from the worklist 
  1.  ;          Error message displayed (potentially)
  1.  N DIR,DIROUT,DIRUT,DLINE,DTOUT,DUOUT,ERROR,IEN,IIENS,IX,LINE,PROMPT,WARRAY
  1.  I '$D(SELECTED) D
  1.  . S SELECTED=0,WARRAY="IBCNILKIX"
  1.  E  S WARRAY="IBCNILKSIX"
  1.  S VALMBCK="R",ERROR=0
  1.  ; 
  1.  ; First select the Insurance Company(s) to be deselected
  1.  S PROMPT="DESELECT Insurance Company(s)"   ;IB*763/CKB
  1.  S IIENS=$$SELINS(1,PROMPT,.DLINE,1,WARRAY)
  1.  I IIENS="" S VALMBCK="R" Q                 ; None Selected
  1.  F IX=1:1:$L(IIENS,",") D
  1.  . S IIEN=$P(IIENS,",",IX)
  1.  . S LINE=$P(DLINE,",",IX)
  1.  . ;
  1.  . ; If not currently selected, display an error message
  1.  . I '$D(^TMP("IBCNILKA",$J,IIEN)) D  Q
  1.  . . W !,*7,">>>> # ",LINE," is not currently selected. It cannot be deselected."
  1.  . . S ERROR=1
  1.  . D MARK(0,IIEN,LINE,.NUMSEL)              ; Deselect the entry
  1.  D HDR(SELECTED)                            ; Update the header
  1.  D:ERROR PAUSE^VALM1
  1.  Q
  1.  ;
  1. MARK(WHICH,IIEN,LINE,NUMSEL)   ;EP
  1.  ; Mark/Remove 'Selection' from a selected
  1.  ; Insurance Company line
  1.  ; Input:   WHICH   - 0 - Remove 'Selection' mark
  1.  ;                    1 - Set 'Selection' mark
  1.  ;          IENIN   - IEN of the entry to Mark/Remove 'In-Progress'
  1.  ;          LINE    - Line number being marked/unmarked
  1.  ;          WLIST   - Worklist, the user is selecting from.
  1.  ;          NUMSEL  - Current # of selected Insurance Companies
  1.  ;          ^TMP("IBCNILKA",$J)- Current array of selected Insurance Companies 
  1.  ; Output:  Insurance  Company is marked or unmarked as selected
  1.  ;          NUMSEL  - Current # of selected Insurance Companies
  1.  ;          ^TMP("IBCNILKA",$J)- Updated array of selected Insurance Companies 
  1.  ;      
  1.  N TEXT
  1.  I WHICH D                                  ; Mark as selected
  1.  . S ^TMP("IBCNILKA",$J,IIEN)=""
  1.  . S TEXT=LINE_">",NUMSEL=NUMSEL+1
  1.  E  D                                       ; Mark as selected
  1.  . K ^TMP("IBCNILKA",$J,IIEN)
  1.  . S TEXT=LINE,NUMSEL=NUMSEL-1
  1.  D FLDTEXT^VALM10(LINE,"CTR",TEXT)          ; Update display
  1.  D WRITE^VALM10(LINE)                       ; Redisplay line
  1.  Q
  1.  ;
  1. SHOWSEL ;EP
  1.  ; Protocol action used to display a listman template of the currently
  1.  ; selected Insurance companies
  1.  ; Input:   NUMSEL                      - Current number of selected insurance
  1.  ;                                        companies
  1.  ;          ^TMP("IBCNILKA",$J,IEN)    - Current Array of selected insurance
  1.  ;                                        companies
  1.  ; Output:  NUMSEL                      - Updated number of selected insurance companies
  1.  ;          ^TMP("IBCNILKA",$J,IEN)    - Updated Array of selected insurance
  1.  ;                                        companies
  1.  S VALMBCK="R"
  1.  D EN^VALM("IBCN INS CO SELECTED")
  1.  D HDR,BLD
  1.  Q
  1.  ;
  1. SELINS(FULL,PROMPT,DLINE,MULT,WLIST)    ;EP
  1.  ; Select Insurance Company(s) to perform an action upon
  1.  ; Also called from IBCNILK@UNSEL
  1.  ; Input:   FULL                    - 1 - full screen mode, 0 otherwise
  1.  ;          PROMPT                  - Prompt to be displayed to the user
  1.  ;          MULT                    - 1 to allow multiple entry selection
  1.  ;                                    0 to only allow single entry selection
  1.  ;                                    Optional, defaults to 0
  1.  ;          WLIST                   - Worklist, the user is selecting from
  1.  ;          ^TMP("IBCNILKIX",$J)   - Index of displayed lines of the Ins Co
  1.  ;                                    Selector Template. 
  1.  ;                                    Only used when WLIST="IBCNILKIX"
  1.  ;          ^TMP("IBCNILKSIX",$J)  - Index of displayed lines of the Ins Cos
  1.  ;                                    Selected Template
  1.  ;                                    Only used if WLIST is "IBCNILKSIX"
  1.  ; Output:  DLINE                   - Comma delimited list of Line #(s) of the 
  1.  ;                                    selected Ins Cos
  1.  ; Returns: IIEN(s) - Comma delimited string or IENS for the selected Ins Co(s)
  1.  ;          Error message and "" IENS if multi-selection and not allowed
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,IIEN,IIENS,IX,VALMY,X,Y
  1.  S:'$D(MULT) MULT=0
  1.  S:'$D(WLIST) WLIST="IBCNILK"
  1.  D:FULL FULL^VALM1
  1.  S DLINE=$P($P($G(XQORNOD(0)),"^",4),"=",2)     ; User selection with action
  1.  S DLINE=$TR(DLINE,"/\; .",",,,,,")             ; Check for multi-selection
  1.  S IIENS=""
  1.  I 'MULT,DLINE["," D  Q ""                      ; Invalid multi-selection
  1.  . W !,*7,">>>> Only single entry selection is allowed"
  1.  . S DLINE=""
  1.  . K DIR
  1.  . D PAUSE^VALM1
  1.  ;
  1.  ; Let the user enter their selection(s)
  1.  D EN^VALM2($G(XQORNOD(0)),"O")                 ; ListMan generic selector
  1.  I '$D(VALMY) Q ""
  1.  S IX="",DLINE=""
  1.  F  D  Q:IX=""
  1.  . S IX=$O(VALMY(IX))
  1.  . Q:IX=""
  1.  . S DLINE=$S(DLINE="":IX,1:DLINE_","_IX)
  1.  . S IIEN=$G(^TMP(WLIST,$J,IX))
  1.  . S IIENS=$S(IIENS="":IIEN,1:IIENS_","_IIEN)
  1.  Q IIENS
  1.  ;
  1. INIT2 ;EP for Show Selections
  1.  ; Initialize variables and list array
  1.  ; Input: None
  1.  ; Output:  ^TMP("IBCNILK",$J) - Body lines to display
  1.  K ^TMP("IBCNILKS",$J),^TMP("IBCNILKSIX",$J)
  1.  D BLD2
  1.  Q
  1.  ;
  1. BLD2 ; Build listman body for Show Selections
  1.  ; Input:   None
  1.  ; Output:  VALMCNT   - Total number of lines displayed in the body
  1.  ;          ^TMP("IBCNILKS",$J)   - Body lines to display
  1.  ;          ^TMP("IBCNILKSIX",$J) - Index of Entry IENs by display line
  1.  N IIEN,LINE,NM,SORTED
  1.  ;
  1.  ; First sort the currently selected insurance companies into name order
  1.  S IIEN=""
  1.  F  D  Q:IIEN=""
  1.  . S IIEN=$O(^TMP("IBCNILKA",$J,IIEN))
  1.  . Q:IIEN=""
  1.  . S NM=$$GET1^DIQ(36,IIEN_",",.01)
  1.  . S SORTED(NM,IIEN)=""
  1.  ;
  1.  ; Now build the lines to be displayed
  1.  S (ICTR,VALMCNT)=0,NM=""
  1.  F  D  Q:NM=""
  1.  . S NM=$O(SORTED(NM))
  1.  . Q:NM=""
  1.  . S IIEN=""
  1.  . F  D  Q:IIEN=""
  1.  . . S IIEN=$O(SORTED(NM,IIEN))
  1.  . . Q:IIEN=""
  1.  . . S ICTR=ICTR+1
  1.  . . S LINE=$$BLDLN(ICTR,IIEN)
  1.  . . S VALMCNT=VALMCNT+1
  1.  . . D SET^VALM10(VALMCNT,LINE,LINE)
  1.  . . S ^TMP("IBCNILKSIX",$J,ICTR)=IIEN
  1.  ;
  1.  I VALMCNT=0 D
  1.  . S ^TMP("IBCNILK",$J,1,0)="No Selected Insurance Companies were found."
  1.  Q
  1.  ;
  1. EXIT2 ;EP for Show Selections
  1.  ; Exit code
  1.  ; Input: None
  1.  K ^TMP("IBCNILKS",$J),^TMP("IBCNILKSIX",$J)
  1.  D CLEAR^VALM1
  1.  Q
  1.  ;