- 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 Jan 18, 2025@03:28:02 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 ;