IBCNRDV1 ;AITC/TAZ - INSURANCE INFORMATION EXCHANGE VIA RDV ;11-MAR-2020
;;2.0;INTEGRATED BILLING;**664**;21-MAR-94;Build 29
;;Per VA Directive 6402, this routine should not be modified.
;
; This routine is used to exchange insurance information between
; facilities.
;
Q ;Only called from labels
;
EN ; -- main entry point for IBCN RDV SELECTION
N NUMSEL
S NUMSEL=0
D EN^VALM("IBCN RDV SELECTOR")
Q
;
HDR ; -- header code
N PATNAM,VA
S PATNAM=$$GET1^DIQ(2,DFN_",",.01)
D PID^VADPT
S VALMHDR(1)="Patient Name: "_PATNAM_" "_$E(PATNAM,1)_$G(VA("BID"))_" "_$$FMTE^XLFDT($$GET1^DIQ(2,DFN_",",.03))
S VALMHDR(2)=NUMSEL_" Polic"_$S(NUMSEL=1:"y",1:"ies")_" selected."
S VALM("TITLE")="Insurance Import Selection"
Q
;
INIT ; -- init variables and list array
N DATA,LINE,LINEVAR
K @VALMAR
D BLD
Q
;
BLD ;
;Source Data from ^TMP($J,"IBCNRDV")
N IIEN,LINE
S (IIEN,VALMCNT)=0
F S IIEN=$O(^TMP($J,"IBCNRDV",IIEN)) Q:'IIEN D
. S VALMCNT=VALMCNT+1
. S LINE=$$BLDLN(VALMCNT,IIEN)
. D SET^VALM10(VALMCNT,LINE,LINE)
. S ^TMP("IBCNRDVIX",$J,VALMCNT)=IIEN
Q
;
BLDLN(ICTR,IIEN,DATA) ;EP
; Builds a line to display one insurance company
; Input: ICTR - Selection Number
; IIEN - IEN of the Policy to be displayed
; ^TMP("IBCNRDVA",$J,IIEN) - Array of currently selected policies
;
; Output: LINE - Formatted for setting into the list display
N DATA,LINEVAR
M DATA=^TMP($J,"IBCNRDV",IIEN)
S LINEVAR=""
I $D(^TMP("IBCNRDVA",$J,IIEN)) S ICTR=ICTR_">"
S LINEVAR=$$SETFLD^VALM1(ICTR,LINEVAR,"CTR")
S LINEVAR=$$SETFLD^VALM1($G(DATA(20.01)),LINEVAR,"INSCO")
S LINEVAR=$$SETFLD^VALM1($G(DATA(40.02)),LINEVAR,"GRPNM")
S LINEVAR=$$SETFLD^VALM1($$GET1^DIQ(4,$G(DATA(.14)),.01),LINEVAR,"SITE")
Q LINEVAR
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
;File selected plans
I $D(IBFASTXT)!'$D(^TMP("IBCNRDVA",$J)) G EXITQ
N X,Y
S DIR(0)="YA",DIR("A")="Are you sure you want to file the selected plans? (Y/N): ",DIR("B")="Y"
D ^DIR K DIR
I Y D
. N IBB,IIEN
. S IIEN=0
. F S IIEN=$O(^TMP("IBCNRDVA",$J,IIEN)) Q:'IIEN D
.. M IBB=^TMP($J,"IBCNRDV",IIEN)
.. S IBB=$$ADDSTF^IBCNBES($G(IBB(.03),1),DFN,.IBB)
. W !!,NUMSEL," entr",$S(NUMSEL=1:"y has",1:"ies have")," been added to the Insurance Buffer File."
. D WAIT^VALM1
;
EXITQ ;
K @VALMAR,^TMP("IBCNRDVIX",$J),^TMP("IBCNRDVA",$J)
Q
;
EXPND ; -- expand code
Q
;
SEL ;EP
; Protocol Action to select an unselected policy
; Input: NUMSEL - Current number of selected policies
; ^TMP("IBCNRDV1",$J) - Current Array of displayed policies
; ^TMP("IBCNRDVIX",$J) - Current Index of displayed policies
; ^TMP("IBCNRDVA,$J,IIEN) - Current Array of selected policies
; Output: NUMSEL - Updated number of selected policies
; ^TMP("IBCNRDVA,$J,IIEN)- Updated Array of selected policies
; 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 Policy(s) to be selected
S PROMPT="Select Policy(s)"
S IIENS=$$SELINS(1,PROMPT,.DLINE,1,"IBCNRDVIX")
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("IBCNRDVA",$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 policy
; Input: SELECTED - 1 - Called from IBCN RDV POL DESELECT
; 0 - Called from IBCN RDV DESELECT
; Optional, defaults to 0
; NUMSEL - Current number of selected policies
; ^TMP("IBCNRDV",$J) - Current Array of displayed policies
; ^TMP("IBCNRDVS",$J) - Current Array of selected policies
; ^TMP("IBCNRDVIX",$J) - Current Index of displayed policies
; ^TMP("IBCNRDVA,$J,IIEN)- Current Array of selected policies
; Output: NUMSEL - Current number of selected policies
; ^TMP("IBCNRDVA,$J,IIEN)- Updated Array of selected policies
; Selected policy 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="IBCNRDVIX"
E S WARRAY="IBCNRDVSIX"
S VALMBCK="R",ERROR=0
;
; First select the Policy(s) to be deselected
S PROMPT="Deselect Policy(s)"
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("IBCNRDVA",$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 ; 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 policies
; ^TMP("IBCNRDVA",$J)- Current array of selected policies
; Output: Policy is marked or unmarked as selected
; NUMSEL - Current # of selected policies
; ^TMP("IBCNRDVA",$J)- Updated array of selected policies
;
N TEXT
I WHICH D ; Mark as selected
. S ^TMP("IBCNRDVA",$J,IIEN)=""
. S TEXT=LINE_">",NUMSEL=NUMSEL+1
E D ; Mark as selected
. K ^TMP("IBCNRDVA",$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 policies
; Input: NUMSEL - Current number of selected policies
; ^TMP("IBCNRDVA",$J,IEN) - Current Array of selected policies
; Output: NUMSEL - Updated number of selected policies
; ^TMP("IBCNRDVA",$J,IEN) - Updated Array of selected policies
S VALMBCK="R"
D EN^VALM("IBCN RDV POL SELECTED")
I '$D(IBFASTXT) D HDR,BLD
Q
;
SELINS(FULL,PROMPT,DLINE,MULT,WLIST) ;EP
; Select Insurance Company(s) to perform an action upon
; Also called from IBCNRDV1@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("IBCNRDVIX",$J) - Index of displayed lines of the policy
; Selector Template.
; Only used when WLIST="IBCNRDVIX"
; ^TMP("IBCNRDVSIX",$J) - Index of displayed lines of the policy
; Selected Template
; Only used if WLIST is "IBCNRDVSIX"
; Output: DLINE - Comma delimited list of Line #(s) of the
; selected Ins Cos
; Returns: IIEN(s) - Comma delimited string or IENS for the selected policy(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="IBCNRDV1"
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("IBCNRDV",$J) - Body lines to display
S VALMBCK="R"
K ^TMP("IBCNRDVS",$J),^TMP("IBCNRDVSIX",$J)
D BLD2
Q
;
BLD2 ; Build listman body for Show Selections
; Input: None
; Output: VALMCNT - Total number of lines displayed in the body
; ^TMP("IBCNRDVS",$J) - Body lines to display
; ^TMP("IBCNRDVSIX",$J) - Index of Entry IENs by display line
N IIEN,LINE
;
; Build the lines to be displayed
S (IIEN,VALMCNT)=0
F S IIEN=$O(^TMP("IBCNRDVA",$J,IIEN)) Q:'IIEN D
. S VALMCNT=VALMCNT+1
. S LINE=$$BLDLN(VALMCNT,IIEN)
. D SET^VALM10(VALMCNT,LINE,LINE)
. S ^TMP("IBCNRDVSIX",$J,VALMCNT)=IIEN
;
I VALMCNT=0 D
. S ^TMP("IBCNRDVS",$J,1,0)="No Selected Policies were found."
Q
;
EXIT2 ;EP for Show Selections
; Exit code
; Input: None
K ^TMP("IBCNRDVS",$J),^TMP("IBCNRDVSIX",$J)
D CLEAR^VALM1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNRDV1 10298 printed Dec 13, 2024@02:16:11 Page 2
IBCNRDV1 ;AITC/TAZ - INSURANCE INFORMATION EXCHANGE VIA RDV ;11-MAR-2020
+1 ;;2.0;INTEGRATED BILLING;**664**;21-MAR-94;Build 29
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; This routine is used to exchange insurance information between
+5 ; facilities.
+6 ;
+7 ;Only called from labels
QUIT
+8 ;
EN ; -- main entry point for IBCN RDV SELECTION
+1 NEW NUMSEL
+2 SET NUMSEL=0
+3 DO EN^VALM("IBCN RDV SELECTOR")
+4 QUIT
+5 ;
HDR ; -- header code
+1 NEW PATNAM,VA
+2 SET PATNAM=$$GET1^DIQ(2,DFN_",",.01)
+3 DO PID^VADPT
+4 SET VALMHDR(1)="Patient Name: "_PATNAM_" "_$EXTRACT(PATNAM,1)_$GET(VA("BID"))_" "_$$FMTE^XLFDT($$GET1^DIQ(2,DFN_",",.03))
+5 SET VALMHDR(2)=NUMSEL_" Polic"_$SELECT(NUMSEL=1:"y",1:"ies")_" selected."
+6 SET VALM("TITLE")="Insurance Import Selection"
+7 QUIT
+8 ;
INIT ; -- init variables and list array
+1 NEW DATA,LINE,LINEVAR
+2 KILL @VALMAR
+3 DO BLD
+4 QUIT
+5 ;
BLD ;
+1 ;Source Data from ^TMP($J,"IBCNRDV")
+2 NEW IIEN,LINE
+3 SET (IIEN,VALMCNT)=0
+4 FOR
SET IIEN=$ORDER(^TMP($JOB,"IBCNRDV",IIEN))
if 'IIEN
QUIT
Begin DoDot:1
+5 SET VALMCNT=VALMCNT+1
+6 SET LINE=$$BLDLN(VALMCNT,IIEN)
+7 DO SET^VALM10(VALMCNT,LINE,LINE)
+8 SET ^TMP("IBCNRDVIX",$JOB,VALMCNT)=IIEN
End DoDot:1
+9 QUIT
+10 ;
BLDLN(ICTR,IIEN,DATA) ;EP
+1 ; Builds a line to display one insurance company
+2 ; Input: ICTR - Selection Number
+3 ; IIEN - IEN of the Policy to be displayed
+4 ; ^TMP("IBCNRDVA",$J,IIEN) - Array of currently selected policies
+5 ;
+6 ; Output: LINE - Formatted for setting into the list display
+7 NEW DATA,LINEVAR
+8 MERGE DATA=^TMP($JOB,"IBCNRDV",IIEN)
+9 SET LINEVAR=""
+10 IF $DATA(^TMP("IBCNRDVA",$JOB,IIEN))
SET ICTR=ICTR_">"
+11 SET LINEVAR=$$SETFLD^VALM1(ICTR,LINEVAR,"CTR")
+12 SET LINEVAR=$$SETFLD^VALM1($GET(DATA(20.01)),LINEVAR,"INSCO")
+13 SET LINEVAR=$$SETFLD^VALM1($GET(DATA(40.02)),LINEVAR,"GRPNM")
+14 SET LINEVAR=$$SETFLD^VALM1($$GET1^DIQ(4,$GET(DATA(.14)),.01),LINEVAR,"SITE")
+15 QUIT LINEVAR
+16 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 ;File selected plans
+2 IF $DATA(IBFASTXT)!'$DATA(^TMP("IBCNRDVA",$JOB))
GOTO EXITQ
+3 NEW X,Y
+4 SET DIR(0)="YA"
SET DIR("A")="Are you sure you want to file the selected plans? (Y/N): "
SET DIR("B")="Y"
+5 DO ^DIR
KILL DIR
+6 IF Y
Begin DoDot:1
+7 NEW IBB,IIEN
+8 SET IIEN=0
+9 FOR
SET IIEN=$ORDER(^TMP("IBCNRDVA",$JOB,IIEN))
if 'IIEN
QUIT
Begin DoDot:2
+10 MERGE IBB=^TMP($JOB,"IBCNRDV",IIEN)
+11 SET IBB=$$ADDSTF^IBCNBES($GET(IBB(.03),1),DFN,.IBB)
End DoDot:2
+12 WRITE !!,NUMSEL," entr",$SELECT(NUMSEL=1:"y has",1:"ies have")," been added to the Insurance Buffer File."
+13 DO WAIT^VALM1
End DoDot:1
+14 ;
EXITQ ;
+1 KILL @VALMAR,^TMP("IBCNRDVIX",$JOB),^TMP("IBCNRDVA",$JOB)
+2 QUIT
+3 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
SEL ;EP
+1 ; Protocol Action to select an unselected policy
+2 ; Input: NUMSEL - Current number of selected policies
+3 ; ^TMP("IBCNRDV1",$J) - Current Array of displayed policies
+4 ; ^TMP("IBCNRDVIX",$J) - Current Index of displayed policies
+5 ; ^TMP("IBCNRDVA,$J,IIEN) - Current Array of selected policies
+6 ; Output: NUMSEL - Updated number of selected policies
+7 ; ^TMP("IBCNRDVA,$J,IIEN)- Updated Array of selected policies
+8 ; Selected Insurance Company is added to the worklist
+9 ; Error message displayed (potentially)
+10 NEW DIR,DIROUT,DIRUT,DLINE,DTOUT,DUOUT,ERROR,IEN,IIENS,IX,LINE,PROMPT
+11 SET VALMBCK="R"
SET ERROR=0
+12 ;
+13 ; First select the Policy(s) to be selected
+14 SET PROMPT="Select Policy(s)"
+15 SET IIENS=$$SELINS(1,PROMPT,.DLINE,1,"IBCNRDVIX")
+16 ; None Selected
IF IIENS=""
SET VALMBCK="R"
QUIT
+17 FOR IX=1:1:$LENGTH(IIENS,",")
Begin DoDot:1
+18 SET IIEN=$PIECE(IIENS,",",IX)
+19 SET LINE=$PIECE(DLINE,",",IX)
+20 ;
+21 ; If currently selected, display an error message
+22 IF $DATA(^TMP("IBCNRDVA",$JOB,IIEN))
Begin DoDot:2
+23 WRITE !,*7,">>>> # ",LINE," is currently selected."
+24 SET ERROR=1
End DoDot:2
QUIT
+25 ; Show the selection mark
DO MARK(1,IIEN,LINE,.NUMSEL)
End DoDot:1
+26 ; Update the header
DO HDR
+27 if ERROR
DO PAUSE^VALM1
+28 QUIT
+29 ;
UNSEL(SELECTED) ;EP
+1 ; Protocol Action to deselect an already selected policy
+2 ; Input: SELECTED - 1 - Called from IBCN RDV POL DESELECT
+3 ; 0 - Called from IBCN RDV DESELECT
+4 ; Optional, defaults to 0
+5 ; NUMSEL - Current number of selected policies
+6 ; ^TMP("IBCNRDV",$J) - Current Array of displayed policies
+7 ; ^TMP("IBCNRDVS",$J) - Current Array of selected policies
+8 ; ^TMP("IBCNRDVIX",$J) - Current Index of displayed policies
+9 ; ^TMP("IBCNRDVA,$J,IIEN)- Current Array of selected policies
+10 ; Output: NUMSEL - Current number of selected policies
+11 ; ^TMP("IBCNRDVA,$J,IIEN)- Updated Array of selected policies
+12 ; Selected policy is removed from the worklist
+13 ; Error message displayed (potentially)
+14 NEW DIR,DIROUT,DIRUT,DLINE,DTOUT,DUOUT,ERROR,IEN,IIENS,IX,LINE,PROMPT,WARRAY
+15 IF '$DATA(SELECTED)
Begin DoDot:1
+16 SET SELECTED=0
SET WARRAY="IBCNRDVIX"
End DoDot:1
+17 IF '$TEST
SET WARRAY="IBCNRDVSIX"
+18 SET VALMBCK="R"
SET ERROR=0
+19 ;
+20 ; First select the Policy(s) to be deselected
+21 SET PROMPT="Deselect Policy(s)"
+22 SET IIENS=$$SELINS(1,PROMPT,.DLINE,1,WARRAY)
+23 ; None Selected
IF IIENS=""
SET VALMBCK="R"
QUIT
+24 FOR IX=1:1:$LENGTH(IIENS,",")
Begin DoDot:1
+25 SET IIEN=$PIECE(IIENS,",",IX)
+26 SET LINE=$PIECE(DLINE,",",IX)
+27 ;
+28 ; If not currently selected, display an error message
+29 IF '$DATA(^TMP("IBCNRDVA",$JOB,IIEN))
Begin DoDot:2
+30 WRITE !,*7,">>>> # ",LINE," is not currently selected. It cannot be deselected."
+31 SET ERROR=1
End DoDot:2
QUIT
+32 ; Deselect the entry
DO MARK(0,IIEN,LINE,.NUMSEL)
End DoDot:1
+33 ; Update the header
DO HDR
+34 if ERROR
DO PAUSE^VALM1
+35 QUIT
+36 ;
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 policies
+9 ; ^TMP("IBCNRDVA",$J)- Current array of selected policies
+10 ; Output: Policy is marked or unmarked as selected
+11 ; NUMSEL - Current # of selected policies
+12 ; ^TMP("IBCNRDVA",$J)- Updated array of selected policies
+13 ;
+14 NEW TEXT
+15 ; Mark as selected
IF WHICH
Begin DoDot:1
+16 SET ^TMP("IBCNRDVA",$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("IBCNRDVA",$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 policies
+3 ; Input: NUMSEL - Current number of selected policies
+4 ; ^TMP("IBCNRDVA",$J,IEN) - Current Array of selected policies
+5 ; Output: NUMSEL - Updated number of selected policies
+6 ; ^TMP("IBCNRDVA",$J,IEN) - Updated Array of selected policies
+7 SET VALMBCK="R"
+8 DO EN^VALM("IBCN RDV POL SELECTED")
+9 IF '$DATA(IBFASTXT)
DO HDR
DO BLD
+10 QUIT
+11 ;
SELINS(FULL,PROMPT,DLINE,MULT,WLIST) ;EP
+1 ; Select Insurance Company(s) to perform an action upon
+2 ; Also called from IBCNRDV1@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("IBCNRDVIX",$J) - Index of displayed lines of the policy
+10 ; Selector Template.
+11 ; Only used when WLIST="IBCNRDVIX"
+12 ; ^TMP("IBCNRDVSIX",$J) - Index of displayed lines of the policy
+13 ; Selected Template
+14 ; Only used if WLIST is "IBCNRDVSIX"
+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 policy(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="IBCNRDV1"
+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("IBCNRDV",$J) - Body lines to display
+4 SET VALMBCK="R"
+5 KILL ^TMP("IBCNRDVS",$JOB),^TMP("IBCNRDVSIX",$JOB)
+6 DO BLD2
+7 QUIT
+8 ;
BLD2 ; Build listman body for Show Selections
+1 ; Input: None
+2 ; Output: VALMCNT - Total number of lines displayed in the body
+3 ; ^TMP("IBCNRDVS",$J) - Body lines to display
+4 ; ^TMP("IBCNRDVSIX",$J) - Index of Entry IENs by display line
+5 NEW IIEN,LINE
+6 ;
+7 ; Build the lines to be displayed
+8 SET (IIEN,VALMCNT)=0
+9 FOR
SET IIEN=$ORDER(^TMP("IBCNRDVA",$JOB,IIEN))
if 'IIEN
QUIT
Begin DoDot:1
+10 SET VALMCNT=VALMCNT+1
+11 SET LINE=$$BLDLN(VALMCNT,IIEN)
+12 DO SET^VALM10(VALMCNT,LINE,LINE)
+13 SET ^TMP("IBCNRDVSIX",$JOB,VALMCNT)=IIEN
End DoDot:1
+14 ;
+15 IF VALMCNT=0
Begin DoDot:1
+16 SET ^TMP("IBCNRDVS",$JOB,1,0)="No Selected Policies were found."
End DoDot:1
+17 QUIT
+18 ;
EXIT2 ;EP for Show Selections
+1 ; Exit code
+2 ; Input: None
+3 KILL ^TMP("IBCNRDVS",$JOB),^TMP("IBCNRDVSIX",$JOB)
+4 DO CLEAR^VALM1
+5 QUIT
