- 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 Feb 18, 2025@23:42:35 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