IBRFIWL1 ;ALB/FA/JWS - RFAI Message Detail Worklist; 02-SEP-2015
;;2.0;INTEGRATED BILLING;**547**;21-MAR-94;Build 119
;;Per VA Directive 6402, this routine should not be modified.
;;
;
EN(RFAIEN,RFAIDET,RFAIDHDR) ; Main entry point
; Displays the selected RFAI Message detail
; Input: RFAIEN - IEN of the selected RFAI Message
; RFAIDET - The detailed line from the initial worklist to show what entry is being worked on
; RFAIDHDR - The header for said details mentioned above
N IBIFN,LOINC
S IBIFN=$$GET1^DIQ(368,RFAIEN,111.01,"I") ; IEN for Bill/Claims file
D EN^VALM("IBRFI 277 DETAIL WL")
I $D(IBFASTXT) S VALMBCK="Q"
Q
;
HDR ;EP
; Listman Template action to display Worklist header information
; Input: RFAIEN - IEN of the selected Message
; RFAIDET - The detailed line from the initial worklist to show what entry is being worked on
; RFAIDHDR - The header for said details mentioned above
; Output: Header information for the Selected Message
;
N RBY,RDATE,XX
S XX=$$GET1^DIQ(368,RFAIEN,200.04,"I")
I XX D
. S RDATE=$$GET1^DIQ(368,RFAIEN,200.05,"I")
. S RDATE=$$FMTE^XLFDT(RDATE,"2DZ")
. S RBY=$$GET1^DIQ(368,RFAIEN,200.06)
. S XX="Review Status: Review in Process By: "_RBY_" on "_RDATE
E S XX="Review Status: Not Being Reviewed"
S VALMHDR(1)=$G(RFAIDHDR)
S VALMHDR(2)=$G(RFAIDET)
S VALMHDR(3)=XX
Q
;
INIT ;EP
; Listman Template action to initialize the template
; Input: RFAIEN - IEN of the selected Message
;
K ^TMP("IBRFIWL1",$J)
D BLD
Q
;
BLD ; Creates the body of the worklist
; Input: IBIFN - IEN of the Bill/Claim (file 399) of the selected message
; RFAIEN - IEN of the selected Message
;
N ELINEL,ELINER,SLINE
S SLINE=1
D BLDISRC(RFAIEN,SLINE,.ELINEL) ; Build Information Source section
D BLDCLEV(RFAIEN,ELINEL,.ELINEL) ; Build Claim Level Status section
D BLDSLI^IBRFIWLA(RFAIEN,ELINEL,.ELINEL) ; Build Service Line Info section
D BLDCOM^IBRFIWLA(RFAIEN,ELINEL,.ELINEL) ; Build Comment section
S VALMCNT=ELINEL-1
Q
;
BLDISRC(RFAIEN,SLINE,ELINE) ; Build the Information Source Section
; Input: RFAIEN - IEN of the selected Message
; SLINE - Starting Section Line Number
; ELINE - Current Ending Section Line Number
; Output: ELINE - Updated Ending Section Line Number
;
N XX,YY,ZZ,WW
S ELINE=$$SETN("Information Source",SLINE,1,1)
S XX=$$GETFVAL^IBRFIWL(101.01,RFAIEN,"",0,2)
S ELINE=$$SET("Payer Name: ",XX,ELINE,1)
S XX=$$GETFVAL^IBRFIWL(1.03,RFAIEN,"",0,2)
S ELINE=$$SET("Payer Contact Name: ",XX,ELINE,1)
S XX=$$GETFVAL^IBRFIWL(3.01,RFAIEN,"",0,2) ; Contact 1
S YY=$$GETFVAL^IBRFIWL(102.01,RFAIEN,"",0,2) ; Contact 1 Type
I (YY="FX"!(YY="TE")),$$HLPHONE^HLFNC(XX)]"" S XX=$$HLPHONE^HLFNC(XX)
S XX=$S(XX="":"",YY="FX":XX_"(Fax)",YY="TE":XX_"(Tel)",YY="EX":XX_"(Ext)",YY="EM":"(Email)",YY="UR":"(url)",1:XX)
S YY=$$GETFVAL^IBRFIWL(26.01,RFAIEN,"",0,2) I YY]"" S XX=XX_" EXT: "_YY
S ELINE=$$SET("Payer Contact #1: ",XX,ELINE,1) ;3.01 add (Fax) or (Tel) when
;
S XX=$$GETFVAL^IBRFIWL(4.01,RFAIEN,"",0,2) ; Contact 2
I XX'="" D
. S YY=$$GETFVAL^IBRFIWL(102.02,RFAIEN,"",0,2) ; Contact 2 Type
. I (YY="FX"!(YY="TE")),$$HLPHONE^HLFNC(XX)]"" S XX=$$HLPHONE^HLFNC(XX)
. S XX=$S(XX="":"",YY="FX":XX_"(Fax)",YY="TE":XX_"(Tel)",YY="EX":XX_"(Ext)",YY="EM":"(Email)",YY="UR":"(url)",1:XX)
. S YY=$$GETFVAL^IBRFIWL(27.01,RFAIEN,"",0,2) I YY]"" S XX=XX_" EXT: "_YY
. S ELINE=$$SET("Payer Contact #2: ",XX,ELINE,1)
;
S XX=$$GETFVAL^IBRFIWL(5.01,RFAIEN,"",0,2) ; Contact 3
I XX'="" D
. S YY=$$GETFVAL^IBRFIWL(102.03,RFAIEN,"",0,2) ; Contact 3 Type
. I (YY="FX"!(YY="TE")),$$HLPHONE^HLFNC(XX)]"" S XX=$$HLPHONE^HLFNC(XX)
. S XX=$S(XX="":"",YY="FX":XX_"(Fax)",YY="TE":XX_"(Tel)",YY="EX":XX_"(Ext)",YY="EM":"(Email)",YY="UR":"(url)",1:XX)
. S YY=$$GETFVAL^IBRFIWL(28.01,RFAIEN,"",0,2) I YY]"" S XX=XX_" EXT: "_YY
. S ELINE=$$SET("Payer Contact #3: ",XX,ELINE,1)
;
S XX=$$GETFVAL^IBRFIWL(15.01,RFAIEN,"",0,2)
S ELINE=$$SET("Payer Response Contact Name: ",XX,ELINE,1)
S XX=$$GETFVAL^IBRFIWL(17.01,RFAIEN,"",0,2) ; Response Contact 1
S YY=$$GETFVAL^IBRFIWL(16.01,RFAIEN,"",0,2) ; Response Contact 1 Type
I XX]"",(YY="FX"!(YY="TE")),$$HLPHONE^HLFNC(XX)]"" S XX=$$HLPHONE^HLFNC(XX)
S XX=$S(XX="":"",YY="FX":XX_"(Fax)",YY="TE":XX_"(Tel)",YY="EX":XX_"(Ext)",YY="EM":"(Email)",YY="UR":"(url)",1:XX)
S YY=$$GETFVAL^IBRFIWL(29.01,RFAIEN,"",0,2) I YY]"" S XX=XX_" EXT: "_YY
S ELINE=$$SET("Payer Response Contact #1: ",XX,ELINE,1) ;5.01 skip when null
;
S XX=$$GETFVAL^IBRFIWL(18.01,RFAIEN,"",0,2) ; Response Contact 2
I XX'="" D
. S YY=$$GETFVAL^IBRFIWL(16.02,RFAIEN,"",0,2) ; Contact 2 Type
. I (YY="FX"!(YY="TE")),$$HLPHONE^HLFNC(XX)]"" S XX=$$HLPHONE^HLFNC(XX)
. S XX=$S(XX="":"",YY="FX":XX_"(Fax)",YY="TE":XX_"(Tel)",YY="EX":XX_"(Ext)",YY="EM":"(Email)",YY="UR":"(url)",1:XX)
. S YY=$$GETFVAL^IBRFIWL(30.01,RFAIEN,"",0,2) I YY]"" S XX=XX_" EXT: "_YY
. S ELINE=$$SET("Payer Response Contact #2: ",XX,ELINE,1)
;
S XX=$$GETFVAL^IBRFIWL(19.01,RFAIEN,"",0,2) ; Response Contact 3
I XX'="" D
. S YY=$$GETFVAL^IBRFIWL(16.03,RFAIEN,"",0,2) ; Contact 3 Type
. I (YY="FX"!(YY="TE")),$$HLPHONE^HLFNC(XX)]"" S XX=$$HLPHONE^HLFNC(XX)
. S XX=$S(XX="":"",YY="FX":XX_"(Fax)",YY="TE":XX_"(Tel)",YY="EX":XX_"(Ext)",YY="EM":"(Email)",YY="UR":"(url)",1:XX)
. S YY=$$GETFVAL^IBRFIWL(31.01,RFAIEN,"",0,2) I YY]"" S XX=XX_" EXT: "_YY
. S ELINE=$$SET("Payer Response Contact #3: ",XX,ELINE,1)
;
S XX=$$GETFVAL^IBRFIWL(20.01,RFAIEN,"",0,2) ; Response Cont Addr Line 1
S ELINE=$$SET("Payer Address: ",XX,ELINE,1)
S XX=$$GETFVAL^IBRFIWL(20.02,RFAIEN,"",0,2) ; Response Cont Addr Line 2
I XX]"" S ELINE=$$SET(" ",XX,ELINE,1)
S XX=$$GETFVAL^IBRFIWL(20.03,RFAIEN,"",0,2) ; Response Cont City
S YY=$$GETFVAL^IBRFIWL(120.04,RFAIEN,"",0,2) ; Response Cont State
S ZZ=$$GETFVAL^IBRFIWL(120.05,RFAIEN,"",0,2) ; Response Cont ZIP
S WW=$$GETFVAL^IBRFIWL(120.06,RFAIEN,"",0,2) ; Response Cont Country
S XX=$S(((XX'="")!(YY'="")!(ZZ'="")!(WW]"")):XX_", "_YY_" "_ZZ_" "_WW,1:"")
S ELINE=$$SET("",XX,ELINE,1)
;
S XX=$$GETFVAL^IBRFIWL(11.02,RFAIEN,"",0,2) ; Patient Claim Control #
S ELINE=$$SET("Payer Claim Control #: ",XX,ELINE,1)
Q
;
BLDCLEV(RFAIEN,SLINE,ELINE) ; Build the Claim Level Status Section
; Input: RFAIEN - IEN of the selected Message
; SLINE - Starting Section Line Number
; ELINE - Current Ending Section Line Number
; Output: ELINE - Updated Ending Section Line Number
;
N XX,YY,ZZ,XC0,RFAIEN1,IEN399,ARY,LN,I
S ELINE=$$SET("",$J("",40),SLINE,1) ; Spacing Blank Line
S ELINE=$$SETN("Claim Level Status",ELINE,1,1)
S XX=$$GETFVAL^IBRFIWL(111.01,RFAIEN,"",0,2)
S ELINE=$$SET("Patient Control #: ",XX,ELINE,1)
S XX=$$GETFVAL^IBRFIWL(114.03,RFAIEN,"",3,2)
S YY=$$GETFVAL^IBRFIWL(114.04,RFAIEN,"",3,2)
I XX]"" S XX=XX_$S(YY]"":"-"_YY,1:"")
I XX="" S XX=$$GETFVAL^IBRFIWL(14.05,RFAIEN,"",0,2)
S ELINE=$$SET("Date of Service: ",XX,ELINE,1)
S XX=$$GETFVAL^IBRFIWL(11.03,RFAIEN,"",0,2)
S ELINE=$$SET("Medical Record Number: ",XX,ELINE,1)
S XX=$$GETFVAL^IBRFIWL(10.01,RFAIEN,"",0,2)
S ELINE=$$SET("Member Identification Number: ",XX,ELINE,1)
;
S XX=$$GETFVAL^IBRFIWL(25.01,RFAIEN,"",0,2)
S IEN399=$$GETFVAL^IBRFIWL(111.01,RFAIEN,"",0,0)
I IEN399,$$INSPRF^IBCEF(IEN399) S ELINE=$$SET("Type of Service: ",XX,ELINE,1)
I IEN399,XX]"",'$$INSPRF^IBCEF(IEN399) S ELINE=$$SET("Type of Service: ",XX,ELINE,1)
I 'IEN399,XX]"" S ELINE=$$SET("Type of Service: ",XX,ELINE,1)
;
S XC0=0 F S XC0=$O(^IBA(368,RFAIEN,13,XC0)) Q:XC0'=+XC0 D
. S RFAIEN1=XC0_","_RFAIEN
. S XX=$$GETFVAL^IBRFIWL("368.0113,1.01",RFAIEN1,"",0,2)
. S YY=$$GET1^DIQ(368.0113,RFAIEN1,1.01,"I")
. I YY S ZZ=$$GET1^DIQ(368.001,YY_",",.02) I ZZ]"" S XX=XX_" - "_ZZ
. I XX'="" D
.. K ARY S LN=$$WRAP^IBRFIWLA(XX,64,79,.ARY)
.. S ELINE=$$SET("HCCS Category: ",ARY(1),ELINE,1)
.. F I=2:1:LN S:$D(ARY(LN)) ELINE=$$SET("",ARY(I),ELINE,1)
.;
. S XX=$$GETFVAL^IBRFIWL("368.0113,1.02",RFAIEN1,"",0,2)
. S YY=$$GET1^DIQ(368.0113,RFAIEN1,1.02,"I")
. I YY S ZZ=$P($$GET1^DIQ(368.0113,RFAIEN1,"1.02:80"),":") I ZZ]"" S XX=XX_" - "_ZZ
. S LN=$$WRAP^IBRFIWLA(XX,42,79,.ARY)
. S ELINE=$$SET("Add'l Info Request Modifier (LOINC): ",ARY(1),ELINE,1)
. F I=2:1:LN S:$D(ARY(LN)) ELINE=$$SET("",ARY(I),ELINE,1)
.;
. S XX=$$GETFVAL^IBRFIWL("368.0113,10.01",RFAIEN1,"",0,2)
. S YY=$$GET1^DIQ(368.0113,RFAIEN1,10.01,"I")
. I YY S ZZ=$$GET1^DIQ(368.001,YY_",",.02) I ZZ]"" S XX=XX_" - "_ZZ
. I XX'="" D
.. K ARY S LN=$$WRAP^IBRFIWLA(XX,62,77,.ARY)
.. S ELINE=$$SET(" HCCS Category: ",ARY(1),ELINE,1)
.. F I=2:1:LN S:$D(ARY(LN)) ELINE=$$SET(" ",ARY(I),ELINE,1)
.;
. S XX=$$GETFVAL^IBRFIWL("368.0113,10.02",RFAIEN1,"",0,2)
. S YY=$$GET1^DIQ(368.0113,RFAIEN1,10.02,"I")
. I YY S ZZ=$P($$GET1^DIQ(368.0113,RFAIEN1,"10.02:80"),":") I ZZ]"" S XX=XX_" - "_ZZ
. I XX'="" D
.. K ARY S LN=$$WRAP^IBRFIWLA(XX,48,77,.ARY)
.. S ELINE=$$SET(" Add'l Info Request Modifier: ",ARY(1),ELINE,1)
.. F I=2:1:LN S:$D(ARY(LN)) ELINE=$$SET(" ",ARY(I),ELINE,1)
.;
. S XX=$$GETFVAL^IBRFIWL("368.0113,11.01",RFAIEN1,"",0,2)
. S YY=$$GET1^DIQ(368.0113,RFAIEN1,11.01,"I")
. I YY S ZZ=$$GET1^DIQ(368.001,YY_",",.02) I ZZ]"" S XX=XX_" - "_ZZ
. I XX'="" D
.. K ARY S LN=$$WRAP^IBRFIWLA(XX,62,77,.ARY)
.. S ELINE=$$SET(" HCCS Category: ",ARY(1),ELINE,1)
.. F I=2:1:LN S:$D(ARY(LN)) ELINE=$$SET(" ",ARY(I),ELINE,1)
.;
. S XX=$$GETFVAL^IBRFIWL("368.0113,11.02",RFAIEN1,"",0,2)
. S YY=$$GET1^DIQ(368.0113,RFAIEN1,11.02,"I")
. I YY S ZZ=$P($$GET1^DIQ(368.0113,RFAIEN1,"11.02:80"),":") I ZZ]"" S XX=XX_" - "_ZZ
. I XX'="" D
.. K ARY S LN=$$WRAP^IBRFIWLA(XX,48,77,.ARY)
.. S ELINE=$$SET(" Add'l Info Request Modifier: ",ARY(1),ELINE,1)
.. F I=2:1:LN S:$D(ARY(LN)) ELINE=$$SET(" ",ARY(I),ELINE,1)
.;
. S XX=$$GETFVAL^IBRFIWL("368.0113,.02",RFAIEN1,"",3,2)
. S ELINE=$$SET("Status Information Effective Date: ",XX,ELINE,1)
S XX=$$GETFVAL^IBRFIWL(112.01,RFAIEN,"",0,2)
S ELINE=$$SET("Response Due Date: ",XX,ELINE,1)
Q
;
SET(LABEL,DATA,LINE,COL) ; Sets text into the body of the worklist
; Input: LABEL - Label text to set into the line
; DATA - Field Data to set into the line
; LINE - Line to set LABEL and DATA into
; COL - Starting column position in LINE to insert
; LABEL_DATA text
; Returns: LINE - Updated Line by 1
;
N IBY
S IBY=LABEL_DATA
D SET1(IBY,LINE,COL,$L(IBY))
S LINE=LINE+1
Q LINE
;
SETN(TITLE,LINE,COL,RV) ; Sets a field Section title into the body of the worklist
; Input: TITLE - Text to be used for the field Section Title
; LINE - Line number in the body to insert the field section title
; COL - Starting Column position to set Section Title into
; RV - 1 - Set Reverse Video, 0 or null dont use Reverse Video
; Optional, defaults to ""
; Returns: LINE - Line number increased by 1
;
N IBY
S IBY=" "_TITLE_" "
D SET1(IBY,LINE,COL,$L(IBY),$G(RV))
S LINE=LINE+1
Q LINE
;
SET1(TEXT,LINE,COL,WIDTH,RV) ; Sets the TMP array with body data
; Input: TEXT - Text to be set into the specified line
; LINE - Line to set TEXT into
; COL - Column of LINE to set TEXT into
; WIDTH - Width of the TEXT being set into line
; RV - 1 - Set Reverse Video, 0 or null dont use
; Reverse Video
; Optional, defaults to ""
; ^TMP("IBRFIWL1",$J) - Current ^TMP array
; Output: ^TMP("IBRFIWL1",$J) - Updated ^TMP array
;
N IBX
S IBX=$G(^TMP("IBRFIWL1",$J,LINE,0))
S IBX=$$SETSTR^VALM1(TEXT,IBX,COL,WIDTH)
D SET^VALM10(LINE,IBX)
D:$G(RV)'="" CNTRL^VALM10(LINE,COL,WIDTH,IORVON,IORVOFF)
Q
;
LOCKM(RFAIEN) ; Lock Selection of a specified Message
; Input: RFAIEN - IEN of the selected Message
; Returns: 1 - Lock was obtained, 0 otherwise
L +^IBA(368,RFAIEN):3
I '$T Q 0
Q 1
;
UNLOCKM(RFAIEN) ; Unlock Selection of a specified Message
; Input: RFAIEN - IEN of the selected Message
L -^IBA(368,RFAIEN)
Q
;
REVIEW ;EP
; Protocol action to Mark/Unmark the mesage as being In-Progress
; Input: RFAIEN - IEN of the selected Message
N DA,DIE,DR,DTOUT,NOW,X,XX,Y
S VALMBCK="R"
D FULL^VALM1
I '$$LOCKM(RFAIEN) D Q
. W !!,*7,"Someone else is reviewing the status of this message."
. W !,"Try again later."
. D PAUSE^VALM1
;
S DA=RFAIEN,DIE=368,NOW=$$NOW^XLFDT()
;S XX=$$GET1^DIQ(368,RFAIEN,200.04,"I"),XX=$S(XX=1:"In Progress",1:XX)
;S DR="200.04//"_XX_";200.05////"_NOW_";200.06////"_DUZ
S DR="200.04//REVIEW IN PROCESS"
D ^DIE
D UNLOCKM(RFAIEN)
D HDR
Q
;
; Protocol action to Enter/Edit the comment of the selected Message
; Input: RFAIEN - IEN of the selected Message
N CMTIEN
S VALMBCK="R"
D FULL^VALM1
I '$$LOCKM(RFAIEN) D Q
. W !!,*7,"Someone else is entering/editing this message."
. W !,"Try again later."
. D PAUSE^VALM1
;
S DA(1)=RFAIEN,DLAYGO=368.0201,DIC(0)="L",DIC="^IBA(368,"_DA(1)_",201,",X=$$NOW^XLFDT()
D FILE^DICN K DD,DO S (CMTIEN,DA)=+Y I DA<1 D UNLOCKM(RFAIEN) Q
S DIE="^IBA(368,"_DA(1)_",201,"
S DR=".02////"_DUZ_";.03" D ^DIE
I $G(^IBA(368,RFAIEN,201,CMTIEN,1,1,0))="" S DIK=DIE,DA(1)=RFAIEN,DA=CMTIEN D ^DIK
;. S DA=RFAIEN,DIE=368,NOW=$$NOW^XLFDT()
;. ;S XX=$$GET1^DIQ(368,RFAIEN,200.04,"I") I XX=1 Q
I $G(^IBA(368,RFAIEN,201,CMTIEN,1,1,0))'="" D
. N DA S DA=RFAIEN,DIE=368
. S DR="200.04//REVIEW IN PROCESS"
. D ^DIE
D UNLOCKM(RFAIEN)
D CLEAN^VALM10,INIT^IBRFIN
Q
;
REMOVE ;EP
; Protocol action to manually remove the selected Message
; Input: RFAIEN - IEN of the selected Message
N COM,XX
S VALMBCK="R"
D FULL^VALM1
I '$$LOCKM(RFAIEN) D Q
. W !!,*7,"Someone else is removing this message."
. W !,"Try again later."
. D PAUSE^VALM1
;
R2 ; Give final Warning
N DIK,DA,DLAYGO,DIC,X,Y,DIE,DR,CMTIEN,NOW
I '$$ASKYN("Are you Sure you want to Remove this Message") D Q
. D UNLOCKM(RFAIEN)
;
; create comment multiple
S DA(1)=RFAIEN,DLAYGO=368.0201,DIC(0)="L",DIC="^IBA(368,"_DA(1)_",201,",X=$$NOW^XLFDT()
D FILE^DICN K DD,DO S (CMTIEN,DA)=+Y I DA<1 D Q
. D UNLOCKM(RFAIEN)
. W !!,*7,"Unable to create comment multiple to remove entry!"
. D PAUSE^VALM1
;
; Add reason for removal
S DIE="^IBA(368,"_DA(1)_",201,",DR=".02////"_DUZ_";.03" D ^DIE K DR,DIE
;
; be sure user enters a comment before actually removing the entry
I $G(^IBA(368,RFAIEN,201,CMTIEN,1,1,0))=""!(X="^") D G R2
. W !!,*7,"Please enter the reason this entry is being removed. A comment is mandatory!"
. ; Must delete new comment multiple if they don't enter comment
. S DIK="^IBA(368,"_DA(1)_",201," D ^DIK K DIK
. D PAUSE^VALM1
;
; if comment entered, update review status
N DA,DIE S DA=RFAIEN,DIE=368,NOW=$$NOW^XLFDT()
I $G(^IBA(368,RFAIEN,201,CMTIEN,1,1,0))'="" D
. S XX=$$GET1^DIQ(368,RFAIEN,200.04,"I") I XX=1 Q
. S DR="200.04////1"
. D ^DIE K DR
;
; Set deleted flag and date
S DR="200.01////1;200.02////"_NOW_";200.03////"_DUZ
D ^DIE K DR
;
D UNLOCKM(RFAIEN)
S VALMBCK="Q"
Q
;
TPJI ;EP
; Protocol action to do Third Party Joint Inquiry for the selected message
; Input: IBIFN - IEN for Bill/Claim of the selected message
S VALMBCK="R"
D FULL^VALM1
D TPJI1^IBCECOB2(IBIFN)
Q
;
ASKYN(PROMPT,DEFAULT) ; Ask a yes/no question
; Input: PROMPT - Question to be asked
; DEFAULT - Default Answer
; 1 - YES, 0 - NO
; Optional, defaults to 0
; Returns: 1 - User answered YES, 0 othewise
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S:$G(DEFAULT)'=1 DEFAULT=0
S DIR(0)="Y",DIR("A")=PROMPT
S DIR("B")=$S(DEFAULT:"YES",1:"NO")
D ^DIR
Q Y
;
HELP ;EP
; Protocol Action to display help information
S X="?"
D DISP^XQORM1
W !!
Q
;
EXIT ;EP
; Protocol action to exit the worklist
K ^TMP("IBRFIWL1",$J)
D CLEAR^VALM1
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBRFIWL1 16700 printed Apr 09, 2024@21:04:10 Page 2
IBRFIWL1 ;ALB/FA/JWS - RFAI Message Detail Worklist; 02-SEP-2015
+1 ;;2.0;INTEGRATED BILLING;**547**;21-MAR-94;Build 119
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;
+4 ;
EN(RFAIEN,RFAIDET,RFAIDHDR) ; Main entry point
+1 ; Displays the selected RFAI Message detail
+2 ; Input: RFAIEN - IEN of the selected RFAI Message
+3 ; RFAIDET - The detailed line from the initial worklist to show what entry is being worked on
+4 ; RFAIDHDR - The header for said details mentioned above
+5 NEW IBIFN,LOINC
+6 ; IEN for Bill/Claims file
SET IBIFN=$$GET1^DIQ(368,RFAIEN,111.01,"I")
+7 DO EN^VALM("IBRFI 277 DETAIL WL")
+8 IF $DATA(IBFASTXT)
SET VALMBCK="Q"
+9 QUIT
+10 ;
HDR ;EP
+1 ; Listman Template action to display Worklist header information
+2 ; Input: RFAIEN - IEN of the selected Message
+3 ; RFAIDET - The detailed line from the initial worklist to show what entry is being worked on
+4 ; RFAIDHDR - The header for said details mentioned above
+5 ; Output: Header information for the Selected Message
+6 ;
+7 NEW RBY,RDATE,XX
+8 SET XX=$$GET1^DIQ(368,RFAIEN,200.04,"I")
+9 IF XX
Begin DoDot:1
+10 SET RDATE=$$GET1^DIQ(368,RFAIEN,200.05,"I")
+11 SET RDATE=$$FMTE^XLFDT(RDATE,"2DZ")
+12 SET RBY=$$GET1^DIQ(368,RFAIEN,200.06)
+13 SET XX="Review Status: Review in Process By: "_RBY_" on "_RDATE
End DoDot:1
+14 IF '$TEST
SET XX="Review Status: Not Being Reviewed"
+15 SET VALMHDR(1)=$GET(RFAIDHDR)
+16 SET VALMHDR(2)=$GET(RFAIDET)
+17 SET VALMHDR(3)=XX
+18 QUIT
+19 ;
INIT ;EP
+1 ; Listman Template action to initialize the template
+2 ; Input: RFAIEN - IEN of the selected Message
+3 ;
+4 KILL ^TMP("IBRFIWL1",$JOB)
+5 DO BLD
+6 QUIT
+7 ;
BLD ; Creates the body of the worklist
+1 ; Input: IBIFN - IEN of the Bill/Claim (file 399) of the selected message
+2 ; RFAIEN - IEN of the selected Message
+3 ;
+4 NEW ELINEL,ELINER,SLINE
+5 SET SLINE=1
+6 ; Build Information Source section
DO BLDISRC(RFAIEN,SLINE,.ELINEL)
+7 ; Build Claim Level Status section
DO BLDCLEV(RFAIEN,ELINEL,.ELINEL)
+8 ; Build Service Line Info section
DO BLDSLI^IBRFIWLA(RFAIEN,ELINEL,.ELINEL)
+9 ; Build Comment section
DO BLDCOM^IBRFIWLA(RFAIEN,ELINEL,.ELINEL)
+10 SET VALMCNT=ELINEL-1
+11 QUIT
+12 ;
BLDISRC(RFAIEN,SLINE,ELINE) ; Build the Information Source Section
+1 ; Input: RFAIEN - IEN of the selected Message
+2 ; SLINE - Starting Section Line Number
+3 ; ELINE - Current Ending Section Line Number
+4 ; Output: ELINE - Updated Ending Section Line Number
+5 ;
+6 NEW XX,YY,ZZ,WW
+7 SET ELINE=$$SETN("Information Source",SLINE,1,1)
+8 SET XX=$$GETFVAL^IBRFIWL(101.01,RFAIEN,"",0,2)
+9 SET ELINE=$$SET("Payer Name: ",XX,ELINE,1)
+10 SET XX=$$GETFVAL^IBRFIWL(1.03,RFAIEN,"",0,2)
+11 SET ELINE=$$SET("Payer Contact Name: ",XX,ELINE,1)
+12 ; Contact 1
SET XX=$$GETFVAL^IBRFIWL(3.01,RFAIEN,"",0,2)
+13 ; Contact 1 Type
SET YY=$$GETFVAL^IBRFIWL(102.01,RFAIEN,"",0,2)
+14 IF (YY="FX"!(YY="TE"))
IF $$HLPHONE^HLFNC(XX)]""
SET XX=$$HLPHONE^HLFNC(XX)
+15 SET XX=$SELECT(XX="":"",YY="FX":XX_"(Fax)",YY="TE":XX_"(Tel)",YY="EX":XX_"(Ext)",YY="EM":"(Email)",YY="UR":"(url)",1:XX)
+16 SET YY=$$GETFVAL^IBRFIWL(26.01,RFAIEN,"",0,2)
IF YY]""
SET XX=XX_" EXT: "_YY
+17 ;3.01 add (Fax) or (Tel) when
SET ELINE=$$SET("Payer Contact #1: ",XX,ELINE,1)
+18 ;
+19 ; Contact 2
SET XX=$$GETFVAL^IBRFIWL(4.01,RFAIEN,"",0,2)
+20 IF XX'=""
Begin DoDot:1
+21 ; Contact 2 Type
SET YY=$$GETFVAL^IBRFIWL(102.02,RFAIEN,"",0,2)
+22 IF (YY="FX"!(YY="TE"))
IF $$HLPHONE^HLFNC(XX)]""
SET XX=$$HLPHONE^HLFNC(XX)
+23 SET XX=$SELECT(XX="":"",YY="FX":XX_"(Fax)",YY="TE":XX_"(Tel)",YY="EX":XX_"(Ext)",YY="EM":"(Email)",YY="UR":"(url)",1:XX)
+24 SET YY=$$GETFVAL^IBRFIWL(27.01,RFAIEN,"",0,2)
IF YY]""
SET XX=XX_" EXT: "_YY
+25 SET ELINE=$$SET("Payer Contact #2: ",XX,ELINE,1)
End DoDot:1
+26 ;
+27 ; Contact 3
SET XX=$$GETFVAL^IBRFIWL(5.01,RFAIEN,"",0,2)
+28 IF XX'=""
Begin DoDot:1
+29 ; Contact 3 Type
SET YY=$$GETFVAL^IBRFIWL(102.03,RFAIEN,"",0,2)
+30 IF (YY="FX"!(YY="TE"))
IF $$HLPHONE^HLFNC(XX)]""
SET XX=$$HLPHONE^HLFNC(XX)
+31 SET XX=$SELECT(XX="":"",YY="FX":XX_"(Fax)",YY="TE":XX_"(Tel)",YY="EX":XX_"(Ext)",YY="EM":"(Email)",YY="UR":"(url)",1:XX)
+32 SET YY=$$GETFVAL^IBRFIWL(28.01,RFAIEN,"",0,2)
IF YY]""
SET XX=XX_" EXT: "_YY
+33 SET ELINE=$$SET("Payer Contact #3: ",XX,ELINE,1)
End DoDot:1
+34 ;
+35 SET XX=$$GETFVAL^IBRFIWL(15.01,RFAIEN,"",0,2)
+36 SET ELINE=$$SET("Payer Response Contact Name: ",XX,ELINE,1)
+37 ; Response Contact 1
SET XX=$$GETFVAL^IBRFIWL(17.01,RFAIEN,"",0,2)
+38 ; Response Contact 1 Type
SET YY=$$GETFVAL^IBRFIWL(16.01,RFAIEN,"",0,2)
+39 IF XX]""
IF (YY="FX"!(YY="TE"))
IF $$HLPHONE^HLFNC(XX)]""
SET XX=$$HLPHONE^HLFNC(XX)
+40 SET XX=$SELECT(XX="":"",YY="FX":XX_"(Fax)",YY="TE":XX_"(Tel)",YY="EX":XX_"(Ext)",YY="EM":"(Email)",YY="UR":"(url)",1:XX)
+41 SET YY=$$GETFVAL^IBRFIWL(29.01,RFAIEN,"",0,2)
IF YY]""
SET XX=XX_" EXT: "_YY
+42 ;5.01 skip when null
SET ELINE=$$SET("Payer Response Contact #1: ",XX,ELINE,1)
+43 ;
+44 ; Response Contact 2
SET XX=$$GETFVAL^IBRFIWL(18.01,RFAIEN,"",0,2)
+45 IF XX'=""
Begin DoDot:1
+46 ; Contact 2 Type
SET YY=$$GETFVAL^IBRFIWL(16.02,RFAIEN,"",0,2)
+47 IF (YY="FX"!(YY="TE"))
IF $$HLPHONE^HLFNC(XX)]""
SET XX=$$HLPHONE^HLFNC(XX)
+48 SET XX=$SELECT(XX="":"",YY="FX":XX_"(Fax)",YY="TE":XX_"(Tel)",YY="EX":XX_"(Ext)",YY="EM":"(Email)",YY="UR":"(url)",1:XX)
+49 SET YY=$$GETFVAL^IBRFIWL(30.01,RFAIEN,"",0,2)
IF YY]""
SET XX=XX_" EXT: "_YY
+50 SET ELINE=$$SET("Payer Response Contact #2: ",XX,ELINE,1)
End DoDot:1
+51 ;
+52 ; Response Contact 3
SET XX=$$GETFVAL^IBRFIWL(19.01,RFAIEN,"",0,2)
+53 IF XX'=""
Begin DoDot:1
+54 ; Contact 3 Type
SET YY=$$GETFVAL^IBRFIWL(16.03,RFAIEN,"",0,2)
+55 IF (YY="FX"!(YY="TE"))
IF $$HLPHONE^HLFNC(XX)]""
SET XX=$$HLPHONE^HLFNC(XX)
+56 SET XX=$SELECT(XX="":"",YY="FX":XX_"(Fax)",YY="TE":XX_"(Tel)",YY="EX":XX_"(Ext)",YY="EM":"(Email)",YY="UR":"(url)",1:XX)
+57 SET YY=$$GETFVAL^IBRFIWL(31.01,RFAIEN,"",0,2)
IF YY]""
SET XX=XX_" EXT: "_YY
+58 SET ELINE=$$SET("Payer Response Contact #3: ",XX,ELINE,1)
End DoDot:1
+59 ;
+60 ; Response Cont Addr Line 1
SET XX=$$GETFVAL^IBRFIWL(20.01,RFAIEN,"",0,2)
+61 SET ELINE=$$SET("Payer Address: ",XX,ELINE,1)
+62 ; Response Cont Addr Line 2
SET XX=$$GETFVAL^IBRFIWL(20.02,RFAIEN,"",0,2)
+63 IF XX]""
SET ELINE=$$SET(" ",XX,ELINE,1)
+64 ; Response Cont City
SET XX=$$GETFVAL^IBRFIWL(20.03,RFAIEN,"",0,2)
+65 ; Response Cont State
SET YY=$$GETFVAL^IBRFIWL(120.04,RFAIEN,"",0,2)
+66 ; Response Cont ZIP
SET ZZ=$$GETFVAL^IBRFIWL(120.05,RFAIEN,"",0,2)
+67 ; Response Cont Country
SET WW=$$GETFVAL^IBRFIWL(120.06,RFAIEN,"",0,2)
+68 SET XX=$SELECT(((XX'="")!(YY'="")!(ZZ'="")!(WW]"")):XX_", "_YY_" "_ZZ_" "_WW,1:"")
+69 SET ELINE=$$SET("",XX,ELINE,1)
+70 ;
+71 ; Patient Claim Control #
SET XX=$$GETFVAL^IBRFIWL(11.02,RFAIEN,"",0,2)
+72 SET ELINE=$$SET("Payer Claim Control #: ",XX,ELINE,1)
+73 QUIT
+74 ;
BLDCLEV(RFAIEN,SLINE,ELINE) ; Build the Claim Level Status Section
+1 ; Input: RFAIEN - IEN of the selected Message
+2 ; SLINE - Starting Section Line Number
+3 ; ELINE - Current Ending Section Line Number
+4 ; Output: ELINE - Updated Ending Section Line Number
+5 ;
+6 NEW XX,YY,ZZ,XC0,RFAIEN1,IEN399,ARY,LN,I
+7 ; Spacing Blank Line
SET ELINE=$$SET("",$JUSTIFY("",40),SLINE,1)
+8 SET ELINE=$$SETN("Claim Level Status",ELINE,1,1)
+9 SET XX=$$GETFVAL^IBRFIWL(111.01,RFAIEN,"",0,2)
+10 SET ELINE=$$SET("Patient Control #: ",XX,ELINE,1)
+11 SET XX=$$GETFVAL^IBRFIWL(114.03,RFAIEN,"",3,2)
+12 SET YY=$$GETFVAL^IBRFIWL(114.04,RFAIEN,"",3,2)
+13 IF XX]""
SET XX=XX_$SELECT(YY]"":"-"_YY,1:"")
+14 IF XX=""
SET XX=$$GETFVAL^IBRFIWL(14.05,RFAIEN,"",0,2)
+15 SET ELINE=$$SET("Date of Service: ",XX,ELINE,1)
+16 SET XX=$$GETFVAL^IBRFIWL(11.03,RFAIEN,"",0,2)
+17 SET ELINE=$$SET("Medical Record Number: ",XX,ELINE,1)
+18 SET XX=$$GETFVAL^IBRFIWL(10.01,RFAIEN,"",0,2)
+19 SET ELINE=$$SET("Member Identification Number: ",XX,ELINE,1)
+20 ;
+21 SET XX=$$GETFVAL^IBRFIWL(25.01,RFAIEN,"",0,2)
+22 SET IEN399=$$GETFVAL^IBRFIWL(111.01,RFAIEN,"",0,0)
+23 IF IEN399
IF $$INSPRF^IBCEF(IEN399)
SET ELINE=$$SET("Type of Service: ",XX,ELINE,1)
+24 IF IEN399
IF XX]""
IF '$$INSPRF^IBCEF(IEN399)
SET ELINE=$$SET("Type of Service: ",XX,ELINE,1)
+25 IF 'IEN399
IF XX]""
SET ELINE=$$SET("Type of Service: ",XX,ELINE,1)
+26 ;
+27 SET XC0=0
FOR
SET XC0=$ORDER(^IBA(368,RFAIEN,13,XC0))
if XC0'=+XC0
QUIT
Begin DoDot:1
+28 SET RFAIEN1=XC0_","_RFAIEN
+29 SET XX=$$GETFVAL^IBRFIWL("368.0113,1.01",RFAIEN1,"",0,2)
+30 SET YY=$$GET1^DIQ(368.0113,RFAIEN1,1.01,"I")
+31 IF YY
SET ZZ=$$GET1^DIQ(368.001,YY_",",.02)
IF ZZ]""
SET XX=XX_" - "_ZZ
+32 IF XX'=""
Begin DoDot:2
+33 KILL ARY
SET LN=$$WRAP^IBRFIWLA(XX,64,79,.ARY)
+34 SET ELINE=$$SET("HCCS Category: ",ARY(1),ELINE,1)
+35 FOR I=2:1:LN
if $DATA(ARY(LN))
SET ELINE=$$SET("",ARY(I),ELINE,1)
End DoDot:2
+36 ;
+37 SET XX=$$GETFVAL^IBRFIWL("368.0113,1.02",RFAIEN1,"",0,2)
+38 SET YY=$$GET1^DIQ(368.0113,RFAIEN1,1.02,"I")
+39 IF YY
SET ZZ=$PIECE($$GET1^DIQ(368.0113,RFAIEN1,"1.02:80"),":")
IF ZZ]""
SET XX=XX_" - "_ZZ
+40 SET LN=$$WRAP^IBRFIWLA(XX,42,79,.ARY)
+41 SET ELINE=$$SET("Add'l Info Request Modifier (LOINC): ",ARY(1),ELINE,1)
+42 FOR I=2:1:LN
if $DATA(ARY(LN))
SET ELINE=$$SET("",ARY(I),ELINE,1)
+43 ;
+44 SET XX=$$GETFVAL^IBRFIWL("368.0113,10.01",RFAIEN1,"",0,2)
+45 SET YY=$$GET1^DIQ(368.0113,RFAIEN1,10.01,"I")
+46 IF YY
SET ZZ=$$GET1^DIQ(368.001,YY_",",.02)
IF ZZ]""
SET XX=XX_" - "_ZZ
+47 IF XX'=""
Begin DoDot:2
+48 KILL ARY
SET LN=$$WRAP^IBRFIWLA(XX,62,77,.ARY)
+49 SET ELINE=$$SET(" HCCS Category: ",ARY(1),ELINE,1)
+50 FOR I=2:1:LN
if $DATA(ARY(LN))
SET ELINE=$$SET(" ",ARY(I),ELINE,1)
End DoDot:2
+51 ;
+52 SET XX=$$GETFVAL^IBRFIWL("368.0113,10.02",RFAIEN1,"",0,2)
+53 SET YY=$$GET1^DIQ(368.0113,RFAIEN1,10.02,"I")
+54 IF YY
SET ZZ=$PIECE($$GET1^DIQ(368.0113,RFAIEN1,"10.02:80"),":")
IF ZZ]""
SET XX=XX_" - "_ZZ
+55 IF XX'=""
Begin DoDot:2
+56 KILL ARY
SET LN=$$WRAP^IBRFIWLA(XX,48,77,.ARY)
+57 SET ELINE=$$SET(" Add'l Info Request Modifier: ",ARY(1),ELINE,1)
+58 FOR I=2:1:LN
if $DATA(ARY(LN))
SET ELINE=$$SET(" ",ARY(I),ELINE,1)
End DoDot:2
+59 ;
+60 SET XX=$$GETFVAL^IBRFIWL("368.0113,11.01",RFAIEN1,"",0,2)
+61 SET YY=$$GET1^DIQ(368.0113,RFAIEN1,11.01,"I")
+62 IF YY
SET ZZ=$$GET1^DIQ(368.001,YY_",",.02)
IF ZZ]""
SET XX=XX_" - "_ZZ
+63 IF XX'=""
Begin DoDot:2
+64 KILL ARY
SET LN=$$WRAP^IBRFIWLA(XX,62,77,.ARY)
+65 SET ELINE=$$SET(" HCCS Category: ",ARY(1),ELINE,1)
+66 FOR I=2:1:LN
if $DATA(ARY(LN))
SET ELINE=$$SET(" ",ARY(I),ELINE,1)
End DoDot:2
+67 ;
+68 SET XX=$$GETFVAL^IBRFIWL("368.0113,11.02",RFAIEN1,"",0,2)
+69 SET YY=$$GET1^DIQ(368.0113,RFAIEN1,11.02,"I")
+70 IF YY
SET ZZ=$PIECE($$GET1^DIQ(368.0113,RFAIEN1,"11.02:80"),":")
IF ZZ]""
SET XX=XX_" - "_ZZ
+71 IF XX'=""
Begin DoDot:2
+72 KILL ARY
SET LN=$$WRAP^IBRFIWLA(XX,48,77,.ARY)
+73 SET ELINE=$$SET(" Add'l Info Request Modifier: ",ARY(1),ELINE,1)
+74 FOR I=2:1:LN
if $DATA(ARY(LN))
SET ELINE=$$SET(" ",ARY(I),ELINE,1)
End DoDot:2
+75 ;
+76 SET XX=$$GETFVAL^IBRFIWL("368.0113,.02",RFAIEN1,"",3,2)
+77 SET ELINE=$$SET("Status Information Effective Date: ",XX,ELINE,1)
End DoDot:1
+78 SET XX=$$GETFVAL^IBRFIWL(112.01,RFAIEN,"",0,2)
+79 SET ELINE=$$SET("Response Due Date: ",XX,ELINE,1)
+80 QUIT
+81 ;
SET(LABEL,DATA,LINE,COL) ; Sets text into the body of the worklist
+1 ; Input: LABEL - Label text to set into the line
+2 ; DATA - Field Data to set into the line
+3 ; LINE - Line to set LABEL and DATA into
+4 ; COL - Starting column position in LINE to insert
+5 ; LABEL_DATA text
+6 ; Returns: LINE - Updated Line by 1
+7 ;
+8 NEW IBY
+9 SET IBY=LABEL_DATA
+10 DO SET1(IBY,LINE,COL,$LENGTH(IBY))
+11 SET LINE=LINE+1
+12 QUIT LINE
+13 ;
SETN(TITLE,LINE,COL,RV) ; Sets a field Section title into the body of the worklist
+1 ; Input: TITLE - Text to be used for the field Section Title
+2 ; LINE - Line number in the body to insert the field section title
+3 ; COL - Starting Column position to set Section Title into
+4 ; RV - 1 - Set Reverse Video, 0 or null dont use Reverse Video
+5 ; Optional, defaults to ""
+6 ; Returns: LINE - Line number increased by 1
+7 ;
+8 NEW IBY
+9 SET IBY=" "_TITLE_" "
+10 DO SET1(IBY,LINE,COL,$LENGTH(IBY),$GET(RV))
+11 SET LINE=LINE+1
+12 QUIT LINE
+13 ;
SET1(TEXT,LINE,COL,WIDTH,RV) ; Sets the TMP array with body data
+1 ; Input: TEXT - Text to be set into the specified line
+2 ; LINE - Line to set TEXT into
+3 ; COL - Column of LINE to set TEXT into
+4 ; WIDTH - Width of the TEXT being set into line
+5 ; RV - 1 - Set Reverse Video, 0 or null dont use
+6 ; Reverse Video
+7 ; Optional, defaults to ""
+8 ; ^TMP("IBRFIWL1",$J) - Current ^TMP array
+9 ; Output: ^TMP("IBRFIWL1",$J) - Updated ^TMP array
+10 ;
+11 NEW IBX
+12 SET IBX=$GET(^TMP("IBRFIWL1",$JOB,LINE,0))
+13 SET IBX=$$SETSTR^VALM1(TEXT,IBX,COL,WIDTH)
+14 DO SET^VALM10(LINE,IBX)
+15 if $GET(RV)'=""
DO CNTRL^VALM10(LINE,COL,WIDTH,IORVON,IORVOFF)
+16 QUIT
+17 ;
LOCKM(RFAIEN) ; Lock Selection of a specified Message
+1 ; Input: RFAIEN - IEN of the selected Message
+2 ; Returns: 1 - Lock was obtained, 0 otherwise
+3 LOCK +^IBA(368,RFAIEN):3
+4 IF '$TEST
QUIT 0
+5 QUIT 1
+6 ;
UNLOCKM(RFAIEN) ; Unlock Selection of a specified Message
+1 ; Input: RFAIEN - IEN of the selected Message
+2 LOCK -^IBA(368,RFAIEN)
+3 QUIT
+4 ;
REVIEW ;EP
+1 ; Protocol action to Mark/Unmark the mesage as being In-Progress
+2 ; Input: RFAIEN - IEN of the selected Message
+3 NEW DA,DIE,DR,DTOUT,NOW,X,XX,Y
+4 SET VALMBCK="R"
+5 DO FULL^VALM1
+6 IF '$$LOCKM(RFAIEN)
Begin DoDot:1
+7 WRITE !!,*7,"Someone else is reviewing the status of this message."
+8 WRITE !,"Try again later."
+9 DO PAUSE^VALM1
End DoDot:1
QUIT
+10 ;
+11 SET DA=RFAIEN
SET DIE=368
SET NOW=$$NOW^XLFDT()
+12 ;S XX=$$GET1^DIQ(368,RFAIEN,200.04,"I"),XX=$S(XX=1:"In Progress",1:XX)
+13 ;S DR="200.04//"_XX_";200.05////"_NOW_";200.06////"_DUZ
+14 SET DR="200.04//REVIEW IN PROCESS"
+15 DO ^DIE
+16 DO UNLOCKM(RFAIEN)
+17 DO HDR
+18 QUIT
+19 ;
+1 ; Protocol action to Enter/Edit the comment of the selected Message
+2 ; Input: RFAIEN - IEN of the selected Message
+3 NEW CMTIEN
+4 SET VALMBCK="R"
+5 DO FULL^VALM1
+6 IF '$$LOCKM(RFAIEN)
Begin DoDot:1
+7 WRITE !!,*7,"Someone else is entering/editing this message."
+8 WRITE !,"Try again later."
+9 DO PAUSE^VALM1
End DoDot:1
QUIT
+10 ;
+11 SET DA(1)=RFAIEN
SET DLAYGO=368.0201
SET DIC(0)="L"
SET DIC="^IBA(368,"_DA(1)_",201,"
SET X=$$NOW^XLFDT()
+12 DO FILE^DICN
KILL DD,DO
SET (CMTIEN,DA)=+Y
IF DA<1
DO UNLOCKM(RFAIEN)
QUIT
+13 SET DIE="^IBA(368,"_DA(1)_",201,"
+14 SET DR=".02////"_DUZ_";.03"
DO ^DIE
+15 IF $GET(^IBA(368,RFAIEN,201,CMTIEN,1,1,0))=""
SET DIK=DIE
SET DA(1)=RFAIEN
SET DA=CMTIEN
DO ^DIK
+16 ;. S DA=RFAIEN,DIE=368,NOW=$$NOW^XLFDT()
+17 ;. ;S XX=$$GET1^DIQ(368,RFAIEN,200.04,"I") I XX=1 Q
+18 IF $GET(^IBA(368,RFAIEN,201,CMTIEN,1,1,0))'=""
Begin DoDot:1
+19 NEW DA
SET DA=RFAIEN
SET DIE=368
+20 SET DR="200.04//REVIEW IN PROCESS"
+21 DO ^DIE
End DoDot:1
+22 DO UNLOCKM(RFAIEN)
+23 DO CLEAN^VALM10
DO INIT^IBRFIN
+24 QUIT
+25 ;
REMOVE ;EP
+1 ; Protocol action to manually remove the selected Message
+2 ; Input: RFAIEN - IEN of the selected Message
+3 NEW COM,XX
+4 SET VALMBCK="R"
+5 DO FULL^VALM1
+6 IF '$$LOCKM(RFAIEN)
Begin DoDot:1
+7 WRITE !!,*7,"Someone else is removing this message."
+8 WRITE !,"Try again later."
+9 DO PAUSE^VALM1
End DoDot:1
QUIT
+10 ;
R2 ; Give final Warning
+1 NEW DIK,DA,DLAYGO,DIC,X,Y,DIE,DR,CMTIEN,NOW
+2 IF '$$ASKYN("Are you Sure you want to Remove this Message")
Begin DoDot:1
+3 DO UNLOCKM(RFAIEN)
End DoDot:1
QUIT
+4 ;
+5 ; create comment multiple
+6 SET DA(1)=RFAIEN
SET DLAYGO=368.0201
SET DIC(0)="L"
SET DIC="^IBA(368,"_DA(1)_",201,"
SET X=$$NOW^XLFDT()
+7 DO FILE^DICN
KILL DD,DO
SET (CMTIEN,DA)=+Y
IF DA<1
Begin DoDot:1
+8 DO UNLOCKM(RFAIEN)
+9 WRITE !!,*7,"Unable to create comment multiple to remove entry!"
+10 DO PAUSE^VALM1
End DoDot:1
QUIT
+11 ;
+12 ; Add reason for removal
+13 SET DIE="^IBA(368,"_DA(1)_",201,"
SET DR=".02////"_DUZ_";.03"
DO ^DIE
KILL DR,DIE
+14 ;
+15 ; be sure user enters a comment before actually removing the entry
+16 IF $GET(^IBA(368,RFAIEN,201,CMTIEN,1,1,0))=""!(X="^")
Begin DoDot:1
+17 WRITE !!,*7,"Please enter the reason this entry is being removed. A comment is mandatory!"
+18 ; Must delete new comment multiple if they don't enter comment
+19 SET DIK="^IBA(368,"_DA(1)_",201,"
DO ^DIK
KILL DIK
+20 DO PAUSE^VALM1
End DoDot:1
GOTO R2
+21 ;
+22 ; if comment entered, update review status
+23 NEW DA,DIE
SET DA=RFAIEN
SET DIE=368
SET NOW=$$NOW^XLFDT()
+24 IF $GET(^IBA(368,RFAIEN,201,CMTIEN,1,1,0))'=""
Begin DoDot:1
+25 SET XX=$$GET1^DIQ(368,RFAIEN,200.04,"I")
IF XX=1
QUIT
+26 SET DR="200.04////1"
+27 DO ^DIE
KILL DR
End DoDot:1
+28 ;
+29 ; Set deleted flag and date
+30 SET DR="200.01////1;200.02////"_NOW_";200.03////"_DUZ
+31 DO ^DIE
KILL DR
+32 ;
+33 DO UNLOCKM(RFAIEN)
+34 SET VALMBCK="Q"
+35 QUIT
+36 ;
TPJI ;EP
+1 ; Protocol action to do Third Party Joint Inquiry for the selected message
+2 ; Input: IBIFN - IEN for Bill/Claim of the selected message
+3 SET VALMBCK="R"
+4 DO FULL^VALM1
+5 DO TPJI1^IBCECOB2(IBIFN)
+6 QUIT
+7 ;
ASKYN(PROMPT,DEFAULT) ; Ask a yes/no question
+1 ; Input: PROMPT - Question to be asked
+2 ; DEFAULT - Default Answer
+3 ; 1 - YES, 0 - NO
+4 ; Optional, defaults to 0
+5 ; Returns: 1 - User answered YES, 0 othewise
+6 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+7 if $GET(DEFAULT)'=1
SET DEFAULT=0
+8 SET DIR(0)="Y"
SET DIR("A")=PROMPT
+9 SET DIR("B")=$SELECT(DEFAULT:"YES",1:"NO")
+10 DO ^DIR
+11 QUIT Y
+12 ;
HELP ;EP
+1 ; Protocol Action to display help information
+2 SET X="?"
+3 DO DISP^XQORM1
+4 WRITE !!
+5 QUIT
+6 ;
EXIT ;EP
+1 ; Protocol action to exit the worklist
+2 KILL ^TMP("IBRFIWL1",$JOB)
+3 DO CLEAR^VALM1
+4 QUIT
+5 ;
