IBRFIWL ;ALB/FA - IB LIST OF Request For Additional Information (RFAI) SCREEN ;18-JUL-2015
;;2.0;INTEGRATED BILLING;**547**;21-MAR-1994;Build 119
;;Per VA Directive 6402, this routine should not be modified.
;
EN ; Main entry point for RFAI Management Worklist
; Input: None
; Output: IBAUTHB - Selected Authorized Biller(s)
; IBSORT1 - Selected Primary Sort
; IBSORT2 - Selected Secondary Sort
N IBAUTHB,IBDONE,IBSORT1,IBSORT2,VALMSG
S IBDONE=$$SORT(0)
I IBDONE D Q
. W !!,*7,"Sort Criteria was not selected"
. D PAUSE^VALM1
. S VALMQUIT=1
D EN^VALM("IBRFI 277 WL")
Q
;
HDR ;EP
; Build the listman template header information
; Input: IBAUTHB - Selected Authorized Biller(s)
; IBSORT1 - Selected Primary Sort
; IBSORT2 - Selected Secondary Sort
; Output: VALMHDR - array of header lines for the templaqte3
;N XX
;S XX="Primary Sort: "_$$SD^IBRFIWLA(IBSORT1)
;S:IBSORT2'="" XX=XX_" Secondary Sort: "_$$SD^IBRFIWLA(IBSORT2)
;S VALMHDR(1)=XX
;S:IBAUTHB VALMHDR(2)="Filter: Selected Authorized Billers"
Q
;
INIT ;EP
; Initialize variables and list array
; Input: IBAUTHB - Selected Authorized Biller(s)
; IBSORT1 - Selected Primary Sort
; IBSORT2 - Selected Secondary Sort
;K ^TMP("IBBIL",$J)
K ^TMP("IBRFIWL",$J),^TMP("IBRFIWLS",$J),^TMP("IBRFIWLIX",$J)
K VALMQUIT
S VALMSG="|* Review in progress | Enter ?? for more actions|"
D BLD(.IBAUTHB,IBSORT1,IBSORT2)
Q
;
SORT(REBUILD) ;EP
; Protocol action and also called initially from method EN
; Select/ReSelect Sort/Filter criteria
; Input: REBUILD - 1 to rebuild the worklist (set to 1 from Resort
; protocol option)
; Optional, defaults to 0
; IBAUTHB - Currently Selected Authorized Biller(s)
; IBSORT1 - Currently Selected Primary Sort
; IBSORT2 - Currently Selected Secondary Sort
; Output: IBAUTHB - Currently Selected Authorized Biller(s)
; IBSORT1 - Currently Selected Primary Sort
; IBSORT2 - Currently Selected Secondary Sort
; Returns: 1 - User exited without entering Sort/Filter criteria
; 0 Otherwise
N IBDONE,IBSTOP,XX
S:'$D(REBUILD) REBUILD=0
D FULL^VALM1
D AUTHB(.IBAUTHB,.IBDONE) ; Authorized Biller filter
Q:IBDONE 1
S IBSORT1=$$SORTSET^IBRFIWLA(1,"L","",.IBDONE) ; Primary Sort
Q:IBDONE 1
;
; If the user selected Oldest or Newest Date Received as the primary sort,
; Do not ask for secondary sort
;I (IBSORT1="O")!(IBSORT1="N") S IBSORT2=0
;E D
;. S XX=$S(IBSORT1="O":"",1:"O") ; Default Secondary Sort
;. S IBSORT2=$$SORTSET^IBRFIWLA(2,XX,IBSORT1,.IBDONE) ; Secondary Sort
S XX=$S(IBSORT1="O"!(IBSORT1="N"):"L",1:"O") ; Default Secondary Sort
S IBSORT2=$$SORTSET^IBRFIWLA(2,XX,IBSORT1,.IBDONE) ; Secondary Sort
I REBUILD D
. D INIT ; Rebuild Sorted worklist
. D HDR ; Redisplay Header
. S VALMBCK="R"
Q:IBDONE 1
Q 0
;
AUTHB(IBAUTHB,IBDONE) ; Set the Authorized Biller
; Input: None
; Output: IBAUTHB - 1 - Authorized Biller(s) selected, 0 otherwise
; IBDONE - 1 if user quit or timed out
;
K ^TMP("IBBIL",$J)
N FIRST,DIC,DTOUT,DONE,DUOUT,X,Y
S FIRST=1,(DONE,IBDONE)=0,IBAUTHB=0
F D Q:DONE
. S DIC="^VA(200,",DIC(0)="AEQM"
. S DIC("A")="Select "_$S(FIRST:"",1:" Another ")_"Authorizing Biller: "
. S:FIRST DIC("A")=DIC("A")_"ALL// "
. D ^DIC
. K DIC
. I Y<0 S DONE=1 Q
. I $D(^TMP("IBBIL",$J,+Y)) D Q
. . W !!,*7,"This biller has already been selected",!
. S ^TMP("IBBIL",$J,+Y)="",FIRST=0,IBAUTHB=1
I $D(DTOUT)!$D(DUOUT) S IBDONE=1 Q
Q
;
BLD(IBAUTHB,IBSORT1,IBSORT2) ; Build the listman template body
; Input: IBAUTHB - Authorized Biller filter
; IBSORT1 - Primary Sort
; IBSORT2 - Secondary Sort
; ^TMP("IBRFIWLS",$J,A,B)=RFAIEN - See GETMSGS
; ^TMP("IBRIFWLIX",$J,CNT)=RFAIEN^### - Message Selector Index
N AA,CNT,PFILTER,RFAIEN,S1,S2,XX,SFILTER
D GETMSGS(.IBAUTHB,IBSORT1,IBSORT2) ; Get Sorted/Filtered list
S (CNT,VALMCNT)=0,(AA,PFILTER,S1)=""
F D Q:AA=""
. S AA=$O(^TMP("IBRFIWLS",$J,AA))
. Q:AA=""
. S S1=""
. F D Q:S1=""
. . S S1=$O(^TMP("IBRFIWLS",$J,AA,S1))
. . Q:S1=""
. . S S2=""
. . F D Q:S2=""
. . . S S2=$O(^TMP("IBRFIWLS",$J,AA,S1,S2))
. . . Q:S2=""
. . . S RFAIEN=""
. . . F D Q:RFAIEN=""
. . . . S RFAIEN=$O(^TMP("IBRFIWLS",$J,AA,S1,S2,RFAIEN))
. . . . Q:RFAIEN=""
. . . . S XX=$S(AA="~":S1,1:0)
. . . . D BLDONEM(.VALMCNT,.CNT,RFAIEN,IBSORT1,.PFILTER,XX,S1,IBSORT2,S2,.SFILTER)
Q
;
GETMSGS(IBAUTHB,IBSORT1,IBSORT2) ; Retrieves the RFAI Messages filtering
; by Authorized Biller in sorted order
; Input: IBAUTHB - Authorized Biller filter
; IBSORT1 - Primary Sort
; IBSORT2 - Secondary Sort
; Output: ^TMP("IBRFIWLS",$J,A,B,C,IEN)=""- Where:
; A - ~ - Bad Record Indicator
; 1 - No Authorized Biller filter
; Authorized Biller Name
; B - When A=0 - Bad Data Type
; Otherwise Primary sort value
; C - When A=0 - 0
; Otherwise Secondary Sort value OR
; 0 if no secondary sort
; IEN - IEN of the RFAI Message
N CNT,IBIFN,PIEN,RAUTHBV,RFAIEN,SKIP,STATUS,XX
S CNT=0,RFAIEN=""
F D Q:RFAIEN=""
. S RFAIEN=$O(^IBA(368,"E",0,RFAIEN))
. Q:RFAIEN=""
. S SKIP=0
. Q:$$BADREQ(RFAIEN) ; Quit if bad data error
. S:'$G(IBAUTHB) RAUTHBV=1 ; No Authorized Biller filter or primary sort
. S:IBSORT1="B" RAUTHBV=""
. ;
. ; Filtering on Authorized Biller
. I $G(RAUTHBV)'=1 D Q:SKIP
. . S RAUTHBV=$$GET1^DIQ(399,IBIFN,11,"I") ; IEN of Bill/Claims Authorizer
. . ;
. . ; If Request MRA bill, pull the MRA Requestor user instead
. . I 'RAUTHBV D
. . . S STATUS=$$GET1^DIQ(399,IBIFN,.13,"I") ; Status of Bill
. . . Q:STATUS'=2 ; Not a Request MRA Bill
. . . S RAUTHBV=$$GET1^DIQ(399,IBIFN,8,"I") ; MRA Requestor
. . ;
. . ; Not a selected Authorized Biller
. . I $G(IBAUTHB),'$D(^TMP("IBBIL",$J,RAUTHBV)) S SKIP=1 Q
. . S RAUTHBV=$$GET1^DIQ(200,RAUTHBV,.01) ; New Person NAME
. ;
. D GETONEM(RFAIEN,RAUTHBV,IBSORT1,IBSORT2,IBIFN) ; Get One Message
Q
;
BADREQ(RFAIEN) ; Marks a record that contains missing or incorrect
; critical data
; Input: RFAIEN - IEN of the record containing bad data
; ^TMP("IBRFIWLS",$J,-1,TYPE,0)=RFAIEN potentially
; Returns: 1 - Bad data found, 0 otherwise
N PIEN,XX
S IBIFN=$$GET1^DIQ(368,RFAIEN,111.01,"I") ; IEN for Bill/Claims file
I IBIFN="" D Q 1
. S ^TMP("IBRFIWLS",$J,"~",1,0,RFAIEN)=""
;
S PIEN=$$GET1^DIQ(368,RFAIEN,109.01,"I") ; Patient IEN
I PIEN="" D Q 1
. S ^TMP("IBRFIWLS",$J,"~",2,0,RFAIEN)="" ; Patient Bill/Mismatch
Q 0
;
GETONEM(RFAIEN,RAUTHB,IBSORT1,IBSORT2,IBIFN) ; Get the Data for a specified
; RFAI Message
; Input: RFAIEN - IEN of the selected RFAI Message
; RAUTHB - Authorized Biller Name
; 1 - No Authorized Biller filter
; IBSORT1 - Primary Sort Code
; IBSORT2 - Secondary Sort Code
; IBIFN - IEN for the associated Bill/Claims record
; Output: ^TMP("IBRFIWLS",$J,A,B,C)=IEN - Where:
; A - 0 - Bad Record Indicator
; 1 - No Authorized Biller filter or it passed the filter
; B - When A=0 - Bad Data Type
; Otherwise Primary sort value
; C - When A=0 - 0
; Otherwise Secondary Sort value OR
; 0 if no secondary sort
; IEN - IEN of the RFAI Message
N FIELDP,FIELDS,RDATE
S (FIELDP,FIELDS)=""
;
; Determine the Primary Sort field
S:(IBSORT1="N")!(IBSORT1="O") FIELDP=100.02 ; Request date/tinme
I FIELDP="",((IBSORT1="E")!(IBSORT1="D")) D ; Response Date
. S FIELDP=112.01
I FIELDP="",IBSORT1="I" S FIELDP=101.01 ; Insurance Company Name
I FIELDP="",IBSORT1="P" S FIELDP=109.01 ; Patient Name
I FIELDP="",IBSORT1="L" S FIELDP=122.03 ; LOINC Code
S:FIELDP="" FIELDP=-1 ; Authorized Biller
;
; Determine the Secondary Sort field
I IBSORT2="" S FIELDS=-2 ; No Secondary Sort
S:(IBSORT2="N")!(IBSORT2="O") FIELDS=100.03 ; Transmission Date
I FIELDS="",((IBSORT2="E")!(IBSORT2="D")) D ; Request Due Date
. S FIELDS=112.01
I FIELDS="",IBSORT2="I" S FIELDS=101.01 ; Insurance Company Name
I FIELDS="",IBSORT2="P" S FIELDS=109.01 ; Patient Name
I FIELDS="",IBSORT2="L" S FIELDS=122.03 ; LOINC Code
S:FIELDS="" FIELDS=-1 ; Authorized Biller
;
; Get the sort values
;S RDATE=$S(IBSORT1="N":1,IBSORT1="E":1,1:2)
S RDATE=$S(IBSORT1="O":1,IBSORT1="D":1,1:2)
S FIELDP=$S(IBSORT1="B":RAUTHB,1:$$GETFVAL(FIELDP,RFAIEN,RAUTHB,RDATE)) ; Get Primary sort value
I ".D.O.N.E."[("."_IBSORT1_".") S FIELDP=$P(FIELDP,".") ; don't need times for sort
;S RDATE=$S(IBSORT2="N":1,IBSORT2="E":1,1:2)
S RDATE=$S(IBSORT2="O":1,IBSORT2="D":1,1:2)
S FIELDS=$$GETFVAL(FIELDS,RFAIEN,RAUTHB,RDATE) ; Get Secondary sort value
I ".D.O.N.E."[("."_IBSORT2_".") S FIELDS=$P(FIELDS,".")
I IBSORT2=""!(IBSORT2=0) S FIELDS=0 ; no secondary, avoild subscript error
;
; Finally set the sorted record into the list
S ^TMP("IBRFIWLS",$J,$S(RAUTHB="~":"~",1:1),FIELDP,FIELDS,RFAIEN)=""
Q
;
GETFVAL(FIELD,RFAIEN,RAUTHB,RDATE,RETNA) ;EP
; Returns the external value of the specified field
; Input: FIELD - # of the field to be retrieved
; NOTE: if this number is >100 AND no value is found, then
; the value of FIELD-100 will be returned which is
; the raw value received from the HL7 message.
; The following are 'special' FIELD values:
; -1 - RAUTHB variable is used
; -2 - 0 is returned
; -3 - Last 4 digits of the SSN are returned
; -4 - Current balance is returned
; FIELD
; RFAIEN - IEN of the RFAI Message (file 368) to retrieve values from
; RAUTHB - IEN of the Authorized Billed (special case)
; Optional, defaults to ""
; RDATE - 1 - Return negative internal date (used for sorting)
; 2 - Return internal date (used for sorting)
; 3 - Force Date conversion to DD/MM/YY
; 0 - Return external date (DD/MM/YY)
; Optional, defaults to 0
; RETNA - 2 - Return null if field does not contain a value
; 1 - Return '*NA*' if field does not contain a value
; 0 - Return '0'
; Optional, defaults to 0
; Returns: External Field value
N VAL,VAL2,XX,YY
S:'$D(RAUTHB) RAUTHB=0
S:'$D(RDATE) RDATE=0
S:'$D(RETNA) RETNA=0
I $F(FIELD,",") D Q VAL
. N FILE
. S FILE=$P(FIELD,","),FIELD=$P(FIELD,",",2)
. S VAL=$$GET1^DIQ(FILE,RFAIEN,FIELD)
. I RDATE=3,VAL]"" S VAL2=$$GET1^DIQ(FILE,RFAIEN,FIELD,"I") S:VAL2]"" VAL=$$FMTE^XLFDT(VAL2,"2DZ")
. I VAL="" D ; Return raw value
.. I FILE=368.0113 S FILE=368.013
.. I FILE=368.0121 S FILE=368.021
.. I FILE=368.12199 S FILE=368.2199
.. S VAL=$$GET1^DIQ(FILE,RFAIEN,FIELD)
.. I VAL="" S VAL=$S(RETNA=1:"*NA*",RETNA=2:"",1:0)
.. Q
. Q
I FIELD=-1 Q $$GET1^DIQ(200,RAUTHB,.01) ; Authorized Biller Name
I FIELD=-2 Q 0
I FIELD=-3 D Q VAL ; Last 4 digits of SSN
. S VAL=$$GET1^DIQ(368,RFAIEN,109.01,"I") ; Patient Pointer
. I VAL="" S VAL=$S(RETNA=1:"*NA*",RETNA=2:"",1:0) Q
. S VAL=$$GET1^DIQ(2,VAL,.09) ; SSN number
. I VAL="" S VAL=$S(RETNA=1:"*NA*",RETNA=2:"",1:0) Q
. S VAL=$E(VAL,6,9)
I FIELD=-4 D Q VAL ; Current Balance
. S VAL=$$GET1^DIQ(368,RFAIEN,111.01,"I") ; Bill pointer
. I VAL="" S VAL=$S(RETNA=1:"*NA*",RETNA=2:"",1:0) Q
. S XX=$$GET1^DIQ(399,VAL,201,"I") ; Current Balance
. S YY=$$GET1^DIQ(399,VAL,202,"I") ; Offset
. S VAL=XX-YY
;
S VAL=$$GET1^DIQ(368,RFAIEN,FIELD,"E") ; Get external value
I FIELD=122.03,VAL'="" S VAL=VAL_": "_$$GET1^DIQ(368,RFAIEN,FIELD_":1") ; add LOINC code description
I FIELD=122.03,VAL="" S VAL=$$GET1^DIQ(368,RFAIEN,22.03,"E") ; for LOINC codes not in LAB LOINC file
I ((FIELD=100.02)!(FIELD=100.03)!(FIELD=.03)!(FIELD=122.04)!(FIELD=113.03)!(FIELD=112.01)!(FIELD=114.03)!(FIELD=114.04)),VAL'="" D Q VAL
. S VAL=$$GET1^DIQ(368,RFAIEN,FIELD,"I")
. Q:RDATE=2 ; Return internal date
. I RDATE=1 S VAL=VAL*-1 Q ; Return negative internal date
. S VAL=$$FMTE^XLFDT(VAL,"2DZ") ; Return external date
I VAL'="" Q VAL
I VAL="",FIELD>100 D ; Return raw value
. S FIELD=FIELD-100
. S VAL=$$GET1^DIQ(368,RFAIEN,FIELD)
S:VAL="" VAL=$S(RETNA=1:"*NA*",RETNA=2:"",1:0)
Q VAL
;
BLDONEM(VALMCNT,MSGCNT,RFAIEN,IBSORT1,PFILTER,BTYPE,PSORT,IBSORT2,SSORT,SFILTER) ; Build one Message into
; the listman display
; Input: VALMCNT - Current Line of the display being
; (re)built
; MSGCNT - Current Message Number
; RFAIEN - IEN of the message to be displayed
; IBSORT1 - Primary Sort Code
; PFILTER - Current Filter line value
; BTYPE - 0 - Not a bad record
; Otherwise, type of bad record (1-2)
; PSORT - External value of primary sort data
; IBSORT2 - Secondary Sort Code
; SSORT - External value of secondary sort data
;
; Output: VALMCNT - Updated Line of the display being
; MSGCNT - Updated Message Number
; PFILTER - Update Filter line Value
; ^TMP("IBRIFWLIX",$J,CNT) - Message Selector Index
N LINE,VAL,XX
I BTYPE D ; Display Bad Record Type
. Q:PFILTER=BTYPE ; Same as previous line
. S VALMCNT=VALMCNT+1,PFILTER=BTYPE
. I BTYPE=1 D
. . S LINE="Messages with an invalid Bill Number"
. I BTYPE=2 D
. . S LINE="Messages with Patient/Bill Mismatch"
. D SET^VALM10(VALMCNT,LINE,VALMCNT)
I 'BTYPE D
. I ".N.O.E.D."[("."_IBSORT1_".") S PSORT=$TR(PSORT,"-"),PSORT=$$FMTE^XLFDT(PSORT,"2DZ")
. S LINE=$S(IBSORT1="I":"Insurance Company Name: ",IBSORT1="P":"Patient Name: ",IBSORT1="B":"Authorizing Biller: ",IBSORT1="L":"LOINC Code: ",IBSORT1="E"!(IBSORT1="D"):"Date Due: ",1:"Date Received: ")_PSORT
. I PFILTER'=LINE D
. . S VALMCNT=VALMCNT+1,PFILTER=LINE
. . D SET^VALM10(VALMCNT,LINE,VALMCNT)
. . S SFILTER=""
. I $G(IBSORT2)]"",$G(IBSORT2)'=0 D
. . I ".N.O.E.D."[("."_IBSORT2_".") S SSORT=$TR(SSORT,"-"),SSORT=$$FMTE^XLFDT(SSORT,"2DZ")
. . S LINE=" "_$S(IBSORT2="I":"Insurance Company Name: ",IBSORT2="P":"Patient Name: ",IBSORT2="B":"Authorizing Biller: ",IBSORT2="L":"LOINC Code: ",IBSORT2="E"!(IBSORT2="D"):"Date Due: ",1:"Date Received: ")_SSORT
. . I SFILTER'=LINE D
. . . S VALMCNT=VALMCNT+1,SFILTER=LINE
. . . D SET^VALM10(VALMCNT,LINE,VALMCNT)
S CNT=CNT+1,VALMCNT=VALMCNT+1
S ^TMP("IBRFIWLIX",$J,CNT)=RFAIEN
S LINE=$$SETL("",MSGCNT,"",1,4) ; Message #
S VAL=$$GETFVAL(111.01,RFAIEN,"",0,2) ; External Bill #
S XX=$$GET1^DIQ(368,RFAIEN,200.04,"I") ; Review Status
S:XX VAL=VAL_"*"
S LINE=$$SETL(LINE,VAL,"",5,8)
D SET^VALM10(VALMCNT,LINE,VALMCNT)
S VAL=$$GETFVAL(101.01,RFAIEN,"",0,2) ; Ins. Co. Name
S LINE=$$SETL(LINE,VAL,"",15,16)
D SET^VALM10(VALMCNT,LINE,VALMCNT)
S VAL=$$GETFVAL(109.01,RFAIEN,"",0,2) ; Patient Name
S LINE=$$SETL(LINE,VAL,"",33,20)
D SET^VALM10(VALMCNT,LINE,VALMCNT)
S VAL=$$GETFVAL(-3,RFAIEN,"",0,2) ; SSN
S LINE=$$SETL(LINE,VAL,"",56,4)
D SET^VALM10(VALMCNT,LINE,VALMCNT)
S VAL=$$GETFVAL(114.03,RFAIEN,"",2,2) ; Service Date
I VAL'="" S VAL=$$FMTE^XLFDT(VAL,"2Z")
S LINE=$$SETL(LINE,VAL,"",61,8)
D SET^VALM10(VALMCNT,LINE,VALMCNT)
S VAL=$$GETFVAL(-4,RFAIEN,"",0,2) ; Current Balance
S VAL=$J("$"_$FN(VAL,"",2),9)
S LINE=$$SETL(LINE,VAL,"",71,9)
D SET^VALM10(VALMCNT,LINE,VALMCNT)
;
S ^TMP("IBRFIWLIX",$J,CNT)=RFAIEN_U_VALMCNT ; Selection Index - RFAIEN is pointer to file 368, VALMCNT points to detailed entry in worklist ^TMP
;I IBSORT1'="L" D
;. S VALMCNT=VALMCNT+1
;. S VAL=$$GETFVAL(122.03,RFAIEN,"",0,2) ; LOINC Code + Description
;. I VAL'="" D
;. . S LINE=$$SETL("",VAL,"",6,80)
;. . D SET^VALM10(VALMCNT,LINE,VALMCNT)
;
S VALMCNT=VALMCNT+1
S VAL=$$GETFVAL(122.03,RFAIEN,"",0,2) ; LOINC Code + Description
I VAL'="" D
. S LINE=$$SETL("",VAL,"",5,80)
. D SET^VALM10(VALMCNT,LINE,VALMCNT)
Q
;
SETL(LINE,DATA,LABEL,COL,LNG) ; Creates a line of data to be set into the body
; of the worklist
; Input: LINE - Current line being created
; DATA - Information to be added to the end of the current line
; LABEL - Label to describe the information being added
; COL - Column position in line to add information add
; LNG - Maximum length of data information to include on the line
; Returns: Line updated with added information
S LINE=LINE_$J("",(COL-$L(LABEL)-$L(LINE)))_LABEL_$E(DATA,1,LNG)
Q LINE
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
S VALMSG="* Indicates review in progress"
Q
;
SMSG ;EP
; Protocol action to select an RFI message to be worked
; Input: ^TMP("IBRFIWLIX",$J,CNT)=RFAIEN
N RFAIEN,RFAIDET,RFAIDHDR
S VALMBCK="R"
D FULL^VALM1
S RFAIEN=$$SELMSG^IBRFIWLA("Select Message")
I RFAIEN="" S VALMSG="|* Review in progress | Enter ?? for more actions|" Q
S (RFAIDET,RFAIDHDR)=""
I $P(RFAIEN,U,2) D
.S RFAIDET=$P($G(RFAIEN),U,2)
.I $G(RFAIDET) S RFAIDET=$E($G(^TMP("IBRFIWL",$J,+$G(RFAIDET),0)),6,999)
.S RFAIDHDR=$E($G(VALMCAP),6,999)
S RFAIEN=$P(RFAIEN,U)
;
D EN^IBRFIWL1(RFAIEN,RFAIDET,RFAIDHDR) ; Show the detail of the message
D INIT ; Rebuild the list
Q
;
EXIT ; -- exit code
K IBAUTH,IBSORT1,IBSORT2
K ^TMP("IBBIL",$J),^TMP("IBRFIWL",$J),^TMP("IBRFIWLS",$J),^TMP("IBRFIWLIX",$J)
D CLEAN^VALM10
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBRFIWL 19821 printed Oct 16, 2024@18:27:27 Page 2
IBRFIWL ;ALB/FA - IB LIST OF Request For Additional Information (RFAI) SCREEN ;18-JUL-2015
+1 ;;2.0;INTEGRATED BILLING;**547**;21-MAR-1994;Build 119
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
EN ; Main entry point for RFAI Management Worklist
+1 ; Input: None
+2 ; Output: IBAUTHB - Selected Authorized Biller(s)
+3 ; IBSORT1 - Selected Primary Sort
+4 ; IBSORT2 - Selected Secondary Sort
+5 NEW IBAUTHB,IBDONE,IBSORT1,IBSORT2,VALMSG
+6 SET IBDONE=$$SORT(0)
+7 IF IBDONE
Begin DoDot:1
+8 WRITE !!,*7,"Sort Criteria was not selected"
+9 DO PAUSE^VALM1
+10 SET VALMQUIT=1
End DoDot:1
QUIT
+11 DO EN^VALM("IBRFI 277 WL")
+12 QUIT
+13 ;
HDR ;EP
+1 ; Build the listman template header information
+2 ; Input: IBAUTHB - Selected Authorized Biller(s)
+3 ; IBSORT1 - Selected Primary Sort
+4 ; IBSORT2 - Selected Secondary Sort
+5 ; Output: VALMHDR - array of header lines for the templaqte3
+6 ;N XX
+7 ;S XX="Primary Sort: "_$$SD^IBRFIWLA(IBSORT1)
+8 ;S:IBSORT2'="" XX=XX_" Secondary Sort: "_$$SD^IBRFIWLA(IBSORT2)
+9 ;S VALMHDR(1)=XX
+10 ;S:IBAUTHB VALMHDR(2)="Filter: Selected Authorized Billers"
+11 QUIT
+12 ;
INIT ;EP
+1 ; Initialize variables and list array
+2 ; Input: IBAUTHB - Selected Authorized Biller(s)
+3 ; IBSORT1 - Selected Primary Sort
+4 ; IBSORT2 - Selected Secondary Sort
+5 ;K ^TMP("IBBIL",$J)
+6 KILL ^TMP("IBRFIWL",$JOB),^TMP("IBRFIWLS",$JOB),^TMP("IBRFIWLIX",$JOB)
+7 KILL VALMQUIT
+8 SET VALMSG="|* Review in progress | Enter ?? for more actions|"
+9 DO BLD(.IBAUTHB,IBSORT1,IBSORT2)
+10 QUIT
+11 ;
SORT(REBUILD) ;EP
+1 ; Protocol action and also called initially from method EN
+2 ; Select/ReSelect Sort/Filter criteria
+3 ; Input: REBUILD - 1 to rebuild the worklist (set to 1 from Resort
+4 ; protocol option)
+5 ; Optional, defaults to 0
+6 ; IBAUTHB - Currently Selected Authorized Biller(s)
+7 ; IBSORT1 - Currently Selected Primary Sort
+8 ; IBSORT2 - Currently Selected Secondary Sort
+9 ; Output: IBAUTHB - Currently Selected Authorized Biller(s)
+10 ; IBSORT1 - Currently Selected Primary Sort
+11 ; IBSORT2 - Currently Selected Secondary Sort
+12 ; Returns: 1 - User exited without entering Sort/Filter criteria
+13 ; 0 Otherwise
+14 NEW IBDONE,IBSTOP,XX
+15 if '$DATA(REBUILD)
SET REBUILD=0
+16 DO FULL^VALM1
+17 ; Authorized Biller filter
DO AUTHB(.IBAUTHB,.IBDONE)
+18 if IBDONE
QUIT 1
+19 ; Primary Sort
SET IBSORT1=$$SORTSET^IBRFIWLA(1,"L","",.IBDONE)
+20 if IBDONE
QUIT 1
+21 ;
+22 ; If the user selected Oldest or Newest Date Received as the primary sort,
+23 ; Do not ask for secondary sort
+24 ;I (IBSORT1="O")!(IBSORT1="N") S IBSORT2=0
+25 ;E D
+26 ;. S XX=$S(IBSORT1="O":"",1:"O") ; Default Secondary Sort
+27 ;. S IBSORT2=$$SORTSET^IBRFIWLA(2,XX,IBSORT1,.IBDONE) ; Secondary Sort
+28 ; Default Secondary Sort
SET XX=$SELECT(IBSORT1="O"!(IBSORT1="N"):"L",1:"O")
+29 ; Secondary Sort
SET IBSORT2=$$SORTSET^IBRFIWLA(2,XX,IBSORT1,.IBDONE)
+30 IF REBUILD
Begin DoDot:1
+31 ; Rebuild Sorted worklist
DO INIT
+32 ; Redisplay Header
DO HDR
+33 SET VALMBCK="R"
End DoDot:1
+34 if IBDONE
QUIT 1
+35 QUIT 0
+36 ;
AUTHB(IBAUTHB,IBDONE) ; Set the Authorized Biller
+1 ; Input: None
+2 ; Output: IBAUTHB - 1 - Authorized Biller(s) selected, 0 otherwise
+3 ; IBDONE - 1 if user quit or timed out
+4 ;
+5 KILL ^TMP("IBBIL",$JOB)
+6 NEW FIRST,DIC,DTOUT,DONE,DUOUT,X,Y
+7 SET FIRST=1
SET (DONE,IBDONE)=0
SET IBAUTHB=0
+8 FOR
Begin DoDot:1
+9 SET DIC="^VA(200,"
SET DIC(0)="AEQM"
+10 SET DIC("A")="Select "_$SELECT(FIRST:"",1:" Another ")_"Authorizing Biller: "
+11 if FIRST
SET DIC("A")=DIC("A")_"ALL// "
+12 DO ^DIC
+13 KILL DIC
+14 IF Y<0
SET DONE=1
QUIT
+15 IF $DATA(^TMP("IBBIL",$JOB,+Y))
Begin DoDot:2
+16 WRITE !!,*7,"This biller has already been selected",!
End DoDot:2
QUIT
+17 SET ^TMP("IBBIL",$JOB,+Y)=""
SET FIRST=0
SET IBAUTHB=1
End DoDot:1
if DONE
QUIT
+18 IF $DATA(DTOUT)!$DATA(DUOUT)
SET IBDONE=1
QUIT
+19 QUIT
+20 ;
BLD(IBAUTHB,IBSORT1,IBSORT2) ; Build the listman template body
+1 ; Input: IBAUTHB - Authorized Biller filter
+2 ; IBSORT1 - Primary Sort
+3 ; IBSORT2 - Secondary Sort
+4 ; ^TMP("IBRFIWLS",$J,A,B)=RFAIEN - See GETMSGS
+5 ; ^TMP("IBRIFWLIX",$J,CNT)=RFAIEN^### - Message Selector Index
+6 NEW AA,CNT,PFILTER,RFAIEN,S1,S2,XX,SFILTER
+7 ; Get Sorted/Filtered list
DO GETMSGS(.IBAUTHB,IBSORT1,IBSORT2)
+8 SET (CNT,VALMCNT)=0
SET (AA,PFILTER,S1)=""
+9 FOR
Begin DoDot:1
+10 SET AA=$ORDER(^TMP("IBRFIWLS",$JOB,AA))
+11 if AA=""
QUIT
+12 SET S1=""
+13 FOR
Begin DoDot:2
+14 SET S1=$ORDER(^TMP("IBRFIWLS",$JOB,AA,S1))
+15 if S1=""
QUIT
+16 SET S2=""
+17 FOR
Begin DoDot:3
+18 SET S2=$ORDER(^TMP("IBRFIWLS",$JOB,AA,S1,S2))
+19 if S2=""
QUIT
+20 SET RFAIEN=""
+21 FOR
Begin DoDot:4
+22 SET RFAIEN=$ORDER(^TMP("IBRFIWLS",$JOB,AA,S1,S2,RFAIEN))
+23 if RFAIEN=""
QUIT
+24 SET XX=$SELECT(AA="~":S1,1:0)
+25 DO BLDONEM(.VALMCNT,.CNT,RFAIEN,IBSORT1,.PFILTER,XX,S1,IBSORT2,S2,.SFILTER)
End DoDot:4
if RFAIEN=""
QUIT
End DoDot:3
if S2=""
QUIT
End DoDot:2
if S1=""
QUIT
End DoDot:1
if AA=""
QUIT
+26 QUIT
+27 ;
GETMSGS(IBAUTHB,IBSORT1,IBSORT2) ; Retrieves the RFAI Messages filtering
+1 ; by Authorized Biller in sorted order
+2 ; Input: IBAUTHB - Authorized Biller filter
+3 ; IBSORT1 - Primary Sort
+4 ; IBSORT2 - Secondary Sort
+5 ; Output: ^TMP("IBRFIWLS",$J,A,B,C,IEN)=""- Where:
+6 ; A - ~ - Bad Record Indicator
+7 ; 1 - No Authorized Biller filter
+8 ; Authorized Biller Name
+9 ; B - When A=0 - Bad Data Type
+10 ; Otherwise Primary sort value
+11 ; C - When A=0 - 0
+12 ; Otherwise Secondary Sort value OR
+13 ; 0 if no secondary sort
+14 ; IEN - IEN of the RFAI Message
+15 NEW CNT,IBIFN,PIEN,RAUTHBV,RFAIEN,SKIP,STATUS,XX
+16 SET CNT=0
SET RFAIEN=""
+17 FOR
Begin DoDot:1
+18 SET RFAIEN=$ORDER(^IBA(368,"E",0,RFAIEN))
+19 if RFAIEN=""
QUIT
+20 SET SKIP=0
+21 ; Quit if bad data error
if $$BADREQ(RFAIEN)
QUIT
+22 ; No Authorized Biller filter or primary sort
if '$GET(IBAUTHB)
SET RAUTHBV=1
+23 if IBSORT1="B"
SET RAUTHBV=""
+24 ;
+25 ; Filtering on Authorized Biller
+26 IF $GET(RAUTHBV)'=1
Begin DoDot:2
+27 ; IEN of Bill/Claims Authorizer
SET RAUTHBV=$$GET1^DIQ(399,IBIFN,11,"I")
+28 ;
+29 ; If Request MRA bill, pull the MRA Requestor user instead
+30 IF 'RAUTHBV
Begin DoDot:3
+31 ; Status of Bill
SET STATUS=$$GET1^DIQ(399,IBIFN,.13,"I")
+32 ; Not a Request MRA Bill
if STATUS'=2
QUIT
+33 ; MRA Requestor
SET RAUTHBV=$$GET1^DIQ(399,IBIFN,8,"I")
End DoDot:3
+34 ;
+35 ; Not a selected Authorized Biller
+36 IF $GET(IBAUTHB)
IF '$DATA(^TMP("IBBIL",$JOB,RAUTHBV))
SET SKIP=1
QUIT
+37 ; New Person NAME
SET RAUTHBV=$$GET1^DIQ(200,RAUTHBV,.01)
End DoDot:2
if SKIP
QUIT
+38 ;
+39 ; Get One Message
DO GETONEM(RFAIEN,RAUTHBV,IBSORT1,IBSORT2,IBIFN)
End DoDot:1
if RFAIEN=""
QUIT
+40 QUIT
+41 ;
BADREQ(RFAIEN) ; Marks a record that contains missing or incorrect
+1 ; critical data
+2 ; Input: RFAIEN - IEN of the record containing bad data
+3 ; ^TMP("IBRFIWLS",$J,-1,TYPE,0)=RFAIEN potentially
+4 ; Returns: 1 - Bad data found, 0 otherwise
+5 NEW PIEN,XX
+6 ; IEN for Bill/Claims file
SET IBIFN=$$GET1^DIQ(368,RFAIEN,111.01,"I")
+7 IF IBIFN=""
Begin DoDot:1
+8 SET ^TMP("IBRFIWLS",$JOB,"~",1,0,RFAIEN)=""
End DoDot:1
QUIT 1
+9 ;
+10 ; Patient IEN
SET PIEN=$$GET1^DIQ(368,RFAIEN,109.01,"I")
+11 IF PIEN=""
Begin DoDot:1
+12 ; Patient Bill/Mismatch
SET ^TMP("IBRFIWLS",$JOB,"~",2,0,RFAIEN)=""
End DoDot:1
QUIT 1
+13 QUIT 0
+14 ;
GETONEM(RFAIEN,RAUTHB,IBSORT1,IBSORT2,IBIFN) ; Get the Data for a specified
+1 ; RFAI Message
+2 ; Input: RFAIEN - IEN of the selected RFAI Message
+3 ; RAUTHB - Authorized Biller Name
+4 ; 1 - No Authorized Biller filter
+5 ; IBSORT1 - Primary Sort Code
+6 ; IBSORT2 - Secondary Sort Code
+7 ; IBIFN - IEN for the associated Bill/Claims record
+8 ; Output: ^TMP("IBRFIWLS",$J,A,B,C)=IEN - Where:
+9 ; A - 0 - Bad Record Indicator
+10 ; 1 - No Authorized Biller filter or it passed the filter
+11 ; B - When A=0 - Bad Data Type
+12 ; Otherwise Primary sort value
+13 ; C - When A=0 - 0
+14 ; Otherwise Secondary Sort value OR
+15 ; 0 if no secondary sort
+16 ; IEN - IEN of the RFAI Message
+17 NEW FIELDP,FIELDS,RDATE
+18 SET (FIELDP,FIELDS)=""
+19 ;
+20 ; Determine the Primary Sort field
+21 ; Request date/tinme
if (IBSORT1="N")!(IBSORT1="O")
SET FIELDP=100.02
+22 ; Response Date
IF FIELDP=""
IF ((IBSORT1="E")!(IBSORT1="D"))
Begin DoDot:1
+23 SET FIELDP=112.01
End DoDot:1
+24 ; Insurance Company Name
IF FIELDP=""
IF IBSORT1="I"
SET FIELDP=101.01
+25 ; Patient Name
IF FIELDP=""
IF IBSORT1="P"
SET FIELDP=109.01
+26 ; LOINC Code
IF FIELDP=""
IF IBSORT1="L"
SET FIELDP=122.03
+27 ; Authorized Biller
if FIELDP=""
SET FIELDP=-1
+28 ;
+29 ; Determine the Secondary Sort field
+30 ; No Secondary Sort
IF IBSORT2=""
SET FIELDS=-2
+31 ; Transmission Date
if (IBSORT2="N")!(IBSORT2="O")
SET FIELDS=100.03
+32 ; Request Due Date
IF FIELDS=""
IF ((IBSORT2="E")!(IBSORT2="D"))
Begin DoDot:1
+33 SET FIELDS=112.01
End DoDot:1
+34 ; Insurance Company Name
IF FIELDS=""
IF IBSORT2="I"
SET FIELDS=101.01
+35 ; Patient Name
IF FIELDS=""
IF IBSORT2="P"
SET FIELDS=109.01
+36 ; LOINC Code
IF FIELDS=""
IF IBSORT2="L"
SET FIELDS=122.03
+37 ; Authorized Biller
if FIELDS=""
SET FIELDS=-1
+38 ;
+39 ; Get the sort values
+40 ;S RDATE=$S(IBSORT1="N":1,IBSORT1="E":1,1:2)
+41 SET RDATE=$SELECT(IBSORT1="O":1,IBSORT1="D":1,1:2)
+42 ; Get Primary sort value
SET FIELDP=$SELECT(IBSORT1="B":RAUTHB,1:$$GETFVAL(FIELDP,RFAIEN,RAUTHB,RDATE))
+43 ; don't need times for sort
IF ".D.O.N.E."[("."_IBSORT1_".")
SET FIELDP=$PIECE(FIELDP,".")
+44 ;S RDATE=$S(IBSORT2="N":1,IBSORT2="E":1,1:2)
+45 SET RDATE=$SELECT(IBSORT2="O":1,IBSORT2="D":1,1:2)
+46 ; Get Secondary sort value
SET FIELDS=$$GETFVAL(FIELDS,RFAIEN,RAUTHB,RDATE)
+47 IF ".D.O.N.E."[("."_IBSORT2_".")
SET FIELDS=$PIECE(FIELDS,".")
+48 ; no secondary, avoild subscript error
IF IBSORT2=""!(IBSORT2=0)
SET FIELDS=0
+49 ;
+50 ; Finally set the sorted record into the list
+51 SET ^TMP("IBRFIWLS",$JOB,$SELECT(RAUTHB="~":"~",1:1),FIELDP,FIELDS,RFAIEN)=""
+52 QUIT
+53 ;
GETFVAL(FIELD,RFAIEN,RAUTHB,RDATE,RETNA) ;EP
+1 ; Returns the external value of the specified field
+2 ; Input: FIELD - # of the field to be retrieved
+3 ; NOTE: if this number is >100 AND no value is found, then
+4 ; the value of FIELD-100 will be returned which is
+5 ; the raw value received from the HL7 message.
+6 ; The following are 'special' FIELD values:
+7 ; -1 - RAUTHB variable is used
+8 ; -2 - 0 is returned
+9 ; -3 - Last 4 digits of the SSN are returned
+10 ; -4 - Current balance is returned
+11 ; FIELD
+12 ; RFAIEN - IEN of the RFAI Message (file 368) to retrieve values from
+13 ; RAUTHB - IEN of the Authorized Billed (special case)
+14 ; Optional, defaults to ""
+15 ; RDATE - 1 - Return negative internal date (used for sorting)
+16 ; 2 - Return internal date (used for sorting)
+17 ; 3 - Force Date conversion to DD/MM/YY
+18 ; 0 - Return external date (DD/MM/YY)
+19 ; Optional, defaults to 0
+20 ; RETNA - 2 - Return null if field does not contain a value
+21 ; 1 - Return '*NA*' if field does not contain a value
+22 ; 0 - Return '0'
+23 ; Optional, defaults to 0
+24 ; Returns: External Field value
+25 NEW VAL,VAL2,XX,YY
+26 if '$DATA(RAUTHB)
SET RAUTHB=0
+27 if '$DATA(RDATE)
SET RDATE=0
+28 if '$DATA(RETNA)
SET RETNA=0
+29 IF $FIND(FIELD,",")
Begin DoDot:1
+30 NEW FILE
+31 SET FILE=$PIECE(FIELD,",")
SET FIELD=$PIECE(FIELD,",",2)
+32 SET VAL=$$GET1^DIQ(FILE,RFAIEN,FIELD)
+33 IF RDATE=3
IF VAL]""
SET VAL2=$$GET1^DIQ(FILE,RFAIEN,FIELD,"I")
if VAL2]""
SET VAL=$$FMTE^XLFDT(VAL2,"2DZ")
+34 ; Return raw value
IF VAL=""
Begin DoDot:2
+35 IF FILE=368.0113
SET FILE=368.013
+36 IF FILE=368.0121
SET FILE=368.021
+37 IF FILE=368.12199
SET FILE=368.2199
+38 SET VAL=$$GET1^DIQ(FILE,RFAIEN,FIELD)
+39 IF VAL=""
SET VAL=$SELECT(RETNA=1:"*NA*",RETNA=2:"",1:0)
+40 QUIT
End DoDot:2
+41 QUIT
End DoDot:1
QUIT VAL
+42 ; Authorized Biller Name
IF FIELD=-1
QUIT $$GET1^DIQ(200,RAUTHB,.01)
+43 IF FIELD=-2
QUIT 0
+44 ; Last 4 digits of SSN
IF FIELD=-3
Begin DoDot:1
+45 ; Patient Pointer
SET VAL=$$GET1^DIQ(368,RFAIEN,109.01,"I")
+46 IF VAL=""
SET VAL=$SELECT(RETNA=1:"*NA*",RETNA=2:"",1:0)
QUIT
+47 ; SSN number
SET VAL=$$GET1^DIQ(2,VAL,.09)
+48 IF VAL=""
SET VAL=$SELECT(RETNA=1:"*NA*",RETNA=2:"",1:0)
QUIT
+49 SET VAL=$EXTRACT(VAL,6,9)
End DoDot:1
QUIT VAL
+50 ; Current Balance
IF FIELD=-4
Begin DoDot:1
+51 ; Bill pointer
SET VAL=$$GET1^DIQ(368,RFAIEN,111.01,"I")
+52 IF VAL=""
SET VAL=$SELECT(RETNA=1:"*NA*",RETNA=2:"",1:0)
QUIT
+53 ; Current Balance
SET XX=$$GET1^DIQ(399,VAL,201,"I")
+54 ; Offset
SET YY=$$GET1^DIQ(399,VAL,202,"I")
+55 SET VAL=XX-YY
End DoDot:1
QUIT VAL
+56 ;
+57 ; Get external value
SET VAL=$$GET1^DIQ(368,RFAIEN,FIELD,"E")
+58 ; add LOINC code description
IF FIELD=122.03
IF VAL'=""
SET VAL=VAL_": "_$$GET1^DIQ(368,RFAIEN,FIELD_":1")
+59 ; for LOINC codes not in LAB LOINC file
IF FIELD=122.03
IF VAL=""
SET VAL=$$GET1^DIQ(368,RFAIEN,22.03,"E")
+60 IF ((FIELD=100.02)!(FIELD=100.03)!(FIELD=.03)!(FIELD=122.04)!(FIELD=113.03)!(FIELD=112.01)!(FIELD=114.03)!(FIELD=114.04))
IF VAL'=""
Begin DoDot:1
+61 SET VAL=$$GET1^DIQ(368,RFAIEN,FIELD,"I")
+62 ; Return internal date
if RDATE=2
QUIT
+63 ; Return negative internal date
IF RDATE=1
SET VAL=VAL*-1
QUIT
+64 ; Return external date
SET VAL=$$FMTE^XLFDT(VAL,"2DZ")
End DoDot:1
QUIT VAL
+65 IF VAL'=""
QUIT VAL
+66 ; Return raw value
IF VAL=""
IF FIELD>100
Begin DoDot:1
+67 SET FIELD=FIELD-100
+68 SET VAL=$$GET1^DIQ(368,RFAIEN,FIELD)
End DoDot:1
+69 if VAL=""
SET VAL=$SELECT(RETNA=1:"*NA*",RETNA=2:"",1:0)
+70 QUIT VAL
+71 ;
BLDONEM(VALMCNT,MSGCNT,RFAIEN,IBSORT1,PFILTER,BTYPE,PSORT,IBSORT2,SSORT,SFILTER) ; Build one Message into
+1 ; the listman display
+2 ; Input: VALMCNT - Current Line of the display being
+3 ; (re)built
+4 ; MSGCNT - Current Message Number
+5 ; RFAIEN - IEN of the message to be displayed
+6 ; IBSORT1 - Primary Sort Code
+7 ; PFILTER - Current Filter line value
+8 ; BTYPE - 0 - Not a bad record
+9 ; Otherwise, type of bad record (1-2)
+10 ; PSORT - External value of primary sort data
+11 ; IBSORT2 - Secondary Sort Code
+12 ; SSORT - External value of secondary sort data
+13 ;
+14 ; Output: VALMCNT - Updated Line of the display being
+15 ; MSGCNT - Updated Message Number
+16 ; PFILTER - Update Filter line Value
+17 ; ^TMP("IBRIFWLIX",$J,CNT) - Message Selector Index
+18 NEW LINE,VAL,XX
+19 ; Display Bad Record Type
IF BTYPE
Begin DoDot:1
+20 ; Same as previous line
if PFILTER=BTYPE
QUIT
+21 SET VALMCNT=VALMCNT+1
SET PFILTER=BTYPE
+22 IF BTYPE=1
Begin DoDot:2
+23 SET LINE="Messages with an invalid Bill Number"
End DoDot:2
+24 IF BTYPE=2
Begin DoDot:2
+25 SET LINE="Messages with Patient/Bill Mismatch"
End DoDot:2
+26 DO SET^VALM10(VALMCNT,LINE,VALMCNT)
End DoDot:1
+27 IF 'BTYPE
Begin DoDot:1
+28 IF ".N.O.E.D."[("."_IBSORT1_".")
SET PSORT=$TRANSLATE(PSORT,"-")
SET PSORT=$$FMTE^XLFDT(PSORT,"2DZ")
+29 SET LINE=$SELECT(IBSORT1="I":"Insurance Company Name: ",IBSORT1="P":"Patient Name: ",IBSORT1="B":"Authorizing Biller: ",IBSORT1="L":"LOINC Code: ",IBSORT1="E"!(IBSORT1="D"):"Date Due: ",1:"Date Received: ")_PSORT
+30 IF PFILTER'=LINE
Begin DoDot:2
+31 SET VALMCNT=VALMCNT+1
SET PFILTER=LINE
+32 DO SET^VALM10(VALMCNT,LINE,VALMCNT)
+33 SET SFILTER=""
End DoDot:2
+34 IF $GET(IBSORT2)]""
IF $GET(IBSORT2)'=0
Begin DoDot:2
+35 IF ".N.O.E.D."[("."_IBSORT2_".")
SET SSORT=$TRANSLATE(SSORT,"-")
SET SSORT=$$FMTE^XLFDT(SSORT,"2DZ")
+36 SET LINE=" "_$SELECT(IBSORT2="I":"Insurance Company Name: ",IBSORT2="P":"Patient Name: ",IBSORT2="B":"Authorizing Biller: ",IBSORT2="L":"LOINC Code: ",IBSORT2="E"!(IBSORT2="D"):"Date Due: ",1:"Date Received: ")_SSORT
+37 IF SFILTER'=LINE
Begin DoDot:3
+38 SET VALMCNT=VALMCNT+1
SET SFILTER=LINE
+39 DO SET^VALM10(VALMCNT,LINE,VALMCNT)
End DoDot:3
End DoDot:2
End DoDot:1
+40 SET CNT=CNT+1
SET VALMCNT=VALMCNT+1
+41 SET ^TMP("IBRFIWLIX",$JOB,CNT)=RFAIEN
+42 ; Message #
SET LINE=$$SETL("",MSGCNT,"",1,4)
+43 ; External Bill #
SET VAL=$$GETFVAL(111.01,RFAIEN,"",0,2)
+44 ; Review Status
SET XX=$$GET1^DIQ(368,RFAIEN,200.04,"I")
+45 if XX
SET VAL=VAL_"*"
+46 SET LINE=$$SETL(LINE,VAL,"",5,8)
+47 DO SET^VALM10(VALMCNT,LINE,VALMCNT)
+48 ; Ins. Co. Name
SET VAL=$$GETFVAL(101.01,RFAIEN,"",0,2)
+49 SET LINE=$$SETL(LINE,VAL,"",15,16)
+50 DO SET^VALM10(VALMCNT,LINE,VALMCNT)
+51 ; Patient Name
SET VAL=$$GETFVAL(109.01,RFAIEN,"",0,2)
+52 SET LINE=$$SETL(LINE,VAL,"",33,20)
+53 DO SET^VALM10(VALMCNT,LINE,VALMCNT)
+54 ; SSN
SET VAL=$$GETFVAL(-3,RFAIEN,"",0,2)
+55 SET LINE=$$SETL(LINE,VAL,"",56,4)
+56 DO SET^VALM10(VALMCNT,LINE,VALMCNT)
+57 ; Service Date
SET VAL=$$GETFVAL(114.03,RFAIEN,"",2,2)
+58 IF VAL'=""
SET VAL=$$FMTE^XLFDT(VAL,"2Z")
+59 SET LINE=$$SETL(LINE,VAL,"",61,8)
+60 DO SET^VALM10(VALMCNT,LINE,VALMCNT)
+61 ; Current Balance
SET VAL=$$GETFVAL(-4,RFAIEN,"",0,2)
+62 SET VAL=$JUSTIFY("$"_$FNUMBER(VAL,"",2),9)
+63 SET LINE=$$SETL(LINE,VAL,"",71,9)
+64 DO SET^VALM10(VALMCNT,LINE,VALMCNT)
+65 ;
+66 ; Selection Index - RFAIEN is pointer to file 368, VALMCNT points to detailed entry in worklist ^TMP
SET ^TMP("IBRFIWLIX",$JOB,CNT)=RFAIEN_U_VALMCNT
+67 ;I IBSORT1'="L" D
+68 ;. S VALMCNT=VALMCNT+1
+69 ;. S VAL=$$GETFVAL(122.03,RFAIEN,"",0,2) ; LOINC Code + Description
+70 ;. I VAL'="" D
+71 ;. . S LINE=$$SETL("",VAL,"",6,80)
+72 ;. . D SET^VALM10(VALMCNT,LINE,VALMCNT)
+73 ;
+74 SET VALMCNT=VALMCNT+1
+75 ; LOINC Code + Description
SET VAL=$$GETFVAL(122.03,RFAIEN,"",0,2)
+76 IF VAL'=""
Begin DoDot:1
+77 SET LINE=$$SETL("",VAL,"",5,80)
+78 DO SET^VALM10(VALMCNT,LINE,VALMCNT)
End DoDot:1
+79 QUIT
+80 ;
SETL(LINE,DATA,LABEL,COL,LNG) ; Creates a line of data to be set into the body
+1 ; of the worklist
+2 ; Input: LINE - Current line being created
+3 ; DATA - Information to be added to the end of the current line
+4 ; LABEL - Label to describe the information being added
+5 ; COL - Column position in line to add information add
+6 ; LNG - Maximum length of data information to include on the line
+7 ; Returns: Line updated with added information
+8 SET LINE=LINE_$JUSTIFY("",(COL-$LENGTH(LABEL)-$LENGTH(LINE)))_LABEL_$EXTRACT(DATA,1,LNG)
+9 QUIT LINE
+10 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 SET VALMSG="* Indicates review in progress"
+3 QUIT
+4 ;
SMSG ;EP
+1 ; Protocol action to select an RFI message to be worked
+2 ; Input: ^TMP("IBRFIWLIX",$J,CNT)=RFAIEN
+3 NEW RFAIEN,RFAIDET,RFAIDHDR
+4 SET VALMBCK="R"
+5 DO FULL^VALM1
+6 SET RFAIEN=$$SELMSG^IBRFIWLA("Select Message")
+7 IF RFAIEN=""
SET VALMSG="|* Review in progress | Enter ?? for more actions|"
QUIT
+8 SET (RFAIDET,RFAIDHDR)=""
+9 IF $PIECE(RFAIEN,U,2)
Begin DoDot:1
+10 SET RFAIDET=$PIECE($GET(RFAIEN),U,2)
+11 IF $GET(RFAIDET)
SET RFAIDET=$EXTRACT($GET(^TMP("IBRFIWL",$JOB,+$GET(RFAIDET),0)),6,999)
+12 SET RFAIDHDR=$EXTRACT($GET(VALMCAP),6,999)
End DoDot:1
+13 SET RFAIEN=$PIECE(RFAIEN,U)
+14 ;
+15 ; Show the detail of the message
DO EN^IBRFIWL1(RFAIEN,RFAIDET,RFAIDHDR)
+16 ; Rebuild the list
DO INIT
+17 QUIT
+18 ;
EXIT ; -- exit code
+1 KILL IBAUTH,IBSORT1,IBSORT2
+2 KILL ^TMP("IBBIL",$JOB),^TMP("IBRFIWL",$JOB),^TMP("IBRFIWLS",$JOB),^TMP("IBRFIWLIX",$JOB)
+3 DO CLEAN^VALM10
+4 QUIT
