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