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

RCDPEWL7.m

Go to the documentation of this file.
  1. RCDPEWL7 ;ALB/TMK/KML - EDI LOCKBOX WORKLIST ERA DISPLAY SCREEN ;Jun 06, 2014@19:11:19
  1. ;;4.5;Accounts Receivable;**208,222,269,276,298,304,318,321,326,332,349,432**;Mar 20, 1995;Build 16
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. Q
  1. ;
  1. BLD(RCSORT) ; Build list with sort criteria
  1. ; RCSORT = the sort levels to use to display the data in ^ pieces
  1. ; piece 1 = the codes for the first level sort (sort code;null or -)
  1. ; piece 2 = the codes for the second level sort
  1. ; sort code is the type of data to sort by;- indicates reverse order
  1. N Z,Z1,RCT,RCZ
  1. S (RCT,VALMCNT)=0
  1. I '$D(^TMP($J,"RCERA_LIST")) D
  1. . S Z=0 F S Z=$O(^TMP("RCDPE-ERA_WLDX",$J,Z)) Q:'Z S RCZ=$P($G(^(Z)),U,2) D
  1. .. I $$FILTER^RCDPEWLD(RCZ) S ^TMP($J,"RCERA_LIST",$$SL(RCZ,$P(RCSORT,U)),$$SL(RCZ,$P(RCSORT,U,2)),RCZ)=""
  1. . K ^TMP("RCDPE-ERA_WLDX",$J),^TMP("RCDPE-ERA_WL",$J)
  1. ;
  1. S Z=""
  1. I RCSORT'["PN;-" D
  1. . F S Z=$O(^TMP($J,"RCERA_LIST",Z)) Q:Z="" S Z1="" F S Z1=$O(^TMP($J,"RCERA_LIST",Z,Z1)) Q:Z1="" D EXTRACT(Z,Z1,.RCT)
  1. ;
  1. I $P(RCSORT,U)["PN;-" D
  1. . F S Z=$O(^TMP($J,"RCERA_LIST",Z),-1) Q:Z="" S Z1="" F S Z1=$O(^TMP($J,"RCERA_LIST",Z,Z1)) Q:Z1="" D EXTRACT(Z,Z1,.RCT)
  1. ;
  1. I $P(RCSORT,U,2)["PN;-" D
  1. . F S Z=$O(^TMP($J,"RCERA_LIST",Z)) Q:Z="" S Z1="" F S Z1=$O(^TMP($J,"RCERA_LIST",Z,Z1),-1) Q:Z1="" D EXTRACT(Z,Z1,.RCT)
  1. ;
  1. I '$O(^TMP($J,"RCERA_LIST",0)) D SET("No ERAs left for your selection criteria")
  1. K ^TMP($J,"RCERA_LIST")
  1. S ^TMP("RCERA_PARAMS",$J,"SORT")=RCSORT
  1. Q
  1. ;
  1. EXTRACT(RCSRT1,RCSRT2,RCT) ; Extract the data
  1. ; RCSRT1 = data value at 1st sort level
  1. ; RCSRT2 = data value at 2nd sort level
  1. ; RCT = running entry counter - returned if passed by ref
  1. N AUTOCOMP,FIRST,MDT,RC0,RCARC,RCEFT,RCEXCEP,RCPOST,RCSTAT,RCZ,X,XX,Z,Z0 ;PRCA*4.5*318 Variable XX added
  1. S RCZ=0 F S RCZ=$O(^TMP($J,"RCERA_LIST",RCSRT1,RCSRT2,RCZ)) Q:'RCZ D
  1. . S RCT=RCT+1,RC0=$G(^RCY(344.4,RCZ,0))
  1. . S RCEFT=+$O(^RCY(344.31,"AERA",RCZ,0))
  1. . S MDT=$$MATCHDT^RCDPEWL7(RCEFT,"2D") ; PRCA*4.5*326 - Add date matched
  1. . S RCEXCEP=$$XCEPT^RCDPEWLP(RCZ) ; prca*4.5*298 assignment of ERA exception flag
  1. . S AUTOCOMP=$$STA(RCZ) ;PRCA*4.5*326
  1. . S RCARC=$$WLF^RCDPEWLZ(RCZ)
  1. . S RCSTAT=$S('RCEFT:U_$S($P(RC0,U,15)="CHK":"(CHECK PAYMENT EXPECTED)",$P(RC0,U,15)="NON":"(NO PAYMENT EXPECTED)",$P(RC0,U,9)=2:"(CHECK PAYMENT CHOSEN)",1:"N/A"),1:$$FMSSTAT^RCDPUREC(+$P($G(^RCY(344.31,RCEFT,0)),U,9)))
  1. . S RCPOST=$S(RCEFT:"EFT RECEIPT STATUS: ",1:"")_$P(RCSTAT,U,2)
  1. . ;prca*4.5*298 include Auto-Post Complete indicator and ERA exception flag in $SELECT statement
  1. . S X=$E(RCT_$J("",5),1,5)_" "_$S(RCEXCEP]"":RCEXCEP,AUTOCOMP]"":AUTOCOMP,RCARC]"":RCARC,$D(^RCY(344.49,RCZ)):" ",1:"-")_$E($P(RC0,U)_$J("",10),1,10)_" "_$E($P(RC0,U,2)_$J("",50),1,50)
  1. . D SET(X,RCT,RCZ)
  1. . S X=$J("",43)_$J($$FMTE^XLFDT($P(RC0,U,7),"2D"),8)_$J("",2)_$J(+$P(RC0,U,5),12,2)
  1. . S $E(X,73,80)=$$FMTE^XLFDT($P(RC0,U,7),"2D")
  1. . D SET(X,RCT,RCZ)
  1. . ; PRCA*4.5*326 Start changed block
  1. . S X=$J("",8)_$E($P(RC0,U,6)_$J("",30),1,30)_" APPROX # EEOBs: "_+$$CTEEOB^RCDPEWLB(RCZ)
  1. . D SET(X,RCT,RCZ)
  1. . S X=$P(RC0,U,9),XX=$$EXTERNAL^DILFD(344.4,.09,"",$P(RC0,U,9))
  1. . S XX=$S(X=1:"EFT MATCHED",X=2:"CHK MATCHED",X=3:"MATCH-0 PAY",XX=-1:"MATCH W/ERR",1:$P(XX," ",1))
  1. . I X=2 S MDT=$$GET1^DIQ(344.4,RCZ_",",5.03,"I") I MDT'="" S MDT=$$FMTE^XLFDT(MDT,"2D")
  1. . S:$$UNBAL^RCDPEAP1(RCZ) XX=XX_" - UNBALANCED"
  1. . S X=$J("",8)_$E(XX_$J("",25),1,25)_" "_$E(MDT_$J("",8),1,8)
  1. . S X=X_" "_RCPOST
  1. . ; PRCA*4.5*326 End changed block
  1. . D SET(X,RCT)
  1. . D SET(" ",RCT)
  1. ;.; prca*4.5*298 per patch requirements, keep code related to
  1. ;. ; creating/maintaining batches but just remove from execution.
  1. ;. ;I $G(^TMP("RCERA_PARAMS",$J,"BATCHON")) D
  1. ;.. ;S Z=0 F S Z=$O(^RCY(344.49,RCZ,3,Z)) Q:'Z S Z0=$G(^(Z,0)) I Z0'="" D
  1. ;...; S X=$J("",12)_$E("- BATCH #"_$P(Z0,U)_$J("",4),1,13)_" "_$E($P(Z0,U,2)_$J("",30),1,30)_" "_$S('$P(Z0,U,3):"NOT ",1:"")_"READY TO POST"
  1. ;... ;D SET(X,RCT)
  1. ;
  1. S VALMSG="Enter ?? for more actions and help" ; PRCA*4.5*326
  1. ;
  1. Q
  1. ;
  1. ; BEGIN PRCA*4.5*326
  1. STA(RCZ) ;Determine auto-post status and if marked for auto-post
  1. ; Input - RCZ = ERA ien
  1. ; Output - "" = UNPOSTED
  1. ; "A" = COMPLETE
  1. ; "P" = PARTIAL
  1. ; "M" = MARKED
  1. N STA
  1. ;Get ERA auto-post status
  1. S STA=$$GET1^DIQ(344.4,RCZ_",",4.02,"I")
  1. ;Not auto-post ERA
  1. Q:STA="" ""
  1. ;Unposted but marked for autopost
  1. I STA=0,$$GET1^DIQ(344.4,RCZ_",",4.04,"I")]"" Q "M"
  1. ;Unposted - EFT still not accepted
  1. Q:STA=0 ""
  1. ;Complete
  1. Q:STA=2 "A"
  1. ;Partial
  1. N MATCH,SUB
  1. S MATCH=0,SUB=0
  1. F S SUB=$O(^RCY(344.4,RCZ,1,SUB)) Q:'SUB D Q:MATCH
  1. .S MATCH=$$GET1^DIQ(344.41,SUB_","_RCZ,6,"I")
  1. Q $S(MATCH:"M",1:"P")
  1. ; END PRCA*4.5*326
  1. ;
  1. MATCHDT(RCEFT,FORMAT) ;EP
  1. ; Get the Date the ERA was matched
  1. ; Input: RCEFT - IEN for file 344.31
  1. ; FORMAT - (Optional) date format for second parameter of FMTE^XLFDT (Defaults to 2DZ)
  1. ; Returns: External date when the ERA was matched or ""
  1. I '$G(RCEFT) Q ""
  1. N IENS,XX
  1. I $G(FORMAT)="" S FORMAT="2DZ"
  1. S XX=$O(^RCY(344.31,RCEFT,4,"A"),-1) ; Get last Match Status History record
  1. Q:XX="" ""
  1. S IENS=XX_","_RCEFT_","
  1. S XX=$$GET1^DIQ(344.314,IENS,.02,"I")
  1. Q:XX="" ""
  1. S XX=$$FMTE^XLFDT(XX,FORMAT)
  1. Q XX
  1. ;
  1. SL(Y,SORT) ; Returns data for sort level from entry Y in file 344.4
  1. ; SORT = the sort data in ';' delimited pieces
  1. ; pc 1 = code for sort data
  1. ; pc 2 = the order requested (- or null)
  1. ;
  1. N RC0,DAT,SORT1,SORT2
  1. S SORT1=$P(SORT,";"),SORT2=$P(SORT,";",2)
  1. S RC0=$G(^RCY(344.4,Y,0)),DAT=" "
  1. ; No sort
  1. I SORT="" G SLQ
  1. ; Amt paid
  1. I SORT1="AP" D G SLQ
  1. . S DAT=SORT2_+$P(RC0,U,5)
  1. ; ERA date pd
  1. I SORT1="DP" D G SLQ
  1. . S DAT=SORT2_($P(RC0,U,4)\1)
  1. ; Payer name
  1. I SORT1="PN" D G SLQ
  1. . S DAT=$$UP^RCDPEARL($P(RC0,U,6))
  1. ; ERA date received
  1. I SORT1="DR" D G SLQ
  1. . S DAT=SORT2_($P(RC0,U,7)\1)
  1. ;
  1. SLQ Q $S(DAT'="":DAT,1:" ")
  1. ;
  1. INIT ; Entry point for List template to build the display of ERAs
  1. ;
  1. ; Parameters for selecting ERAs to be included in the list are
  1. ; contained in the global ^TMP("RCERA_PARAMS",$J,parameter name)
  1. ;
  1. N RCZ,RC0,RCT,RCTT,RCQUIT,RCDTFR,RCDTTO,DTOUT,DUOUT,DIR,X,Y,Z,Z1,RCPOST,RCEFT,RCINDX,QFLG
  1. D CLEAN^VALM10
  1. K ^TMP("RCDPE-ERA_WL",$J),^TMP("RCDPE-ERA_WLDX",$J),^TMP($J,"RCERA_LIST")
  1. ;
  1. S (RCT,RCTT,RCQUIT)=0
  1. ;
  1. S RCDTFR=+$P($G(^TMP("RCERA_PARAMS",$J,"RCDT")),U),RCDTTO=$S($P($G(^TMP("RCERA_PARAMS",$J,"RCDT")),U,2):$P(^("RCDT"),U,2),1:DT)
  1. ;
  1. S RCINDX=$S(RCDTFR:RCDTFR-.00000001,1:0)
  1. W !!,"SEARCHING, PLEASE STANDBY (PRESS '^' TO QUIT SEARCH)",!!
  1. F S RCINDX=$O(^RCY(344.4,"AFD",RCINDX)) Q:'RCINDX!(RCINDX\1>RCDTTO)!RCQUIT S RCZ=0 F S RCZ=$O(^RCY(344.4,"AFD",RCINDX,RCZ)) Q:'RCZ D Q:RCQUIT
  1. . S RCTT=RCTT+1
  1. . I RCTT>19999 D Q:RCQUIT=1
  1. . . S RCTT=0
  1. . . D WAIT^DICD
  1. . . D INITKB^XGF ; supported by DBIA 3173
  1. . . S QFLG=$$READ^XGF(1,1)
  1. . . Q:$G(DTOUT)
  1. . . S:QFLG="^" RCQUIT=1 Q
  1. . . I $D(DUOUT)!(Y=0) S RCQUIT=1 Q
  1. . . D RESETKB^XGF
  1. . ;
  1. . S RC0=$G(^RCY(344.4,RCZ,0))
  1. . I $$FILTER^RCDPEWLD(RCZ) S ^TMP($J,"RCERA_LIST",$$SL(RCZ,"DR"),$$SL(RCZ,""),RCZ)=""
  1. ;
  1. ; Output the list
  1. I 'RCQUIT D
  1. . D:$D(^TMP($J,"RCERA_LIST")) BLD("DR^N")
  1. . ; If no ERAs found display the message below in the list area
  1. . I '$O(^TMP("RCDPE-ERA_WL",$J,0)) D
  1. . . S ^TMP("RCDPE-ERA_WL",$J,1,0)="THERE ARE NO ERAs MATCHING YOUR SELECTION CRITERIA"
  1. . . S VALMCNT=1 ; PRCA*4.5*349 - VALMCNT set correctly to indicate 1 item instead of 2
  1. I RCQUIT K ^TMP("RCDPE-ERA_WL",$J),^TMP("RCDPE-ERA_WLDX",$J),^TMP($J,"RCERA_LIST") S VALMQUIT=""
  1. Q
  1. ;
  1. HDR ; Header for ERA Worklist (List user Current Screen View selections)
  1. ; Input: ^TMP("RCERA_PARAMS",$J)
  1. ; Output: VALMHDR
  1. N X,XX,XX2
  1. ;
  1. ; PRCA*4.5*321 - Total re-write of header subroutine to add new filters and shorten lines etc.
  1. ; First header line. Date range and Pharmacy/Tricare/Medical
  1. S X=$G(^TMP("RCERA_PARAMS",$J,"RCDT"))
  1. S XX="DATE RANGE : "
  1. I $P(X,U) D ;
  1. . S XX=XX_$$FMTE^XLFDT($P(X,U),2)
  1. . I $P(X,U,2) S XX=XX_"-"_$$FMTE^XLFDT($P(X,U,2),2)
  1. E S XX=XX_"NONE SELECTED"
  1. S X=$G(^TMP("RCERA_PARAMS",$J,"RCTYPE"))
  1. S XX2="MED/PHARM/TRIC/CHAMPVA: " ; PRCA*4.5*332 ;PRCA*4.5*432 CHAMPVA
  1. S XX2=XX2_$S(X="M":"MEDICAL ONLY",X="P":"PHARMACY ONLY",X="T":"TRICARE ONLY",X="C":"CHAMPVA ONLY",1:"ALL") ;PRCA*4.5*432 CHAMPVA
  1. S XX=$$SETSTR^VALM1(XX2,XX,36,41) ;PRCA*4.5*432 40->36
  1. S VALMHDR(1)=XX
  1. ;
  1. ; Second header line. Match/Unmatched and Auto-posting/Non Autoposting
  1. S X=$G(^TMP("RCERA_PARAMS",$J,"RCMATCH"))
  1. S XX="MATCH STATUS: "_$S(X="N":"NOT MATCHED",X="M":"MATCHED",1:"BOTH")
  1. S X=$G(^TMP("RCERA_PARAMS",$J,"RCAUTOP"))
  1. S XX2="AUTO-POSTING: "
  1. S XX2=XX2_$S(X="A":"AUTO-POSTING ONLY",X="N":"NON AUTO-POSTING ONLY",1:"BOTH")
  1. S XX=$$SETSTR^VALM1(XX2,XX,46,35)
  1. ; BEGIN PRCA*4.5*326
  1. I X'="N" D
  1. .S X=$G(^TMP("RCERA_PARAMS",$J,"RCAPSTA"))
  1. .S XX2="AUTOP: "_$S(X="P":"PARTIAL",X="C":"COMPLETE",X="M":"MARKED",1:"ALL")
  1. .S XX=$$SETSTR^VALM1(XX2,XX,27,15)
  1. ; END PRCA*4.5*326
  1. S VALMHDR(2)=XX
  1. ;
  1. ; Third header line. Post status, payer name range and zero payment/payment
  1. S X=$G(^TMP("RCERA_PARAMS",$J,"RCPOST"))
  1. S XX="POST STATUS : "_$S(X="U":"UNPOSTED",X="P":"POSTED",1:"BOTH")
  1. S X=$G(^TMP("RCERA_PARAMS",$J,"RCPAYR"))
  1. I $P(X,U)="A"!(X="") D ;
  1. . S XX2="ALL PAYERS"
  1. E D ;
  1. . S XX2=$P(X,U,2)_"-"_$P(X,U,3)
  1. . I $L(XX2)>11 S XX2="RANGE"
  1. S XX2="PAYERS: "_XX2
  1. S XX=$$SETSTR^VALM1(XX2,XX,26,20)
  1. S X=$G(^TMP("RCERA_PARAMS",$J,"RCPAYMNT"))
  1. S XX2="PAYMENT TYPE: "
  1. S XX2=XX2_$S(X="Z":"ZERO PAYMENTS ONLY",X="P":"PAYMENTS ONLY",1:"BOTH")
  1. S XX=$$SETSTR^VALM1(XX2,XX,46,35)
  1. S VALMHDR(3)=XX
  1. ;
  1. S VALMHDR(4)="# ERA # Trace#"
  1. Q
  1. ;
  1. FNL ; -- Clean up list
  1. K ^TMP("RCDPE-ERA_WL",$J),^TMP("RCDPE-ERA_WLDX",$J),^TMP("RCERA_PARAMS",$J),^TMP($J,"RCERA_LIST")
  1. Q
  1. ;
  1. SET(X,RCSEQ,RCSEQ1) ; -- set arrays
  1. ; X = the data to set into the global
  1. ; RCSEQ = the selectable line #
  1. ; RCSEQ1 = the ien of the entry in file 344.4
  1. S VALMCNT=VALMCNT+1,^TMP("RCDPE-ERA_WL",$J,VALMCNT,0)=X
  1. I $G(RCSEQ) S ^TMP("RCDPE-ERA_WL",$J,"IDX",VALMCNT,RCSEQ)=$G(RCSEQ1)
  1. I $G(RCSEQ1) S ^TMP("RCDPE-ERA_WLDX",$J,RCSEQ)=VALMCNT_U_RCSEQ1
  1. Q
  1. ;
  1. ENTERWL ; Enter the worklist with an ERA
  1. D WL($$SEL())
  1. D BLD($G(^TMP("RCERA_PARAMS",$J,"SORT")))
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. SEL() ; Select an ERA from the ERA list
  1. N RCDA,VALMY
  1. D FULL^VALM1
  1. D EN^VALM2($G(XQORNOD(0)),"S")
  1. S RCERA=0
  1. S RCDA=0 F S RCDA=$O(VALMY(RCDA)) Q:'RCDA S RCERA=+$P($G(^TMP("RCDPE-ERA_WLDX",$J,RCDA)),U,2)
  1. ;
  1. Q RCERA
  1. ;
  1. WL(RCERA) ; Enter worklist
  1. ;
  1. ; input - RCERA = ien of the ERA entry in file 344.4
  1. ;
  1. N DA,DIE,DIR,DR,DTOUT,DUOUT,I,PREVENT,RC0,RCNOED,RCQUIT,RCSORT,RCEXC,RETCODES,STATE,TYPE,X,Y
  1. Q:RCERA'>0
  1. ; PRCA*4.5*304 - Reentry if we cleared exceptions
  1. WL1 ; retest to make sure this ERA does not have an exception
  1. S TYPE=$S($$PAYTYPE(RCERA,"P"):"P",1:"M"),RCEXC=0 ; PRCA*4.5*321
  1. ; PRCA*4.5*304 - see if we have the ERA and go to WL1 to retest.
  1. I ($$XCEPT^RCDPEWLP(RCERA)]"")&(TYPE="M") D EXCDENY^RCDPEWLP Q ;cannot process MEDICAL ERA if exception exists then fall back to Worklist.
  1. ; PRCA*4.5*304 - Removed the G:($G(RCERA)'="")&&($G(RCEXC)=1) WL1 from above so it falls back to the worklist instead of going forward to the "Select ERA"
  1. ; I ($$XCEPT^RCDPEWLP(RCERA)]"")&(TYPE="M") D EXCDENY^RCDPEWLP G:($G(RCERA)'="")&&($G(RCEXC)=1) WL1 Q
  1. S (RCQUIT,RCNOED,PREVENT)=0,RC0=$G(^RCY(344.4,RCERA,0)),RCSORT=""
  1. I $P(RC0,U,8) D
  1. . I '$D(^RCY(344.49,RCERA,0)) D Q
  1. .. S RCQUIT=1
  1. .. W ! S DIR(0)="EA",DIR("A",1)="A SCRATCH PAD WAS NOT CREATED FOR THIS ERA BEFORE POSTING",DIR("A",2)="USE THE VIEW/PRINT ERA OPTION TO SEE ITS DETAIL",DIR("A")="Press ENTER to continue: " D ^DIR K DIR Q
  1. . ;
  1. . S RCNOED=+$P(RC0,U,8)
  1. . S DIR(0)="EA",DIR("A",1)="THIS ERA ALREADY HAS A RECEIPT - YOU MAY ONLY VIEW ITS SCRATCH PAD",DIR("A")="Press ENTER to continue: "
  1. . W ! D ^DIR K DIR W !
  1. G:RCQUIT WLQ
  1. G:RCNOED WLD ; already has a receipt so no need to check for older unposted EFTs
  1. ; function $$AGEDEFTS - search for any UNPOSTED EFTs older than 14 days (medical) or 30 days (pharmacy)
  1. ; return value of 0, 2, or 3 represent that entry into scratchpad can occur
  1. S TYPE=$S(TYPE="P":"P",$$PAYTYPE(RCERA,"T"):"T",1:"M") ; PRCA*4.5*332
  1. S RETCODES=$$AGEDEFTS^RCDPEWLP(RCERA,TYPE) ; PRCA*4.5*332
  1. S PREVENT=0
  1. F I=1:1 S STATE=$P(RETCODES,U,I) Q:STATE="" I $E(STATE,2)=TYPE,$E(STATE,1)=1 S PREVENT=1 ; PRCA*4.5*332
  1. Q:PREVENT ; prevent user from entering scratchpad; there are older EFTs on the system that need to be worked.
  1. WLD ;
  1. D DISP^RCDPEWL(RCERA,RCNOED)
  1. ;
  1. ; prca*4.5*298 per patch requirements, keep code related to
  1. ; creating/maintaining batches but just remove from execution.
  1. ;I 'RCQUIT,$G(^TMP("RCBATCH_SELECTED",$J)) D
  1. ;. S DA(1)=RCERA,DA=+$G(^TMP("RCBATCH_SELECTED",$J)),DR=".05////0",DIE="^RCY(344.49,"_DA(1)_",3," D ^DIE
  1. ;. L -^RCY(344.49,DA(1),3,DA,0)
  1. ;. K ^TMP("RCBATCH_SELECTED",$J)
  1. ;E D
  1. ;L -^RCY(344.4,RCERA,0)
  1. WLQ ;
  1. L -^RCY(344.4,RCERA,0)
  1. Q
  1. ;
  1. PRERA ; View/Print ERA from ERA list menu
  1. N RCSCR
  1. S RCSCR=$$SEL()
  1. I RCSCR>0 D PRERA^RCDPEWL0
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. BAT(RCERA) ; Select batch, if needed
  1. ; Returns 1 if batch selected OK or no batch needed
  1. ; RCERA = ien of entry in file 344.49
  1. N RCINUSE,RCQUIT,RCADJ,RC0,RCOK,DIR,DTOUT,DUOUT,X,Y,Z
  1. K ^TMP("RCBATCH_SELECTED",$J)
  1. S RCOK=1
  1. I '$O(^RCY(344.49,RCERA,3,0)) G BATQ
  1. S RC0=$G(^RCY(344.4,RCERA,0))
  1. S (RCQUIT,RCADJ)=0
  1. I $$HASADJ^RCDPEWL8(RCERA) D
  1. . S RCADJ=1
  1. . S DIR("A",1)="THIS ERA HAS NEGATIVE ADJUSTMENTS THAT NEED TO BE DISTRIBUTED TO OTHER",DIR("A",2)="PAYMENTS ON THE ERA. YOU CANNOT SELECT ANY INDIVIDUAL BATCHES UNTIL",DIR("A",3)="THE DISTRIBUTIONS ARE COMPLETE."
  1. . S DIR("A")="Press ENTER to continue: ",DIR(0)="EA" W ! D ^DIR K DIR
  1. S RCINUSE=+$O(^RCY(344.49,"AINUSE",1,RCERA,0))
  1. I RCINUSE D
  1. . N OK,Z
  1. . Q:RCADJ!$P(RC0,U,8)
  1. . S OK=0 S Z=0 F S Z=$O(^RCY(344.49,RCERA,3,Z)) Q:'Z I '$P($G(^RCY(344.49,RCERA,3,Z,0)),U,5) S OK=1 Q
  1. . I 'OK D Q
  1. .. S DIR("A",1)="ALL BATCHES WITHIN THIS ERA ARE CURRENTLY IN USE - TRY AGAIN LATER",DIR("A")="Press ENTER to continue: ",DIR(0)="EA" W ! D ^DIR K DIR S RCQUIT=1,RCOK=0 Q
  1. . W !!,"AT LEAST 1 BATCH WITHIN THIS ERA IS CURRENTLY IN USE",!,"AT THIS TIME, YOU CAN ONLY ACCESS INDIVIDUAL BATCHES",!
  1. . D SELBAT^RCDPEWL8(RCERA,.RCQUIT)
  1. . I RCQUIT S RCOK=0
  1. E D
  1. . Q:$P(RC0,U,8)!RCADJ ; Always require the entire ERA be used
  1. . S DIR(0)="SA^E:(E)NTIRE ERA;B:(B)ATCH",DIR("A")="DO YOU WANT THE (E)NTIRE ERA OR JUST A (B)ATCH?: " W ! D ^DIR K DIR
  1. . I $D(DTOUT)!$D(DUOUT) S RCQUIT=1,RCOK=0 Q
  1. . I Y="E" D Q
  1. .. S RCQUIT=1 F Z=1:1:2 L +^RCY(344.4,RCERA,0):5 I $T S RCQUIT=0 Q
  1. .. I RCQUIT S RCOK=0,DIR(0)="EA",DIR("A",1)="ANOTHER USER IS CURRENTLY USING THIS ERA, TRY AGAIN LATER",DIR("A")="Press ENTER to continue: " W ! D ^DIR K DIR Q
  1. . D SELBAT^RCDPEWL8(RCERA,.RCQUIT)
  1. . I RCQUIT S RCOK=0
  1. ;
  1. BATQ Q RCOK
  1. ;
  1. PAYTYPE(IEN,TYPE) ; EP - New way to tell if a payer is pharamcy, Tricare or medical - Added for PRCA*4.5*321
  1. ; Input: IEN - Internal entry number of an ERA (#344.4)
  1. ; TYPE="P" - Pharmacy, "T" - Tricare, "M" - Medical, "C" - CHAMPVA
  1. ; ("M" is neither pharmacy nor Tricare nor CHAMPVA)
  1. ; Return: 1 - Payer on ERA matches the TYPE
  1. ; 0 - Payer on ERA does not match the type. Or can't find payer.
  1. ;
  1. N FLAG,RETURN
  1. S RETURN=0
  1. I '$$PAYFLAGS(IEN,.FLAG) Q 0
  1. I TYPE="P",FLAG("P") S RETURN=1
  1. I TYPE="T",FLAG("T") S RETURN=1
  1. I TYPE="C",FLAG("C") S RETURN=1 ;PRCA*4.5*432 CHAMPVA
  1. I TYPE="M",'FLAG("P"),'FLAG("T"),'FLAG("C") S RETURN=1 ;PRCA*4.5*432 CHAMPVA
  1. Q RETURN
  1. ;
  1. PAYFLAGS(IEN,FLAG) ; EP - Return the pharmacy and tricare flags for an ERA
  1. ; Input: IEN - Internal entry number of an ERA (#344.4)
  1. ; Return: 1 - Payer found
  1. ; 0 - Can't find payer.
  1. ; Variable FLAG passed by reference to return values of the pharmacy, Tricare, and CHAMPVA flags.
  1. ;
  1. N RCINS,RCPAYIEN,RCTIN,X
  1. S RCTIN=$$GET1^DIQ(344.4,IEN_",",.03)
  1. I RCTIN="" Q 0
  1. S RCINS=$$GET1^DIQ(344.4,IEN_",",.06)
  1. I RCINS="" Q 0
  1. ;
  1. ; Find a payer that matches both TIN and PAYER NAME from the ERA
  1. S RCPAYIEN=""
  1. S X=0
  1. F S X=$O(^RCY(344.6,"C",RCTIN_" ",X)) Q:'X D Q:RCPAYIEN ;
  1. . N PAYNAME
  1. . S PAYNAME=$$GET1^DIQ(344.6,X_",",.01)
  1. . I PAYNAME=RCINS S RCPAYIEN=X
  1. I 'RCPAYIEN Q 0
  1. ;
  1. S FLAG("P")=+$$GET1^DIQ(344.6,RCPAYIEN_",",.09,"I")
  1. S FLAG("T")=+$$GET1^DIQ(344.6,RCPAYIEN_",",.1,"I")
  1. S FLAG("C")=+$$GET1^DIQ(344.6,RCPAYIEN_",",.15,"I") ;PRCA*4.5*432 CHAMPVA
  1. Q 1
  1. ;
  1. ; BEGIN PRCA*4.5*326
  1. HELP ; list manager help
  1. D FULL^VALM1
  1. S VALMBCK="R"
  1. W @IOF
  1. W !,"ePay Electronic Remittance Advice Status"
  1. W !!,"The following ERA Status indicators may appear to the left of ERA number:",!
  1. ;
  1. W !," '-' = No scratchpad."
  1. W !," 'x' = EXC exceptions exist."
  1. W !," 'c' = No-pay ERA with auto-decrease CARCs."
  1. W !," 'A' = Auto-post complete."
  1. W !," 'P' = Auto-post partially completed."
  1. W !," 'M' = Marked for Auto-post, waiting processing."
  1. D PAUSE^VALM1
  1. Q
  1. ;