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

RCDPEWL0.m

Go to the documentation of this file.
  1. RCDPEWL0 ;ALB/TMK/PJH - ELECTRONIC EOB WORKLIST ACTIONS ;Jun 06, 2014@19:11:19
  1. ;;4.5;Accounts Receivable;**173,208,252,269,298,317,321,326,332,409**;Mar 20, 1995;Build 17
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. Q
  1. ;
  1. PARAMS(SOURCE) ; Retrieve/Edit/Save View Parameters for ERA Worklist
  1. ; Input: SOURCE - "MO" - Menu Option
  1. ; "CV" - Change View Action
  1. ; Output: Sort/Filtering Criteria for the worklist sent into ^TMP("RCERA_PARAMS",$J)
  1. ; ^TMP("RCERA_PARAMS",$J,"RCPOST") - ERA Posting Status ("P":Posted/"U":Unposted)
  1. ; ^TMP("RCERA_PARAMS",$J,"RCAUTOP")- Auto-Posting Queue
  1. ; ("A":Auto-Posting/"N":Non Auto-Posting/"B":Both)
  1. ; ^TMP("RCERA_PARAMS",$J,"RCAPSTA")- Auto-Posting Status ; PRCA*4.5*326
  1. ; ("M":Marked/"P":Partial/"C":Complete/"A":All)
  1. ; ^TMP("RCERA_PARAMS",$J,"RCMATCH")- ERA Matching Status ("M":Matched/"U":Unmatched)
  1. ; ^TMP("RCERA_PARAMS",$J,"RCTYPE") - ERA Claim Type ("M":Medical/"P":Pharmacy/"B":Both)
  1. ; ^TMP("RCERA_PARAMS",$J,"RCDT") - A1^A2 Where:
  1. ; A1 - ERA Received EARLIEST DATE (Range Limited Only)
  1. ; A2 - ERA Received LATEST DATE (Range Limited Only)
  1. ; ^TMP("RCERA_PARAMS",$J,"RCPAYR") - B1^B2^B3 Where:
  1. ; B1 - All Payers/Range of Payers
  1. ; ("A": All/"R":Range of Payers)
  1. ; B2 - START WITH PAYER (e.g.,'AET')
  1. ; (Range Limited Only)
  1. ; B3 - GO TO PAYER (e.g.,'AETZ') (Range Limited Only)
  1. ;
  1. ; ^TMP("RCERA_PVW",$J) - Same layout as ^TMP("RCERA_PARAMS",$J). This global contains
  1. ; the sort/filters of the user's preferred view (for ERA main page)
  1. ; while ^TMP("RCERA_PARAMS",$J) contains the sort/filters of what is
  1. ; currently displayed. They may or may not be the same values.
  1. ;
  1. ; ^TMP("RCSCRATCH_PVW",$J) - This global contains the sort/filters of the user's preferred view
  1. ; for the Scratch Pad. See PARAMS^RCDPEWLA for the layout.
  1. ;
  1. ; RCQUIT=1 if the user exited out, 0 otherwise
  1. ;
  1. N RCXPAR,USEPVW,X,XX,Y ; PRCA*4.5*317 Added USEPVW,XX
  1. S RCQUIT=0
  1. ;
  1. ; Ask Date Range Selection when coming straight from the menu option
  1. I SOURCE="MO" D Q:RCQUIT
  1. . K ^TMP("RCERA_PARAMS",$J),^TMP("RCERA_PVW",$J),^TMP("RCSCRATCH_PVW",$J)
  1. . S RCQUIT=$$DTR() ; Set date range filter
  1. . Q:RCQUIT
  1. . ;
  1. . ;Retrieve user's saved preferred view (if any)
  1. . D GETWLPVW(.RCXPAR)
  1. ;
  1. ;Only ask user if they want to use their preferred view in the following scenarios:
  1. ; a) Source is "MO" and user has a preferred view on file
  1. ; b) Source is "CV" (change view action), user has a preferred view but is
  1. ; not using the preferred view criteria at this time.
  1. S XX=$$PREFVW(SOURCE)
  1. I ((XX=1)&(SOURCE="MO"))!((XX=0)&(SOURCE="CV")) D Q:USEPVW
  1. . ;
  1. . ; Ask the user if they want to use the preferred view
  1. . S USEPVW=$$ASKUVW()
  1. . I USEPVW=-1 S RCQUIT=1 Q
  1. . Q:'USEPVW
  1. . ;
  1. . ; Set the Sort/Filtering Criteria from the preferred view
  1. . M ^TMP("RCERA_PARAMS",$J)=^TMP("RCERA_PVW",$J)
  1. ;
  1. W !!,"Select parameters for displaying the list of ERAs"
  1. S RCQUIT=$$PARAMS2^RCDPEWLD()
  1. Q:RCQUIT
  1. D SAVEPVW ; Ask if they want to save as preferred view
  1. Q
  1. ;
  1. GETWLPVW(RCXPAR) ; Retrieves the preferred view settings for the ERA worklist
  1. ; for the user
  1. ; Input: None
  1. ; Output: RCXPAR() - Array of preferred view sort/filter criteria
  1. ; ^TMP("RCERA_PARAMS",$J)- Global array of preferred view settings
  1. ; ^TMP("RCERA_PVW") - A copy of the preferred settings (if any)
  1. N XX
  1. K RCXPAR
  1. D GETLST^XPAR(.RCXPAR,"USR","RCDPE EDI LOCKBOX WORKLIST","I")
  1. D:$D(RCXPAR("ERA_POSTING_STATUS")) PVWSAVE(.RCXPAR)
  1. ;
  1. S XX=$G(RCXPAR("ERA_POSTING_STATUS"))
  1. S ^TMP("RCERA_PARAMS",$J,"RCPOST")=$S(XX'="":XX,1:"U")
  1. S XX=$G(RCXPAR("ERA_AUTO_POSTING"))
  1. S ^TMP("RCERA_PARAMS",$J,"RCAUTOP")=$S(XX'="":XX,1:"B")
  1. S XX=$G(RCXPAR("ERA-EFT_MATCH_STATUS"))
  1. S ^TMP("RCERA_PARAMS",$J,"RCMATCH")=$S(XX'="":XX,1:"B")
  1. S XX=$G(RCXPAR("ERA_CLAIM_TYPE"))
  1. ; S ^TMP("RCERA_PARAMS",$J,"RCTYPE")=$S(XX'="":XX,1:"B") ; PRCA*4.5*321
  1. S ^TMP("RCERA_PARAMS",$J,"RCTYPE")=$S(XX'="":XX,1:"A") ; PRCA*4.5*321 change default to (A)LL
  1. S XX=$G(RCXPAR("ALL_PAYERS/RANGE_OF_PAYERS"))
  1. S ^TMP("RCERA_PARAMS",$J,"RCPAYR")=$S(XX'="":$TR(XX,";","^"),1:"A")
  1. S XX=$G(RCXPAR("ERA_PAYMENT_TYPE")) ; PRCA*4.5*321 new filter
  1. S ^TMP("RCERA_PARAMS",$J,"RCPAYMNT")=$S(XX'="":XX,1:"B") ; PRCA*4.5*321
  1. S XX=$G(RCXPAR("AUTO-POST_STATUS")) ; PRCA*4.5*326
  1. S ^TMP("RCERA_PARAMS",$J,"RCAPSTA")=$S(XX'="":XX,1:"A") ; PRCA*4.5*326
  1. Q
  1. ;
  1. PVWSAVE(RCXPAR) ; Save a copy of the preferred view on file
  1. ; PRCA*4.5*317 added subroutine
  1. ; Input: RCXPAR - array of preferred view setting for the user
  1. ; Output: ^TMP("RCERA_PVW") - a copy of the preferred settings
  1. ;
  1. K ^TMP("RCERA_PVW",$J)
  1. ; only continue if we have answers to all ERA Worklist related preferred view prompts
  1. Q:'$D(RCXPAR("ERA_POSTING_STATUS"))
  1. Q:'$D(RCXPAR("ERA_AUTO_POSTING"))
  1. Q:'$D(RCXPAR("ERA-EFT_MATCH_STATUS"))
  1. Q:'$D(RCXPAR("ERA_CLAIM_TYPE"))
  1. Q:'$D(RCXPAR("ALL_PAYERS/RANGE_OF_PAYERS"))
  1. Q:'$D(RCXPAR("ERA_PAYMENT_TYPE")) ; PRCA*4.5*321
  1. Q:'$D(RCXPAR("AUTO-POST_STATUS")) ; PRCA*4.5*326
  1. ;
  1. S ^TMP("RCERA_PVW",$J,"RCPOST")=RCXPAR("ERA_POSTING_STATUS")
  1. S ^TMP("RCERA_PVW",$J,"RCAUTOP")=RCXPAR("ERA_AUTO_POSTING")
  1. S ^TMP("RCERA_PVW",$J,"RCMATCH")=RCXPAR("ERA-EFT_MATCH_STATUS")
  1. S ^TMP("RCERA_PVW",$J,"RCTYPE")=RCXPAR("ERA_CLAIM_TYPE")
  1. S ^TMP("RCERA_PVW",$J,"RCPAYR")=$TR(RCXPAR("ALL_PAYERS/RANGE_OF_PAYERS"),";","^")
  1. S ^TMP("RCERA_PVW",$J,"RCPAYMNT")=RCXPAR("ERA_PAYMENT_TYPE") ; PRCA*4.5*321 new filter
  1. S ^TMP("RCERA_PVW",$J,"RCPAPST")=RCXPAR("AUTO-POST_STATUS") ; PRCA*4.5*326
  1. Q
  1. ;
  1. PREFVW(SOURCE) ; Checks to see if the user has a preferred view
  1. ; PRCA*4.5*317 added subroutine
  1. ; When source is 'CV', checks to see if the preferred view is being used
  1. ; Input: SOURCE - 'MO' - When called from the Worklist menu
  1. ; option
  1. ; 'CV' - When called from the Change View
  1. ; action
  1. ;
  1. ; ^TMP("RCERA_PVW") - Global array of preferred view settings
  1. ; ^TMP("RCERA_PARAMS") - Global array of currently in use defaults
  1. ; Returns: 1 - User has preferred view if SOURCE is 'MO' or is using
  1. ; their preferred view if SOURCE is 'CV'
  1. ; 0 - User is not using their preferred view
  1. ; -1 - User does not have a preferred view
  1. I SOURCE="MO" Q $S($D(^TMP("RCERA_PVW",$J)):1,1:-1)
  1. Q:'$D(^TMP("RCERA_PVW",$J)) -1 ; No stored preferred view
  1. Q:$G(^TMP("RCERA_PARAMS",$J,"RCPOST"))'=$G(^TMP("RCERA_PVW",$J,"RCPOST")) 0
  1. Q:$G(^TMP("RCERA_PARAMS",$J,"RCAUTOP"))'=$G(^TMP("RCERA_PVW",$J,"RCAUTOP")) 0
  1. Q:$G(^TMP("RCERA_PARAMS",$J,"RCMATCH"))'=$G(^TMP("RCERA_PVW",$J,"RCMATCH")) 0
  1. Q:$G(^TMP("RCERA_PARAMS",$J,"RCTYPE"))'=$G(^TMP("RCERA_PVW",$J,"RCTYPE")) 0
  1. Q:$G(^TMP("RCERA_PARAMS",$J,"RCPAYR"))'=$G(^TMP("RCERA_PVW",$J,"RCPAYR")) 0
  1. Q:$G(^TMP("RCERA_PARAMS",$J,"RCPAYMNT"))'=$G(^TMP("RCERA_PVW",$J,"RCPAYMNT")) 0 ; PRCA*4.5*321
  1. Q:$G(^TMP("RCERA_PARAMS",$J,"RCAPSTA"))'=$G(^TMP("RCERA_PVW",$J,"RCAPSTA")) 0 ; PRCA*4.5*326
  1. Q 1
  1. ;
  1. ASKUVW() ;EP from PARAMS^RCDPEWLA, PARAMS^RCDPEAA1
  1. ; Prompts the user to see if they want to use their preferred view
  1. ; PRCA*4.5*317 added function
  1. ; Input: None
  1. ; Returns: 1 - User wants to use their preferred view
  1. ; 0 - User does not want to use their preferred view
  1. ; -1 - User typed '^'
  1. N DIR,DTOUT,DUOUT
  1. S DIR(0)="Y"
  1. S DIR("A")="Use preferred view"
  1. S DIR("B")="N"
  1. W !
  1. D ^DIR
  1. I $D(DTOUT)!$D(DUOUT) Q -1
  1. Q:Y 1 ; response is YES
  1. Q 0
  1. ;
  1. SAVEPVW ; Option to save as User Preferred View
  1. ; PRCA*4.5*317 added subroutine
  1. ; Input: ^TMP("RCERA_PARAMS") - Global array of current worklist settings
  1. ; Output Current worklist settings set as preferred view (potentially)
  1. N DIR,DTOUT,DUOUT,RCERROR,XX
  1. K DIR
  1. S DIR(0)="YA",DIR("B")="NO"
  1. S DIR("A")="Do you want to save this as your preferred view (Y/N)? "
  1. W !
  1. D ^DIR
  1. Q:Y'=1
  1. S XX=^TMP("RCERA_PARAMS",$J,"RCPOST")
  1. D EN^XPAR(DUZ_";VA(200,","RCDPE EDI LOCKBOX WORKLIST","ERA_POSTING_STATUS",XX,.RCERROR)
  1. S XX=^TMP("RCERA_PARAMS",$J,"RCAUTOP")
  1. D EN^XPAR(DUZ_";VA(200,","RCDPE EDI LOCKBOX WORKLIST","ERA_AUTO_POSTING",XX,.RCERROR)
  1. S XX=^TMP("RCERA_PARAMS",$J,"RCMATCH")
  1. D EN^XPAR(DUZ_";VA(200,","RCDPE EDI LOCKBOX WORKLIST","ERA-EFT_MATCH_STATUS",XX,.RCERROR)
  1. S XX=^TMP("RCERA_PARAMS",$J,"RCTYPE")
  1. D EN^XPAR(DUZ_";VA(200,","RCDPE EDI LOCKBOX WORKLIST","ERA_CLAIM_TYPE",XX,.RCERROR)
  1. S XX=$TR(^TMP("RCERA_PARAMS",$J,"RCPAYR"),"^",";")
  1. D EN^XPAR(DUZ_";VA(200,","RCDPE EDI LOCKBOX WORKLIST","ALL_PAYERS/RANGE_OF_PAYERS",XX,.RCERROR)
  1. S XX=^TMP("RCERA_PARAMS",$J,"RCPAYMNT") ; PRCA*4.5*321
  1. D EN^XPAR(DUZ_";VA(200,","RCDPE EDI LOCKBOX WORKLIST","ERA_PAYMENT_TYPE",XX,.RCERROR) ; PRCA*4.5*321
  1. S XX=$TR(^TMP("RCERA_PARAMS",$J,"RCAPSTA"),"^",";") ; PRCA*4.5*326
  1. D EN^XPAR(DUZ_";VA(200,","RCDPE EDI LOCKBOX WORKLIST","AUTO-POST_STATUS",XX,.RCERROR) ; PRCA*4.5*326
  1. ;
  1. K ^TMP("RCERA_PVW",$J)
  1. M ^TMP("RCERA_PVW",$J)=^TMP("RCERA_PARAMS",$J) ; capture new preferred settings for comparison
  1. Q
  1. ;
  1. DTR() ; Date Range Selection
  1. ; Input: ^TMP("RCERA_PARAMS",$J,"RCDT") - Current selected Date Range (if any)
  1. ; Output: ^TMP("RCERA_PARAMS",$J,"RCDT") - Updated Selected Date Range
  1. ; Returns: 1 if user quit or timed out, 0 otherwise
  1. DTR1 ;
  1. N DIR,DTOUT,DTQUIT,DUOUT,Y,FROM,TO,RCDTRNG
  1. S ^TMP("RCERA_PARAMS",$J,"RCDT")="0^"_DT
  1. K DIR S DIR(0)="YA"
  1. S DIR("A")="Limit the selection to a date range when the ERA was received?: "
  1. S DIR("B")="NO"
  1. S DIR("?")="Enter YES to specify a date range filter."
  1. W !
  1. D ^DIR
  1. I $D(DTOUT)!$D(DUOUT) Q 1
  1. I Y D G:DTQUIT DTR1
  1. . S DTQUIT=0
  1. . S FROM=$P($G(^TMP("RCERA_PARAMS",$J,"RCDT")),"^",1)
  1. . S TO=$P($G(^TMP("RCERA_PARAMS",$J,"RCDT")),"^",2)
  1. . W !
  1. . S RCDTRNG=$$DTRANGE(FROM,TO)
  1. . I RCDTRNG="^" S DTQUIT=1 Q
  1. . S ^TMP("RCERA_PARAMS",$J,"RCDT")=RCDTRNG
  1. Q 0
  1. ;
  1. DTRANGE(DEFFROM,DEFTO) ; Asks for and returns a Date Range
  1. ; Input: DEFFROM - Default FROM date
  1. ; DEFTO - Default TO date
  1. ;Output: From_Date^To_Date (YYYMMDD^YYYDDMM) or "^" (timeout or ^ entered)
  1. ;
  1. N DIR,Y,DTOUT,DUOUT,RCDFR,START
  1. S RCQUIT=0
  1. S DIR(0)="DAE^:"_DT_":E"
  1. S DIR("A")="Earliest date: "
  1. S DIR("?")="Enter the start of the date range."
  1. S:($G(DEFFROM)) DIR("B")=$$FMTE^XLFDT(DEFFROM,2)
  1. D ^DIR
  1. I $D(DTOUT)!$D(DUOUT) Q "^"
  1. S RCDFR=Y,START=$$FMTE^XLFDT(RCDFR,"2DZ")
  1. K DIR
  1. S DIR(0)="DAE^"_RCDFR_":"_DT_":E"
  1. S DIR("A")="Latest date: "
  1. S DIR("?",1)="Enter the end of the date range. The ending date must be greater than "
  1. S DIR("?")="or equal to "_START_"."
  1. S:($G(DEFTO)) DIR("B")=$$FMTE^XLFDT(DEFTO,2)
  1. D ^DIR
  1. I $D(DTOUT)!$D(DUOUT) Q "^"
  1. Q (RCDFR_"^"_Y)
  1. ;
  1. SPLIT ; Split line in ERA list
  1. ; input - RCSCR = ien of 344.49 and 344.4
  1. N RCLINE,RCZ,RCDA,Q,Q0,Z,Z0,DIR,X,Y,CT,L,L1,RCONE,RCQUIT
  1. D FULL^VALM1
  1. I $S($P($G(^RCY(344.4,RCSCR,4)),U,2)]"":1,1:0) D NOEDIT^RCDPEWLP G SPLITQ ;prca*4.5*298 auto-posted ERAs cannot enter Split/Edit action
  1. I $G(RCSCR("NOEDIT")) D NOEDIT^RCDPEWL G SPLITQ
  1. W !!,"Select the entry that has a line you need to Split/Edit",!
  1. D SEL^RCDPEWL(.RCDA)
  1. S Z=+$O(RCDA(0)) G:'$G(RCDA(Z)) SPLITQ
  1. S RCLINE=+RCDA(Z),Z0=+$O(^TMP("RCDPE-EOB_WLDX",$J,Z_".999"),-1)
  1. S RCZ=Z F S RCZ=$O(^TMP("RCDPE-EOB_WLDX",$J,RCZ)) Q:'RCZ!(RCZ\1'=Z) D
  1. . S Q=$P($G(^TMP("RCDPE-EOB_WLDX",$J,RCZ)),U,2)
  1. . Q:'Q
  1. . S RCZ(RCZ)=Q
  1. . S Q0=0 F S Q0=$O(^RCY(344.49,RCSCR,1,Q,1,Q0)) Q:'Q0 I "01"[$P($G(^(Q0,0)),U,2) K RCZ(RCZ) Q
  1. I '$O(RCZ(0)) D G SPLITQ
  1. . S DIR(0)="EA",DIR("A",1)="This entry has no lines available to Edit/Split",DIR("A")="PRESS RETURN TO CONTINUE " W ! D ^DIR K DIR
  1. S RCQUIT=0
  1. I $P($G(^RCY(344.49,RCSCR,1,RCLINE,0)),U,13) D G:RCQUIT SPLITQ
  1. . S DIR("A",1)="WARNING! This line has already been VERIFIED",DIR("A")="Are you sure you want to continue?: ",DIR(0)="YA",DIR("B")="NO" W ! D ^DIR K DIR
  1. . I Y'=1 S RCQUIT=1
  1. S CT=0,CT=CT+1,DIR("?",CT)="Enter the line # that you want to split or edit:",RCONE=1
  1. S L=Z F S L=$O(RCZ(L)) Q:'L D
  1. . S L1=+$G(^TMP("RCDPE-EOB_WLDX",$J,L))
  1. . S CT=CT+1
  1. . S DIR("?",CT)=$G(^TMP("RCDPE-EOB_WL",$J,L1,0)),CT=CT+1,DIR("?",CT)=$G(^TMP("RCDPE-EOB_WL",$J,L1+1,0)) S RCONE(1)=$S(RCONE:L,1:"") S RCONE=0
  1. S DIR("?")=" ",Y=-1
  1. I $G(RCONE(1)) S Y=+RCONE(1) K DIR G:'Y SPLITQ
  1. I '$G(RCONE(1)) D K DIR I $D(DTOUT)!$D(DUOUT)!(Y\1'=Z) G SPLITQ
  1. . F S DIR(0)="NAO^"_(Z+.001)_":"_Z0_":3",DIR("A")="Which line of entry "_Z_" do you want to Split/Edit?: " S:$G(RCONE(1))'="" DIR("B")=RCONE(1) D ^DIR Q:'Y!$D(DUOUT)!$D(DTOUT) D Q:Y>0
  1. .. I '$D(^TMP("RCDPE-EOB_WLDX",$J,Y)) W !!,"Line "_Y_" does NOT exist - TRY AGAIN",! S Y=-1 Q
  1. .. I '$D(RCZ(Y)) W !!,"Line "_Y_" has been used in a DISTRIBUTE ADJ action and can't be edited",! S Y=-1 Q
  1. .. S Q=+$O(^RCY(344.49,RCSCR,1,"B",Y,0))
  1. ;
  1. K ^TMP("RCDPE_SPLIT_REBLD",$J)
  1. D SPLIT^RCDPEWL3(RCSCR,+Y)
  1. I $G(^TMP("RCDPE_SPLIT_REBLD",$J)) K ^TMP("RCDPE_SPLIT_REBLD",$J) D BLD^RCDPEWL1($G(^TMP($J,"RC_SORTPARM")))
  1. ;
  1. SPLITQ S VALMBCK="R"
  1. Q
  1. ;
  1. PRTERA ; EP from menu option View/Print ERA (VP) [RCDPE VIEW/PRINT ERA]
  1. ; View the selected ERA in a listman template
  1. ; Input: RCSCR - IEN of the ERA to be viewed
  1. N DIC,RCSCR,X,Y
  1. S DIC="^RCY(344.4,",DIC(0)="AEMQ"
  1. D ^DIC
  1. Q:Y'>0
  1. S RCSCR=+Y
  1. D PRERA1
  1. Q
  1. ;
  1. PRERA ; RCSCR is assumed to be defined
  1. D FULL^VALM1 ; Protocol entry
  1. PRERA1 ; Option entry
  1. N DIR,X,Y,RCERADET,RCLSTMGR,POP,ZTRTN,ZTSAVE,ZTDESC,%ZIS ; PRCA*4.5*332
  1. D EXCWARN^RCDPEWLP(RCSCR)
  1. S DIR("?",1)="Including expanded detail will significantly increase the size of this report",DIR("?",2)="IF YOU CHOOSE TO INCLUDE IT, ALL PAYMENT DETAILS FOR EACH EEOB WILL BE"
  1. S DIR("?")="listed. If you want just summary data for each EEOB, do NOT include it."
  1. S DIR(0)="YA",DIR("A")="Do you want to include expanded EEOB detail?: ",DIR("B")="NO"
  1. W !
  1. D ^DIR
  1. K DIR
  1. I $D(DUOUT)!$D(DTOUT) G PRERAQ
  1. S RCERADET=+Y
  1. S RCLSTMGR=$$ASKLM^RCDPEARL(1) ; PRCA*4.5*332
  1. I RCLSTMGR=-1 G PRERAQ ; PRCA*4.5*332
  1. I RCLSTMGR D VPERA(RCSCR,RCERADET,1) Q ; PRCA*4.5*332
  1. S %ZIS="QM" D ^%ZIS G:POP PRERAQ
  1. I $D(IO("Q")) D G PRERAQ
  1. . S ZTRTN="VPERA^RCDPEWL0("_RCSCR_","_RCERADET_",0)",ZTDESC="AR - Print ERA From Worklist"
  1. . D ^%ZTLOAD
  1. . W !!,$S($D(ZTSK):"Your task # "_ZTSK_" has been queued.",1:"Unable to queue this job.")
  1. . K ZTSK,IO("Q") D HOME^%ZIS
  1. U IO
  1. D VPERA(RCSCR,RCERADET,0) ; PRCA*4.5*332
  1. Q
  1. ;
  1. VPERA(RCSCR,RCERADET,LSTMGR) ; Queued entry
  1. ; Input: RCSCR - IEN of ERA to be viewed (#344.4)
  1. ; RCERADET - 1 if inclusion of all EOB details from file 361.1 is
  1. ; desired, 0 if not
  1. ; LSTMGR - 1 display in list manager, 0 otherwise
  1. N RC,RCDIQ,RCDIQ1,RCDIQ2,RCDOT,RCPG,RCSCR1,RC3611,RCXM1,RCZ,RC3611,XX,Z,Z0
  1. K ^TMP($J,"RC_SUMRAW"),^TMP($J,"RC_SUMOUT"),^TMP($J,"RC_SUMALL")
  1. S (RCSTOP,RCPG)=0,RCDOT="",$P(RCDOT,".",79)=""
  1. D GETS^DIQ(344.4,RCSCR_",","*","IEN","RCDIQ")
  1. D TXT0^RCDPEX31(RCSCR,.RCDIQ,.RCXM1,.RC) ; Get top level 0-node captioned flds
  1. I $O(^RCY(344.4,RCSCR,2,0)) S RC=RC+1,RCXM1(RC)=" **ERA LEVEL ADJUSTMENTS**"
  1. S RCSCR1=0 F S RCSCR1=$O(^RCY(344.4,RCSCR,2,RCSCR1)) Q:'RCSCR1 D
  1. . K RCDIQ2
  1. . D GETS^DIQ(344.42,RCSCR1_","_RCSCR_",","*","IEN","RCDIQ2")
  1. . D TXT2^RCDPEX31(RCSCR,RCSCR1,.RCDIQ2,.RCXM1,.RC) ; Get top level ERA adjs
  1. ;
  1. ; PRCA*4.5*409 - Add header and PLB information to print array so it will display
  1. ; even when there are no claim lines.
  1. I '$O(^RCY(344.4,RCSCR,1,0)) D
  1. . S RC=RC+1,RCXM1(RC)=" **NO ERA DETAIL PRESENT**"
  1. S Z0=+$O(^TMP($J,"RC_SUMALL"," "),-1)
  1. S Z=0 F S Z=$O(RCXM1(Z)) Q:'Z S Z0=Z0+1,^TMP($J,"RC_SUMALL",Z0)=RCXM1(Z)
  1. K RCXM1 S RC=0
  1. ;
  1. ; PRCA*4.5*409 - End modified code block
  1. S RCSCR1=0 F S RCSCR1=$O(^RCY(344.4,RCSCR,1,RCSCR1)) Q:'RCSCR1 D
  1. . K RCDIQ1
  1. . D GETS^DIQ(344.41,RCSCR1_","_RCSCR_",","*","IE","RCDIQ1") ;PRCA*4.5*298 need to retrieve all fields even if null (changed "IEN" to "IE")
  1. . D TXT00^RCDPEX31(RCSCR,RCSCR1,.RCDIQ1,.RCXM1,.RC)
  1. . ;HIPAA 5010
  1. . N PNAME4
  1. . S PNAME4=$$PNM4^RCDPEWL1(RCSCR,RCSCR1)
  1. . I $L(PNAME4)<32 D
  1. . .S RC=RC+1,RCXM1(RC-1)=$E("PATIENT: "_PNAME4_$J("",41),1,41)_"CLAIM #: "_$$BILLREF^RCDPESR0(RCSCR,RCSCR1),RCXM1(RC)=" "
  1. . I $L(PNAME4)>31 D
  1. . .S RC=RC+1,RCXM1(RC-1)=$J("",41)_"CLAIM #: "_$$BILLREF^RCDPESR0(RCSCR,RCSCR1)
  1. . .S RC=RC+1,RCXM1(RC-1)=$E("PATIENT: "_PNAME4,1,78),RCXM1(RC)=" "
  1. . D PROV^RCDPEWLD(RCSCR,RCSCR1,.RCXM1,.RC)
  1. . S RC3611=$P($G(^RCY(344.4,RCSCR,1,RCSCR1,0)),U,2)
  1. . I RCERADET D
  1. .. I 'RC3611 D Q
  1. ... D DISP^RCDPESR0("^RCY(344.4,"_RCSCR_",1,"_RCSCR1_",1)","^TMP($J,""RC_SUMRAW"")",1,"^TMP($J,""RC_SUMOUT"")",75,1)
  1. ..;
  1. .. E D ; Detail record is in 361.1
  1. ... K ^TMP("PRCA_EOB",$J)
  1. ... D GETEOB^IBCECSA6(RC3611,2)
  1. ... I $O(^IBM(361.1,RC3611,"ERR",0)) D GETERR^RCDPEDS(RC3611,+$O(^TMP("PRCA_EOB",$J,RC3611," "),-1)) ; get filing errors
  1. ... S Z=0 F S Z=$O(^TMP("PRCA_EOB",$J,RC3611,Z)) Q:'Z S RC=RC+1,^TMP($J,"RC_SUMOUT",RC)=$G(^TMP("PRCA_EOB",$J,RC3611,Z))
  1. ... S RC=RC+2,^TMP($J,"RC_SUMOUT",RC-1)=" ",^TMP($J,"RC_SUMOUT",RC)=" "
  1. ... K ^TMP("PRCA_EOB",$J)
  1. . I $D(RCDIQ1(344.41,RCSCR1_","_RCSCR_",",2)) D
  1. .. S RC=RC+1,RCXM1(RC)=" **EXCEPTION RESOLUTION LOG DATA**"
  1. .. S Z=0 F S Z=$O(RCDIQ1(344.41,RCSCR1_","_RCSCR_",",2,Z)) Q:'Z S RC=RC+1,RCXM1(RC)=RCDIQ1(344.41,RCSCR1_","_RCSCR_",",2,Z)
  1. . S RC=RC+1,RCXM1(RC)=" "
  1. . S Z0=+$O(^TMP($J,"RC_SUMALL"," "),-1)
  1. . S Z=0 F S Z=$O(RCXM1(Z)) Q:'Z S Z0=Z0+1,^TMP($J,"RC_SUMALL",Z0)=RCXM1(Z)
  1. . K RCXM1 S RC=0
  1. . S Z=0 F S Z=$O(^TMP($J,"RC_SUMOUT",Z)) Q:'Z S Z0=Z0+1,^TMP($J,"RC_SUMALL",Z0)=$G(^TMP($J,"RC_SUMOUT",Z))
  1. I LSTMGR D DOLSTMAN,PRERAQ Q ; PRCA*4.5*332
  1. S RCSTOP=0,Z=""
  1. F S Z=$O(^TMP($J,"RC_SUMALL",Z)) Q:'Z D Q:RCSTOP
  1. . I $D(ZTQUEUED),$$S^%ZTLOAD S (RCSTOP,ZTSTOP)=1 K ZTREQ I +$G(RCPG) W !!,"***TASK STOPPED BY USER***" Q
  1. . I 'RCPG!(($Y+5)>IOSL) D I RCSTOP Q
  1. .. D:RCPG ASK(.RCSTOP) I RCSTOP Q
  1. .. D HDR(.RCPG)
  1. . W !,$G(^TMP($J,"RC_SUMALL",Z))
  1. ;
  1. I 'RCSTOP,RCPG D ASK(.RCSTOP)
  1. ;
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. I '$D(ZTQUEUED) D ^%ZISC
  1. ;
  1. PRERAQ K ^TMP($J,"RC_SUMRAW"),^TMP($J,"RC_SUMOUT"),^TMP($J,"SUMALL")
  1. S VALMBCK="R"
  1. Q
  1. ; PRCA*4.5*332 - Subroutine added
  1. DOLSTMAN ; Display the ERA Detail in a listman format
  1. N HDR
  1. S HDR("TITLE")="VIEW ERA DETAIL"
  1. D LMRPT^RCDPEARL(.HDR,$NA(^TMP($J,"RC_SUMALL")),"RCDPE VIEW ERA DETAIL") ; generate ListMan display
  1. Q
  1. ;
  1. HDR(RCPG) ;Report hdr
  1. ; RCPG = last page #
  1. I RCPG!($E(IOST,1,2)="C-") W @IOF,*13
  1. S RCPG=$G(RCPG)+1
  1. W !,?5,"EDI LOCKBOX WORKLIST - ERA DETAIL",?55,$$FMTE^XLFDT(DT,2),?70,"Page: ",RCPG,!,$TR($J("",IOM)," ","=")
  1. Q
  1. ;
  1. ASK(RCSTOP) ;
  1. I $E(IOST,1,2)'["C-" Q
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT
  1. S DIR(0)="E" W ! D ^DIR
  1. I ($D(DIRUT))!($D(DUOUT)) S RCSTOP=1 Q
  1. Q
  1. ;