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

IBRFIWL1.m

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