IBCNILK ;ALB/FA - Insurance Company Selection ; 02-OCT-2015
;;2.0;INTEGRATED BILLING;**549,713,737,763,827**;21-MAR-94;Build 24
;;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 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 FILTER
;
; First ask what kind of filter to use
;IB*763/CKB - 'Select' was modified to 'SELECT' in several within
; what is now GETFILT^IBCNILK1
;IB*827/DW - Due to routine size, moved the code of GETFILT to IBCNILK1
;
S FILTER=$$GETFILT^IBCNILK1()
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,6) ; Selection # ;IB*827 was (...1,4)
S XX=$$GET1^DIQ(36,IIEN_",",.01)
S LINE=$$SETSTR^VALM1(XX,LINE,8,30) ; Ins Co Name ;IB*827 was (...7,30)
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
; IB*827/DW Reworded text
W !!,"After the Insurance Company selection number, an '>' indicates that this"
W !," Insurance Company has already been selected.",!
;W @IOF,"A '>' after the Insurance Company selection number indicates that this Insurance"
;W !,"Company has already been selected.",!
I $G(VALMANS)="?" D ;IB*827/DW Added
. N DIR,X,Y
. S DIR(0)="E",DIR("A")="Press <Enter> to return back to the list of Insurance Companies"
. D ^DIR
. K DIR,X,Y
S VALMBCK="R"
Q
;
EXIT ;EP
; Exit code
; Input: None
K ^TMP("IBCNILK",$J),^TMP("IBCNILKIX",$J)
D CLEAR^VALM1
Q
;
SEL ;EP
; Protocol Action to select insurance companies
; 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 added to 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
;
SELALL ; EP
;IB*827/DW new action added "Choose All"
;
; Protocol Action to select all insurance companies in this ListMan regardless
; of the page it is on
;
; 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 added to the worklist
; Error message displayed (potentially)
N DIR,DIROUT,DIRUT,DLINE,DTOUT,DUOUT,ERROR,IEN,IIENS,IX,LINE,PROMPT
S VALMBCK="R",ERROR=0
;
S NUMSEL=0 ; reset # of selected, tag MARK counts the # selected as it loops thru all
;
S LINE=0 F S LINE=$O(^TMP("IBCNILKIX",$J,LINE)) Q:'LINE D ;loop thru all possible companies
. S IIEN=^TMP("IBCNILKIX",$J,LINE)
. 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 selected 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 19465 printed Jul 22, 2026@15:24:47 Page 2
IBCNILK ;ALB/FA - Insurance Company Selection ; 02-OCT-2015
+1 ;;2.0;INTEGRATED BILLING;**549,713,737,763,827**;21-MAR-94;Build 24
+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 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 FILTER
+15 ;
+16 ; First ask what kind of filter to use
+17 ;IB*763/CKB - 'Select' was modified to 'SELECT' in several within
+18 ; what is now GETFILT^IBCNILK1
+19 ;IB*827/DW - Due to routine size, moved the code of GETFILT to IBCNILK1
+20 ;
+21 SET FILTER=$$GETFILT^IBCNILK1()
+22 QUIT FILTER
+23 ;
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 # ;IB*827 was (...1,4)
SET LINE=$$SETSTR^VALM1(ICTR,"",1,6)
+11 SET XX=$$GET1^DIQ(36,IIEN_",",.01)
+12 ; Ins Co Name ;IB*827 was (...7,30)
SET LINE=$$SETSTR^VALM1(XX,LINE,8,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 ; IB*827/DW Reworded text
+5 WRITE !!,"After the Insurance Company selection number, an '>' indicates that this"
+6 WRITE !," Insurance Company has already been selected.",!
+7 ;W @IOF,"A '>' after the Insurance Company selection number indicates that this Insurance"
+8 ;W !,"Company has already been selected.",!
+9 ;IB*827/DW Added
IF $GET(VALMANS)="?"
Begin DoDot:1
+10 NEW DIR,X,Y
+11 SET DIR(0)="E"
SET DIR("A")="Press <Enter> to return back to the list of Insurance Companies"
+12 DO ^DIR
+13 KILL DIR,X,Y
End DoDot:1
+14 SET VALMBCK="R"
+15 QUIT
+16 ;
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 select insurance companies
+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 added to 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 ;
SELALL ; EP
+1 ;IB*827/DW new action added "Choose All"
+2 ;
+3 ; Protocol Action to select all insurance companies in this ListMan regardless
+4 ; of the page it is on
+5 ;
+6 ; Input: NUMSEL - Current number of selected insurance
+7 ; companies
+8 ; ^TMP("IBCNILK",$J) - Current Array of displayed 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 - Updated number of selected insurance
+12 ; companies
+13 ; ^TMP("IBCNILKA,$J,IIEN)- Updated Array of selected Ins Cos
+14 ; Selected Insurance Company is added to the worklist
+15 ; Error message displayed (potentially)
+16 NEW DIR,DIROUT,DIRUT,DLINE,DTOUT,DUOUT,ERROR,IEN,IIENS,IX,LINE,PROMPT
+17 SET VALMBCK="R"
SET ERROR=0
+18 ;
+19 ; reset # of selected, tag MARK counts the # selected as it loops thru all
SET NUMSEL=0
+20 ;
+21 ;loop thru all possible companies
SET LINE=0
FOR
SET LINE=$ORDER(^TMP("IBCNILKIX",$JOB,LINE))
if 'LINE
QUIT
Begin DoDot:1
+22 SET IIEN=^TMP("IBCNILKIX",$JOB,LINE)
+23 ; Show the selection mark
DO MARK(1,IIEN,LINE,.NUMSEL)
End DoDot:1
+24 ; Update the header
DO HDR
+25 if ERROR
DO PAUSE^VALM1
+26 QUIT
+27 ;
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 selected 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 ;
