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

IBCNRDV1.m

Go to the documentation of this file.
  1. IBCNRDV1 ;AITC/TAZ - INSURANCE INFORMATION EXCHANGE VIA RDV ;11-MAR-2020
  1. ;;2.0;INTEGRATED BILLING;**664**;21-MAR-94;Build 29
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; This routine is used to exchange insurance information between
  1. ; facilities.
  1. ;
  1. Q ;Only called from labels
  1. ;
  1. EN ; -- main entry point for IBCN RDV SELECTION
  1. N NUMSEL
  1. S NUMSEL=0
  1. D EN^VALM("IBCN RDV SELECTOR")
  1. Q
  1. ;
  1. HDR ; -- header code
  1. N PATNAM,VA
  1. S PATNAM=$$GET1^DIQ(2,DFN_",",.01)
  1. D PID^VADPT
  1. S VALMHDR(1)="Patient Name: "_PATNAM_" "_$E(PATNAM,1)_$G(VA("BID"))_" "_$$FMTE^XLFDT($$GET1^DIQ(2,DFN_",",.03))
  1. S VALMHDR(2)=NUMSEL_" Polic"_$S(NUMSEL=1:"y",1:"ies")_" selected."
  1. S VALM("TITLE")="Insurance Import Selection"
  1. Q
  1. ;
  1. INIT ; -- init variables and list array
  1. N DATA,LINE,LINEVAR
  1. K @VALMAR
  1. D BLD
  1. Q
  1. ;
  1. BLD ;
  1. ;Source Data from ^TMP($J,"IBCNRDV")
  1. N IIEN,LINE
  1. S (IIEN,VALMCNT)=0
  1. F S IIEN=$O(^TMP($J,"IBCNRDV",IIEN)) Q:'IIEN D
  1. . S VALMCNT=VALMCNT+1
  1. . S LINE=$$BLDLN(VALMCNT,IIEN)
  1. . D SET^VALM10(VALMCNT,LINE,LINE)
  1. . S ^TMP("IBCNRDVIX",$J,VALMCNT)=IIEN
  1. Q
  1. ;
  1. BLDLN(ICTR,IIEN,DATA) ;EP
  1. ; Builds a line to display one insurance company
  1. ; Input: ICTR - Selection Number
  1. ; IIEN - IEN of the Policy to be displayed
  1. ; ^TMP("IBCNRDVA",$J,IIEN) - Array of currently selected policies
  1. ;
  1. ; Output: LINE - Formatted for setting into the list display
  1. N DATA,LINEVAR
  1. M DATA=^TMP($J,"IBCNRDV",IIEN)
  1. S LINEVAR=""
  1. I $D(^TMP("IBCNRDVA",$J,IIEN)) S ICTR=ICTR_">"
  1. S LINEVAR=$$SETFLD^VALM1(ICTR,LINEVAR,"CTR")
  1. S LINEVAR=$$SETFLD^VALM1($G(DATA(20.01)),LINEVAR,"INSCO")
  1. S LINEVAR=$$SETFLD^VALM1($G(DATA(40.02)),LINEVAR,"GRPNM")
  1. S LINEVAR=$$SETFLD^VALM1($$GET1^DIQ(4,$G(DATA(.14)),.01),LINEVAR,"SITE")
  1. Q LINEVAR
  1. ;
  1. HELP ; -- help code
  1. S X="?" D DISP^XQORM1 W !!
  1. Q
  1. ;
  1. EXIT ; -- exit code
  1. ;File selected plans
  1. I $D(IBFASTXT)!'$D(^TMP("IBCNRDVA",$J)) G EXITQ
  1. N X,Y
  1. S DIR(0)="YA",DIR("A")="Are you sure you want to file the selected plans? (Y/N): ",DIR("B")="Y"
  1. D ^DIR K DIR
  1. I Y D
  1. . N IBB,IIEN
  1. . S IIEN=0
  1. . F S IIEN=$O(^TMP("IBCNRDVA",$J,IIEN)) Q:'IIEN D
  1. .. M IBB=^TMP($J,"IBCNRDV",IIEN)
  1. .. S IBB=$$ADDSTF^IBCNBES($G(IBB(.03),1),DFN,.IBB)
  1. . W !!,NUMSEL," entr",$S(NUMSEL=1:"y has",1:"ies have")," been added to the Insurance Buffer File."
  1. . D WAIT^VALM1
  1. ;
  1. EXITQ ;
  1. K @VALMAR,^TMP("IBCNRDVIX",$J),^TMP("IBCNRDVA",$J)
  1. Q
  1. ;
  1. EXPND ; -- expand code
  1. Q
  1. ;
  1. SEL ;EP
  1. ; Protocol Action to select an unselected policy
  1. ; Input: NUMSEL - Current number of selected policies
  1. ; ^TMP("IBCNRDV1",$J) - Current Array of displayed policies
  1. ; ^TMP("IBCNRDVIX",$J) - Current Index of displayed policies
  1. ; ^TMP("IBCNRDVA,$J,IIEN) - Current Array of selected policies
  1. ; Output: NUMSEL - Updated number of selected policies
  1. ; ^TMP("IBCNRDVA,$J,IIEN)- Updated Array of selected policies
  1. ; Selected Insurance Company is added to the worklist
  1. ; Error message displayed (potentially)
  1. N DIR,DIROUT,DIRUT,DLINE,DTOUT,DUOUT,ERROR,IEN,IIENS,IX,LINE,PROMPT
  1. S VALMBCK="R",ERROR=0
  1. ;
  1. ; First select the Policy(s) to be selected
  1. S PROMPT="Select Policy(s)"
  1. S IIENS=$$SELINS(1,PROMPT,.DLINE,1,"IBCNRDVIX")
  1. I IIENS="" S VALMBCK="R" Q ; None Selected
  1. F IX=1:1:$L(IIENS,",") D
  1. . S IIEN=$P(IIENS,",",IX)
  1. . S LINE=$P(DLINE,",",IX)
  1. . ;
  1. . ; If currently selected, display an error message
  1. . I $D(^TMP("IBCNRDVA",$J,IIEN)) D Q
  1. . . W !,*7,">>>> # ",LINE," is currently selected."
  1. . . S ERROR=1
  1. . D MARK(1,IIEN,LINE,.NUMSEL) ; Show the selection mark
  1. D HDR ; Update the header
  1. D:ERROR PAUSE^VALM1
  1. Q
  1. ;
  1. UNSEL(SELECTED) ;EP
  1. ; Protocol Action to deselect an already selected policy
  1. ; Input: SELECTED - 1 - Called from IBCN RDV POL DESELECT
  1. ; 0 - Called from IBCN RDV DESELECT
  1. ; Optional, defaults to 0
  1. ; NUMSEL - Current number of selected policies
  1. ; ^TMP("IBCNRDV",$J) - Current Array of displayed policies
  1. ; ^TMP("IBCNRDVS",$J) - Current Array of selected policies
  1. ; ^TMP("IBCNRDVIX",$J) - Current Index of displayed policies
  1. ; ^TMP("IBCNRDVA,$J,IIEN)- Current Array of selected policies
  1. ; Output: NUMSEL - Current number of selected policies
  1. ; ^TMP("IBCNRDVA,$J,IIEN)- Updated Array of selected policies
  1. ; Selected policy is removed from the worklist
  1. ; Error message displayed (potentially)
  1. N DIR,DIROUT,DIRUT,DLINE,DTOUT,DUOUT,ERROR,IEN,IIENS,IX,LINE,PROMPT,WARRAY
  1. I '$D(SELECTED) D
  1. . S SELECTED=0,WARRAY="IBCNRDVIX"
  1. E S WARRAY="IBCNRDVSIX"
  1. S VALMBCK="R",ERROR=0
  1. ;
  1. ; First select the Policy(s) to be deselected
  1. S PROMPT="Deselect Policy(s)"
  1. S IIENS=$$SELINS(1,PROMPT,.DLINE,1,WARRAY)
  1. I IIENS="" S VALMBCK="R" Q ; None Selected
  1. F IX=1:1:$L(IIENS,",") D
  1. . S IIEN=$P(IIENS,",",IX)
  1. . S LINE=$P(DLINE,",",IX)
  1. . ;
  1. . ; If not currently selected, display an error message
  1. . I '$D(^TMP("IBCNRDVA",$J,IIEN)) D Q
  1. . . W !,*7,">>>> # ",LINE," is not currently selected. It cannot be deselected."
  1. . . S ERROR=1
  1. . D MARK(0,IIEN,LINE,.NUMSEL) ; Deselect the entry
  1. D HDR ; Update the header
  1. D:ERROR PAUSE^VALM1
  1. Q
  1. ;
  1. MARK(WHICH,IIEN,LINE,NUMSEL) ;EP
  1. ; Mark/Remove 'Selection' from a selected
  1. ; Insurance Company line
  1. ; Input: WHICH - 0 - Remove 'Selection' mark
  1. ; 1 - Set 'Selection' mark
  1. ; IENIN - IEN of the entry to Mark/Remove 'In-Progress'
  1. ; LINE - Line number being marked/unmarked
  1. ; WLIST - Worklist, the user is selecting from.
  1. ; NUMSEL - Current # of selected policies
  1. ; ^TMP("IBCNRDVA",$J)- Current array of selected policies
  1. ; Output: Policy is marked or unmarked as selected
  1. ; NUMSEL - Current # of selected policies
  1. ; ^TMP("IBCNRDVA",$J)- Updated array of selected policies
  1. ;
  1. N TEXT
  1. I WHICH D ; Mark as selected
  1. . S ^TMP("IBCNRDVA",$J,IIEN)=""
  1. . S TEXT=LINE_">",NUMSEL=NUMSEL+1
  1. E D ; Mark as selected
  1. . K ^TMP("IBCNRDVA",$J,IIEN)
  1. . S TEXT=LINE,NUMSEL=NUMSEL-1
  1. D FLDTEXT^VALM10(LINE,"CTR",TEXT) ; Update display
  1. D WRITE^VALM10(LINE) ; Redisplay line
  1. Q
  1. ;
  1. SHOWSEL ;EP
  1. ; Protocol action used to display a listman template of the currently
  1. ; selected policies
  1. ; Input: NUMSEL - Current number of selected policies
  1. ; ^TMP("IBCNRDVA",$J,IEN) - Current Array of selected policies
  1. ; Output: NUMSEL - Updated number of selected policies
  1. ; ^TMP("IBCNRDVA",$J,IEN) - Updated Array of selected policies
  1. S VALMBCK="R"
  1. D EN^VALM("IBCN RDV POL SELECTED")
  1. I '$D(IBFASTXT) D HDR,BLD
  1. Q
  1. ;
  1. SELINS(FULL,PROMPT,DLINE,MULT,WLIST) ;EP
  1. ; Select Insurance Company(s) to perform an action upon
  1. ; Also called from IBCNRDV1@UNSEL
  1. ; Input: FULL - 1 - full screen mode, 0 otherwise
  1. ; PROMPT - Prompt to be displayed to the user
  1. ; MULT - 1 to allow multiple entry selection
  1. ; 0 to only allow single entry selection
  1. ; Optional, defaults to 0
  1. ; WLIST - Worklist, the user is selecting from
  1. ; ^TMP("IBCNRDVIX",$J) - Index of displayed lines of the policy
  1. ; Selector Template.
  1. ; Only used when WLIST="IBCNRDVIX"
  1. ; ^TMP("IBCNRDVSIX",$J) - Index of displayed lines of the policy
  1. ; Selected Template
  1. ; Only used if WLIST is "IBCNRDVSIX"
  1. ; Output: DLINE - Comma delimited list of Line #(s) of the
  1. ; selected Ins Cos
  1. ; Returns: IIEN(s) - Comma delimited string or IENS for the selected policy(s)
  1. ; Error message and "" IENS if multi-selection and not allowed
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,IIEN,IIENS,IX,VALMY,X,Y
  1. S:'$D(MULT) MULT=0
  1. S:'$D(WLIST) WLIST="IBCNRDV1"
  1. D:FULL FULL^VALM1
  1. S DLINE=$P($P($G(XQORNOD(0)),"^",4),"=",2) ; User selection with action
  1. S DLINE=$TR(DLINE,"/\; .",",,,,,") ; Check for multi-selection
  1. S IIENS=""
  1. I 'MULT,DLINE["," D Q "" ; Invalid multi-selection
  1. . W !,*7,">>>> Only single entry selection is allowed"
  1. . S DLINE=""
  1. . K DIR
  1. . D PAUSE^VALM1
  1. ;
  1. ; Let the user enter their selection(s)
  1. D EN^VALM2($G(XQORNOD(0)),"O") ; ListMan generic selector
  1. I '$D(VALMY) Q ""
  1. S IX="",DLINE=""
  1. F D Q:IX=""
  1. . S IX=$O(VALMY(IX))
  1. . Q:IX=""
  1. . S DLINE=$S(DLINE="":IX,1:DLINE_","_IX)
  1. . S IIEN=$G(^TMP(WLIST,$J,IX))
  1. . S IIENS=$S(IIENS="":IIEN,1:IIENS_","_IIEN)
  1. Q IIENS
  1. ;
  1. INIT2 ;EP for Show Selections
  1. ; Initialize variables and list array
  1. ; Input: None
  1. ; Output: ^TMP("IBCNRDV",$J) - Body lines to display
  1. S VALMBCK="R"
  1. K ^TMP("IBCNRDVS",$J),^TMP("IBCNRDVSIX",$J)
  1. D BLD2
  1. Q
  1. ;
  1. BLD2 ; Build listman body for Show Selections
  1. ; Input: None
  1. ; Output: VALMCNT - Total number of lines displayed in the body
  1. ; ^TMP("IBCNRDVS",$J) - Body lines to display
  1. ; ^TMP("IBCNRDVSIX",$J) - Index of Entry IENs by display line
  1. N IIEN,LINE
  1. ;
  1. ; Build the lines to be displayed
  1. S (IIEN,VALMCNT)=0
  1. F S IIEN=$O(^TMP("IBCNRDVA",$J,IIEN)) Q:'IIEN D
  1. . S VALMCNT=VALMCNT+1
  1. . S LINE=$$BLDLN(VALMCNT,IIEN)
  1. . D SET^VALM10(VALMCNT,LINE,LINE)
  1. . S ^TMP("IBCNRDVSIX",$J,VALMCNT)=IIEN
  1. ;
  1. I VALMCNT=0 D
  1. . S ^TMP("IBCNRDVS",$J,1,0)="No Selected Policies were found."
  1. Q
  1. ;
  1. EXIT2 ;EP for Show Selections
  1. ; Exit code
  1. ; Input: None
  1. K ^TMP("IBCNRDVS",$J),^TMP("IBCNRDVSIX",$J)
  1. D CLEAR^VALM1
  1. Q