RCDPEE ;AITC/FA -Select Partially Matched EFTs ; 29-MAY-2018
;;4.5;Accounts Receivable;**332**;Mar 20, 1995;Build 40
;Per VA Directive 6402, this routine should not be modified.
Q
;
EN(ERAIEN) ;EP from Manual Match, MATCH1^RCDPEM2
; Input: ERAIEN - IEN of the ERA to show partial matches for
; Returns: IEN of the selected EFT or "" if none selected
N RCQUIT,XX
S RCQUIT=0
K ^TMP("RCPM_PARAMS",$J),^TMP("RCDPEU1",$J)
S ^TMP("RCPM_PARAMS",$J,"ERAIEN")=ERAIEN
D FULL^VALM1
S RCQUIT=$$DTR() ; Set date range filter
Q:RCQUIT
S RCQUIT=$$CLAIMTYP() ; Ask Claim Type
Q:RCQUIT
S RCQUIT=$$PAYR() ; Ask for selected payers
Q:RCQUIT
D EN^VALM("RCDPE EFT PARTIAL MATCH")
Q
;
DTR() ;EP from RCDPEPMR
; Date Range Selection
; Input: ^TMP("RCPM_PARAMS",$J,"RCDT") - Current selected Date Range (if any)
; Output: ^TMP("RCPM_PARAMS",$J,"RCDT") - Updated Selected Date Range
; Returns: 1 if user quit or timed out, 0 otherwise
N DIR,DIRUT,DTOUT,DTQUIT,DUOUT,FROM,RCDTRNG,TO,Y
S ^TMP("RCPM_PARAMS",$J,"RCDT")="0^"_DT
S DTQUIT=0
S FROM=$P($G(^TMP("RCPM_PARAMS",$J,"RCDT")),"^",1)
S TO=$P($G(^TMP("RCPM_PARAMS",$J,"RCDT")),"^",2)
S RCDTRNG=$$DTRANGE(FROM,TO)
Q:RCDTRNG="^" 1
S ^TMP("RCPM_PARAMS",$J,"RCDT")=RCDTRNG
Q 0
;
DTRANGE(DEFFROM,DEFTO) ; Asks for and returns a Date Range
; Input: DEFFROM - Default FROM date
; DEFTO - Default TO date
; Output: From_Date^To_Date (YYYMMDD^YYYDDMM) or "^" (timeout or ^ entered)
N DIR,Y,DTOUT,DUOUT,RCDFR,START
S RCQUIT=0
S DIR(0)="DAE^:"_DT_":E"
S DIR("A")="Earliest date: "
S DIR("?")="Enter the start of the date range."
S:($G(DEFFROM)) DIR("B")=$$FMTE^XLFDT(DEFFROM,2)
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q "^"
S RCDFR=Y,START=$$FMTE^XLFDT(RCDFR,"2DZ")
K DIR
S DIR(0)="DAE^"_RCDFR_":"_DT_":E"
S DIR("A")="Latest date: "
S DIR("?",1)="Enter the end of the date range. The ending date must be greater than "
S DIR("?")="or equal to "_START_"."
S:($G(DEFTO)) DIR("B")=$$FMTE^XLFDT(DEFTO,2)
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q "^"
Q (RCDFR_"^"_Y)
;
CLAIMTYP() ;EP from RCDPEPMR
; Claim Type (Medical/Pharmacy/Both) Selection
; Input: ^TMP("RCPM_PARAMS") - Global array of preferred values (if any)
; Output: ^TMP("RCPM_PARAMS",$J,"RCTYPE") - EFT Claim Type filter
; Returns: 1 if user quit or timed out, 0 otherwise
N RCTYPE
S RCTYPE=$$RTYPE^RCDPEU1("ALL")
I RCTYPE<0 Q 1
S ^TMP("RCPM_PARAMS",$J,"RCTYPE")=RCTYPE
Q 0
;
PAYR() ;EP from RCDPEPMR
; Payer Selection
; Input: ^TMP("RCPM_PARAMS",$J,"RCTYPE") - M/P/T filter selection
; Output: ^TMP("RCPM_PARAMS",$J,"RCPAYR") - Payer filter selection
; ^TMP("RCDPEU1",$J) - If specific payers were selected
; Returns: 1 if user quit or timed out, 0 otherwise
N RCPAR,RCPAY,RCTYPE,XX
K ^TMP("RCPDEU1",$J)
S RCTYPE=$G(^TMP("RCPM_PARAMS",$J,"RCTYPE"))
S RCPAY=$$PAYRNG^RCDPEU1(0,0,0,"SELECT") ; Selected or Range of Payers
Q:RCPAY=-1 1
;
I RCPAY'="A" D Q:XX=-1 1 ; Since we don't want all payers
. S RCPAR("SELC")=RCPAY ; prompt for payers we do want
. S RCPAR("TYPE")=RCTYPE
. S RCPAR("FILE")=344.31
. S RCPAR("DICA")="Select Insurance Company NAME: "
. S XX=$$SELPAY^RCDPEU1(.RCPAR)
S ^TMP("RCPM_PARAMS",$J,"RCPAYR")=RCPAY
Q 0
;
HDR ;EP from listman template RCDPE EFT PARTIAL MATCH
; Display listman header
; Input: ^TMP("RCPM_PARAMS",$J)
; Output: VALMHDR
N ERAIEN,X,XX,XX2,YY
S X=$G(^TMP("RCPM_PARAMS",$J,"RCDT"))
S XX="DATE RANGE: "
S XX=XX_$$FMTE^XLFDT($P(X,"^",1),"2ZD")
I $P(X,"^",2) S XX=XX_"-"_$$FMTE^XLFDT($P(X,"^",2),"2ZD")
S X=$G(^TMP("RCPM_PARAMS",$J,"RCTYPE"))
S XX2="M/P/T: "
S XX2=XX2_$S(X="M":"MEDICAL ONLY",X="P":"PHARMACY ONLY",X="T":"TRICARE ONLY",1:"ALL")
S XX=$$SETSTR^VALM1(XX2,XX,35,21)
;
S X=$G(^TMP("RCPM_PARAMS",$J,"RCPAYR"))
I $P(X,"^",1)="A"!(X="") D
. S XX2="ALL PAYERS"
E S XX2="SELECTED"
S XX2="PAYERS: "_XX2
S XX=$$SETSTR^VALM1(XX2,XX,62,18)
S VALMHDR(1)=XX
;
; Build 2nd Header Line
S ERAIEN=$G(^TMP("RCPM_PARAMS",$J,"ERAIEN"))
S XX="ERA #: "_ERAIEN
S XX2=$$GET1^DIQ(344.4,ERAIEN_",",.02,"I") ; ERA Trace #
S XX2="Trace #: "_XX2
S XX=$$SETSTR^VALM1(XX2,XX,20,60)
S VALMHDR(2)=XX
;
; Build 3rd Header Line
S YY=$$GET1^DIQ(344.4,ERAIEN_",",.03,"I") ; ERA Payer TIN
S XX=$$GET1^DIQ(344.4,ERAIEN_",",.06,"I") ; ERA Payer Name
S XX2=XX_"/"_YY
S:$L(XX2)>63 XX2=$E(XX,1,79-$L(YY))_"/"_YY
S VALMHDR(3)="Payer Name/TIN: "_XX2
;
; Build 4TH Header Line
S YY=$$GET1^DIQ(344.4,ERAIEN_",",.05,"I") ; ERA Total Amount Paid
S XX=" Total Amt Pd: "_$J(YY,12,2)
S VALMHDR(4)=XX
;
S VALMHDR(5)=""
S VALMHDR(6)=" # EFT # Trace Number Total Amt Pd"
Q
;
INIT ;EP from listman template RCDPE EFT PARTIAL MATCH
; Display listman body
; Build the display of EFTs that are partially matched
; Input: ^TMP("RCPM_PARAMS",#J) - Selected Parameters
N EFTAMT,EFTDR,EFTREM,EFTTIN,EFTTR,ERAIEN,ERATIN,ERATOT,ERATR,RCDTFR,RCDTTO,XX
D CLEAN^VALM10
K ^TMP("RCPM-WL",$J),^TMP("RCPM-WL_WLDX",$J),^TMP($J,"RCPM_LIST")
S ERAIEN=$G(^TMP("RCPM_PARAMS",$J,"ERAIEN"))
S XX=$G(^TMP("RCPM_PARAMS",$J,"RCDT"))
S RCDTFR=+$P(XX,"^",1)
S RCDTTO=$S($P(XX,"^",2):$P(XX,"^",2),1:DT)
S ERATIN=$$GET1^DIQ(344.4,ERAIEN_",",.03,"I") ; ERA Payer TIN
S ERATIN=$$UP^XLFSTR(ERATIN)
S ERATR=$$GET1^DIQ(344.4,ERAIEN_",",.02,"I") ; ERA Trace #
S ERATR=$$UP^XLFSTR(ERATR)
S ERATOT=$$GET1^DIQ(344.4,ERAIEN_",",.05,"I") ; ERA Total Amount Paid
S EFTIEN=0
;
; Search for all unmatched, not removed EFTs that are partially matched for
; the specified date range
F D Q:'EFTIEN
. S EFTIEN=$O(^RCY(344.31,"AMATCH",0,EFTIEN))
. Q:'EFTIEN
. S EFTREM=$$GET1^DIQ(344.31,EFTIEN_",",.17,"I") ; User who removed EFT
. Q:EFTREM'="" ; Skip removed EFTs
. S EFTAMT=$$GET1^DIQ(344.31,EFTIEN_",",.07,"I") ; Amount of Payment
. Q:'EFTAMT ; Skip EFTs with no Payment Amount
. S EFTDR=$$GET1^DIQ(344.31,EFTIEN_",",.13,"I") ; Date Received
. Q:$$FMDIFF^XLFDT(RCDTFR,EFTDR,1)>0 ; Date Received before start of range
. Q:$$FMDIFF^XLFDT(EFTDR,RCDTTO,1)>0 ; Date Received after end of range
. Q:'$$FILTEFT(EFTIEN) ; Didn't pass selected filters
. D EFTCHK(EFTIEN,ERATIN,ERATOT,ERATR) ; Check for partial matched EFTs
;
I $D(^TMP($J,"RCPM_LIST")) D BLD Q ; Build the list main display
;
; No EFTs found, display the message below in the list area
S ^TMP("RCPM-WL",$J,1,0)="THERE ARE NO EFTs MATCHING YOUR SELECTION CRITERIA"
S VALMCNT=0
Q
;
EFTCHK(EFTIEN,ERATIN,ERATOT,ERATR) ; Check for partially matched EFTs
; Input: EFTIEN - IEN of the EFT being checked (#344.31)
; ERATIN - Payer TIN on the ERA record
; ERATOT - ERA Total Amount Paid
; ERATR - ERA Trace #
; Output: ^TMP($J,"RCPM_LIST,MATCHW,EFTSEQ)=A1^...^A11 Where
; MATCHW - Weighted number derived from partial matches
; EFTSEQ - Unique EFT Sequence #
; A1 - Number of matches between the ERA and the EFT
; A2 - Payer TIN # if matched, else ""
; A3 - Payer Trace # if matched, else ""
; A4 - Total Amount paid if matched else ""
; A5 - Matched weighted value
; 10 points for a match on Trace Number
; 5 points for a match on Total Amount
; 1 point for a match on TIN
; Only matches with a weigted value of 5 or more are displayed
; A6 - EFT IEN
; A7 - Deposit #
; A8 - Internal Deposit Date
; A9 - Payer Name/TIN (max 58 characters)
; A10- EFT Trace #
; A11- EFT Total Amount Paid
N DEPDT,DEPNUM,EFTSEQ,EFTTOT,EFTTIN,EFTTR,MATCH,MATCHW,PAYNM,XX,YY
;
S (EFTSEQ,XX)=$$GET1^DIQ(344.31,EFTIEN_",",.01,"I") ; IEN for 344.3
S DEPNUM=$$GET1^DIQ(344.3,XX_",",.06,"I") ; Deposit #
S DEPDT=$$GET1^DIQ(344.3,XX_",",.07,"I") ; Deposit Date
Q:$E(DEPNUM,1,3)="HAC"
S MATCHW=0,MATCH=""
S XX=$$GET1^DIQ(344.31,EFTIEN_",",.14,"I") ; EFT Transaction #
S:XX'="" EFTSEQ=EFTSEQ_"."_XX ; EFT Sequence number
S EFTTOT=$$GET1^DIQ(344.31,EFTIEN_",",.07,"I") ; EFT Total Amount Paid
S EFTTIN=$$GET1^DIQ(344.31,EFTIEN_",",.03,"I") ; EFT TIN
S EFTTIN=$$UP^XLFSTR(EFTTIN)
S EFTTR=$$GET1^DIQ(344.31,EFTIEN_",",.04,"I") ; EFT Trace #
S EFTTR=$$UP^XLFSTR(EFTTR)
I EFTTIN=ERATIN D ; Payer TIN match
. S MATCH=1,MATCHW=MATCHW+1
. S $P(MATCH,"^",2)=EFTTIN
I EFTTR=ERATR D ; Trace # number match
. S XX=$P(MATCH,"^",1),MATCHW=MATCHW+10
. S $P(MATCH,"^",1)=XX+1
. S $P(MATCH,"^",3)=EFTTR
I EFTTOT=ERATOT D ; Total Amount Paid match
. S XX=$P(MATCH,"^",1),MATCHW=MATCHW+5
. S $P(MATCH,"^",1)=XX+1
. S $P(MATCH,"^",4)=EFTTOT
Q:MATCHW<5 ; Only TIN match, skip
S $P(MATCH,"^",6)=EFTIEN ; EFT IEN
S $P(MATCH,"^",7)=DEPNUM ; Deposit #
S $P(MATCH,"^",8)=DEPDT ; Deposit Date (internal)
S PAYNM=$$GET1^DIQ(344.31,EFTIEN_",",.02,"I") ; EFT Payer Name
S XX=PAYNM_"/"_EFTTIN
S:$L(XX)>73 XX=$E(PAYNM,1,79-$L(EFTTIN))_"/"_EFTTIN
S $P(MATCH,"^",9)=XX
S $P(MATCH,"^",10)=EFTTR
S $P(MATCH,"^",11)=EFTTOT
S ^TMP($J,"RCPM_LIST",MATCHW,EFTSEQ)=MATCH
Q
;
FILTEFT(EFTIEN) ; Check to see if the EFT passes filter checks
; Input: EFTIEN - IEN for the EFT (#344.31)
; ^TMP("RCPM_PARAMS",$J,"RCPAYR") - Payer Selection - 'A','S' or 'R'
; ^TMP("RCPM_PARAMS",$J,"RCTYPE") - M/P/T Selection - 'A','M', 'P' or 'T'
; ^TMP("RCDPEU1",$J) - Selected payers if ALL not selected
; Returns: 1 if EFT passes filter checks, 0 otherwise
N RCFLAG,RCPAY,RCTYPE,XX
S XX=$G(^TMP("RCPM_PARAMS",$J,"RCPAYR"))
S RCPAY=$P(XX,"^",1)
S RCTYPE=$G(^TMP("RCPM_PARAMS",$J,"RCTYPE"))
;
; Payer filter check
I RCPAY'="A" D Q:'XX 0
. S XX=$$ISSEL^RCDPEU1(344.31,EFTIEN)
;
; M/P/T filter check
I RCTYPE'="A" D Q:'XX 0
. S XX=$$ISTYPE^RCDPEU1(344.31,EFTIEN,RCTYPE)
Q 1
;
BLD ; Build listman dislay
; Input: ^TMP($J,"RCPM_LIST,MATCHW,EFTSEQ)=A1^...^A11 Where:
; MATCHW - Weighted number derived from partial matches
; EFTSEQ - Unique EFT Sequence #
; A1 - Number of matches between the ERA and the EFT
; A2 - Payer TIN # if matched, else ""
; A3 - Payer Trace # if matched, else ""
; A4 - Total Amount paid if matched else ""
; A5 - Matched weighted value
; 10 points for a match on Trace Number
; 5 points for a match on Total Amount
; 1 point for a match on TIN
; Only matches with a weigted value of 5 or more are displayed
; A6 - EFT IEN
; A7 - Deposit #
; A8 - Internal Deposit Date
; A9 - Payer Name/TIN (max 58 characters)
; A10- EFT Trace #
; A11- EFT Total Amount Paid
N CTR,EFTSEQ,MATCH,MATCHW
S CTR=1
S VALMCNT=0
S MATCHW=""
F D Q:MATCHW=""
. S MATCHW=$O(^TMP($J,"RCPM_LIST",MATCHW),-1)
. Q:MATCHW=""
. S EFTSEQ=""
. F D Q:EFTSEQ=""
. . S EFTSEQ=$O(^TMP($J,"RCPM_LIST",MATCHW,EFTSEQ))
. . Q:EFTSEQ=""
. . S MATCH=^TMP($J,"RCPM_LIST",MATCHW,EFTSEQ)
. . D DISPEFT(MATCH,EFTSEQ,.CTR,.VALMCNT)
;
K ^TMP($J,"RCPM_LIST")
S VALMSG="Enter ?? for more actions and help"
Q
;
DISPEFT(MATCH,EFTSEQ,CTR,VALMCNT) ; Build the display for one EFT
; Input: MATCH - A1^...^A11 Where:
; A1 - Number of matches between the ERA and the EFT
; A2 - Payer TIN # if matched, else ""
; A3 - Payer Trace # if matched, else ""
; A4 - Total Amount paid if matched else ""
; A5 - Matched weighted value
; 10 points for a match on Trace Number
; 5 points for a match on Total Amount
; 1 point for a match on TIN
; Only matches with a weigted value of 5 or more are displayed
; A6 - EFT IEN
; A7 - Deposit #
; A8 - Internal Deposit Date
; A9 - Payer Name/TIN (max 58 characters)
; A10- EFT Trace #
; A11- EFT Total Amount Paid
; EFTSEQ - Unique EFT sequence #
; CTR - Current EFT counter
; VALMCNT - Current Listman body line counter
; Output: CTR - Updated EFT counter
; VALMCNT - Updated Listman body line counter
N EFTIEN,X,XX,TT
S EFTIEN=$P(MATCH,"^",6) ; EFT IEN
;
; Build first display line of the EFT
S YY=$P(MATCH,"^",10) ; Trace Number
S X=$E(CTR_$J("",4),1,4)_" "_$E(EFTSEQ_$J("",10),1,10)_" "_$E(YY_$J("",50),1,50)
S X=X_" "_$J($P(MATCH,"^",11),12,2) ; Total Amount Paid
D SET(X,CTR,EFTIEN,.VALMCNT)
;
; Build second display line of the EFT
S XX=$P(MATCH,"^",9)
S X=" "_$E(XX_$J("",73),1,73) ; Payer Name/TIN
D SET(X,CTR,EFTIEN,.VALMCNT)
D SET(" ",CTR,"",.VALMCNT) ; Display blank line
S CTR=CTR+1
S VALMSG="Enter ?? for more actions and help"
Q
;
SET(X,RCSEQ,EFTIEN,VALMCNT) ; Set listman body and selection arrays
; Input: X - Data to set into the display line
; RCSEQ - Selectable line #
; EFTIEN - IEN of the EFT record (#344.31)
; VALMCNT - Current Display line counter
; ^TMP("RCPM-WL",$J) - Current global array of body display lines
; ^TMP("RCPM-WL_WLDX",$J,RCSEQ) -VALMCNT_"^"_EFTIEN
; Output: VALMCNT - Updated Display line counter
; ^TMP("RCPM--WL",$J,VALMCNT,0) - Updated display lines with new line
; ^TMP("RCPM-WL_WLDX",$J,RCSEQ) -VALMCNT_"^"_ERAIEN
S VALMCNT=VALMCNT+1,^TMP("RCPM-WL",$J,VALMCNT,0)=X
S:$G(RCSEQ) ^TMP("RCPM-WL",$J,"IDX",VALMCNT,RCSEQ)=$G(EFTIEN)
S:$G(EFTIEN) ^TMP("RCPM-WL_WLDX",$J,RCSEQ)=VALMCNT_"^"_EFTIEN
Q
;
HELP ;EP from listman template RCDPE EFT PARTIAL MATCH
; help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ;EP from listman template RCDPE EFT PARTIAL MATCH
; Exit code
K ^TMP("RCPM_PARAMS",$J),^TMP("RCDPEU1",$J)
K ^TMP("RCPM-WL",$J),^TMP("RCPM-WL_WLDX",$J),^TMP($J,"RCPM_LIST")
Q
;
SELEFT ;EP from RCDPE EFT PARTIAL MATCH SELECT
; Input: None
; Output: ^TMP($J,"SELEFT")-EFTIEN if an EFT was selected
N PCNT,PROMPT,RCEFT,SEL
D FULL^VALM1
S VALM("ENTITY")="#"
D EN^VALM2($G(XQORNOD(0)),"S")
S PCNT=$O(VALMY(0))
Q:'PCNT
S RCEFT=$P(^TMP("RCPM-WL_WLDX",$J,PCNT),"^",2)
Q:RCEFT=""
S VALMBCK="R"
S RCQUIT=$$SHOWM(RCEFT)
I RCQUIT S VALMBCK="Q"
Q
;
SHOWM(RCEFT) ; Show EFT details and ask user if this is the correct one
; Input : RCEFT - IEN of EFT from file 344.31
; Returns : 1 - If match was made, 0 - to refresh patial match list, -1 to exit
;
N DEPDT,DEPNUM,RCQUIT
D GETDINFO^RCDPEM2(RCEFT,.DEPNUM,.DEPDT)
W !
S DIC="^RCY(344.31,",DR="0",DA=RCEFT D EN^DIQ
W " DEPOSIT NUMBER: ",DEPNUM,?40,"DEPOSIT DATE: ",DEPDT
W !
S DIR("A")="ARE YOU SURE THIS IS THE EFT YOU WANT TO MATCH?: ",DIR(0)="YA",DIR("B")="YES" D ^DIR K DIR
I $D(DUOUT)!$D(DTOUT) S RCQUIT=1 Q -1
I Y'=1 Q 0 ; G ML1 CJE*4.5*332
; Go to the Manual match, we have the ERA and EFT
S RCQUIT=0
D M12A^RCDPEM2
I RCQUIT Q -1
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEE 16572 printed Nov 22, 2024@16:54:47 Page 2
RCDPEE ;AITC/FA -Select Partially Matched EFTs ; 29-MAY-2018
+1 ;;4.5;Accounts Receivable;**332**;Mar 20, 1995;Build 40
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
EN(ERAIEN) ;EP from Manual Match, MATCH1^RCDPEM2
+1 ; Input: ERAIEN - IEN of the ERA to show partial matches for
+2 ; Returns: IEN of the selected EFT or "" if none selected
+3 NEW RCQUIT,XX
+4 SET RCQUIT=0
+5 KILL ^TMP("RCPM_PARAMS",$JOB),^TMP("RCDPEU1",$JOB)
+6 SET ^TMP("RCPM_PARAMS",$JOB,"ERAIEN")=ERAIEN
+7 DO FULL^VALM1
+8 ; Set date range filter
SET RCQUIT=$$DTR()
+9 if RCQUIT
QUIT
+10 ; Ask Claim Type
SET RCQUIT=$$CLAIMTYP()
+11 if RCQUIT
QUIT
+12 ; Ask for selected payers
SET RCQUIT=$$PAYR()
+13 if RCQUIT
QUIT
+14 DO EN^VALM("RCDPE EFT PARTIAL MATCH")
+15 QUIT
+16 ;
DTR() ;EP from RCDPEPMR
+1 ; Date Range Selection
+2 ; Input: ^TMP("RCPM_PARAMS",$J,"RCDT") - Current selected Date Range (if any)
+3 ; Output: ^TMP("RCPM_PARAMS",$J,"RCDT") - Updated Selected Date Range
+4 ; Returns: 1 if user quit or timed out, 0 otherwise
+5 NEW DIR,DIRUT,DTOUT,DTQUIT,DUOUT,FROM,RCDTRNG,TO,Y
+6 SET ^TMP("RCPM_PARAMS",$JOB,"RCDT")="0^"_DT
+7 SET DTQUIT=0
+8 SET FROM=$PIECE($GET(^TMP("RCPM_PARAMS",$JOB,"RCDT")),"^",1)
+9 SET TO=$PIECE($GET(^TMP("RCPM_PARAMS",$JOB,"RCDT")),"^",2)
+10 SET RCDTRNG=$$DTRANGE(FROM,TO)
+11 if RCDTRNG="^"
QUIT 1
+12 SET ^TMP("RCPM_PARAMS",$JOB,"RCDT")=RCDTRNG
+13 QUIT 0
+14 ;
DTRANGE(DEFFROM,DEFTO) ; Asks for and returns a Date Range
+1 ; Input: DEFFROM - Default FROM date
+2 ; DEFTO - Default TO date
+3 ; Output: From_Date^To_Date (YYYMMDD^YYYDDMM) or "^" (timeout or ^ entered)
+4 NEW DIR,Y,DTOUT,DUOUT,RCDFR,START
+5 SET RCQUIT=0
+6 SET DIR(0)="DAE^:"_DT_":E"
+7 SET DIR("A")="Earliest date: "
+8 SET DIR("?")="Enter the start of the date range."
+9 if ($GET(DEFFROM))
SET DIR("B")=$$FMTE^XLFDT(DEFFROM,2)
+10 DO ^DIR
+11 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT "^"
+12 SET RCDFR=Y
SET START=$$FMTE^XLFDT(RCDFR,"2DZ")
+13 KILL DIR
+14 SET DIR(0)="DAE^"_RCDFR_":"_DT_":E"
+15 SET DIR("A")="Latest date: "
+16 SET DIR("?",1)="Enter the end of the date range. The ending date must be greater than "
+17 SET DIR("?")="or equal to "_START_"."
+18 if ($GET(DEFTO))
SET DIR("B")=$$FMTE^XLFDT(DEFTO,2)
+19 DO ^DIR
+20 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT "^"
+21 QUIT (RCDFR_"^"_Y)
+22 ;
CLAIMTYP() ;EP from RCDPEPMR
+1 ; Claim Type (Medical/Pharmacy/Both) Selection
+2 ; Input: ^TMP("RCPM_PARAMS") - Global array of preferred values (if any)
+3 ; Output: ^TMP("RCPM_PARAMS",$J,"RCTYPE") - EFT Claim Type filter
+4 ; Returns: 1 if user quit or timed out, 0 otherwise
+5 NEW RCTYPE
+6 SET RCTYPE=$$RTYPE^RCDPEU1("ALL")
+7 IF RCTYPE<0
QUIT 1
+8 SET ^TMP("RCPM_PARAMS",$JOB,"RCTYPE")=RCTYPE
+9 QUIT 0
+10 ;
PAYR() ;EP from RCDPEPMR
+1 ; Payer Selection
+2 ; Input: ^TMP("RCPM_PARAMS",$J,"RCTYPE") - M/P/T filter selection
+3 ; Output: ^TMP("RCPM_PARAMS",$J,"RCPAYR") - Payer filter selection
+4 ; ^TMP("RCDPEU1",$J) - If specific payers were selected
+5 ; Returns: 1 if user quit or timed out, 0 otherwise
+6 NEW RCPAR,RCPAY,RCTYPE,XX
+7 KILL ^TMP("RCPDEU1",$JOB)
+8 SET RCTYPE=$GET(^TMP("RCPM_PARAMS",$JOB,"RCTYPE"))
+9 ; Selected or Range of Payers
SET RCPAY=$$PAYRNG^RCDPEU1(0,0,0,"SELECT")
+10 if RCPAY=-1
QUIT 1
+11 ;
+12 ; Since we don't want all payers
IF RCPAY'="A"
Begin DoDot:1
+13 ; prompt for payers we do want
SET RCPAR("SELC")=RCPAY
+14 SET RCPAR("TYPE")=RCTYPE
+15 SET RCPAR("FILE")=344.31
+16 SET RCPAR("DICA")="Select Insurance Company NAME: "
+17 SET XX=$$SELPAY^RCDPEU1(.RCPAR)
End DoDot:1
if XX=-1
QUIT 1
+18 SET ^TMP("RCPM_PARAMS",$JOB,"RCPAYR")=RCPAY
+19 QUIT 0
+20 ;
HDR ;EP from listman template RCDPE EFT PARTIAL MATCH
+1 ; Display listman header
+2 ; Input: ^TMP("RCPM_PARAMS",$J)
+3 ; Output: VALMHDR
+4 NEW ERAIEN,X,XX,XX2,YY
+5 SET X=$GET(^TMP("RCPM_PARAMS",$JOB,"RCDT"))
+6 SET XX="DATE RANGE: "
+7 SET XX=XX_$$FMTE^XLFDT($PIECE(X,"^",1),"2ZD")
+8 IF $PIECE(X,"^",2)
SET XX=XX_"-"_$$FMTE^XLFDT($PIECE(X,"^",2),"2ZD")
+9 SET X=$GET(^TMP("RCPM_PARAMS",$JOB,"RCTYPE"))
+10 SET XX2="M/P/T: "
+11 SET XX2=XX2_$SELECT(X="M":"MEDICAL ONLY",X="P":"PHARMACY ONLY",X="T":"TRICARE ONLY",1:"ALL")
+12 SET XX=$$SETSTR^VALM1(XX2,XX,35,21)
+13 ;
+14 SET X=$GET(^TMP("RCPM_PARAMS",$JOB,"RCPAYR"))
+15 IF $PIECE(X,"^",1)="A"!(X="")
Begin DoDot:1
+16 SET XX2="ALL PAYERS"
End DoDot:1
+17 IF '$TEST
SET XX2="SELECTED"
+18 SET XX2="PAYERS: "_XX2
+19 SET XX=$$SETSTR^VALM1(XX2,XX,62,18)
+20 SET VALMHDR(1)=XX
+21 ;
+22 ; Build 2nd Header Line
+23 SET ERAIEN=$GET(^TMP("RCPM_PARAMS",$JOB,"ERAIEN"))
+24 SET XX="ERA #: "_ERAIEN
+25 ; ERA Trace #
SET XX2=$$GET1^DIQ(344.4,ERAIEN_",",.02,"I")
+26 SET XX2="Trace #: "_XX2
+27 SET XX=$$SETSTR^VALM1(XX2,XX,20,60)
+28 SET VALMHDR(2)=XX
+29 ;
+30 ; Build 3rd Header Line
+31 ; ERA Payer TIN
SET YY=$$GET1^DIQ(344.4,ERAIEN_",",.03,"I")
+32 ; ERA Payer Name
SET XX=$$GET1^DIQ(344.4,ERAIEN_",",.06,"I")
+33 SET XX2=XX_"/"_YY
+34 if $LENGTH(XX2)>63
SET XX2=$EXTRACT(XX,1,79-$LENGTH(YY))_"/"_YY
+35 SET VALMHDR(3)="Payer Name/TIN: "_XX2
+36 ;
+37 ; Build 4TH Header Line
+38 ; ERA Total Amount Paid
SET YY=$$GET1^DIQ(344.4,ERAIEN_",",.05,"I")
+39 SET XX=" Total Amt Pd: "_$JUSTIFY(YY,12,2)
+40 SET VALMHDR(4)=XX
+41 ;
+42 SET VALMHDR(5)=""
+43 SET VALMHDR(6)=" # EFT # Trace Number Total Amt Pd"
+44 QUIT
+45 ;
INIT ;EP from listman template RCDPE EFT PARTIAL MATCH
+1 ; Display listman body
+2 ; Build the display of EFTs that are partially matched
+3 ; Input: ^TMP("RCPM_PARAMS",#J) - Selected Parameters
+4 NEW EFTAMT,EFTDR,EFTREM,EFTTIN,EFTTR,ERAIEN,ERATIN,ERATOT,ERATR,RCDTFR,RCDTTO,XX
+5 DO CLEAN^VALM10
+6 KILL ^TMP("RCPM-WL",$JOB),^TMP("RCPM-WL_WLDX",$JOB),^TMP($JOB,"RCPM_LIST")
+7 SET ERAIEN=$GET(^TMP("RCPM_PARAMS",$JOB,"ERAIEN"))
+8 SET XX=$GET(^TMP("RCPM_PARAMS",$JOB,"RCDT"))
+9 SET RCDTFR=+$PIECE(XX,"^",1)
+10 SET RCDTTO=$SELECT($PIECE(XX,"^",2):$PIECE(XX,"^",2),1:DT)
+11 ; ERA Payer TIN
SET ERATIN=$$GET1^DIQ(344.4,ERAIEN_",",.03,"I")
+12 SET ERATIN=$$UP^XLFSTR(ERATIN)
+13 ; ERA Trace #
SET ERATR=$$GET1^DIQ(344.4,ERAIEN_",",.02,"I")
+14 SET ERATR=$$UP^XLFSTR(ERATR)
+15 ; ERA Total Amount Paid
SET ERATOT=$$GET1^DIQ(344.4,ERAIEN_",",.05,"I")
+16 SET EFTIEN=0
+17 ;
+18 ; Search for all unmatched, not removed EFTs that are partially matched for
+19 ; the specified date range
+20 FOR
Begin DoDot:1
+21 SET EFTIEN=$ORDER(^RCY(344.31,"AMATCH",0,EFTIEN))
+22 if 'EFTIEN
QUIT
+23 ; User who removed EFT
SET EFTREM=$$GET1^DIQ(344.31,EFTIEN_",",.17,"I")
+24 ; Skip removed EFTs
if EFTREM'=""
QUIT
+25 ; Amount of Payment
SET EFTAMT=$$GET1^DIQ(344.31,EFTIEN_",",.07,"I")
+26 ; Skip EFTs with no Payment Amount
if 'EFTAMT
QUIT
+27 ; Date Received
SET EFTDR=$$GET1^DIQ(344.31,EFTIEN_",",.13,"I")
+28 ; Date Received before start of range
if $$FMDIFF^XLFDT(RCDTFR,EFTDR,1)>0
QUIT
+29 ; Date Received after end of range
if $$FMDIFF^XLFDT(EFTDR,RCDTTO,1)>0
QUIT
+30 ; Didn't pass selected filters
if '$$FILTEFT(EFTIEN)
QUIT
+31 ; Check for partial matched EFTs
DO EFTCHK(EFTIEN,ERATIN,ERATOT,ERATR)
End DoDot:1
if 'EFTIEN
QUIT
+32 ;
+33 ; Build the list main display
IF $DATA(^TMP($JOB,"RCPM_LIST"))
DO BLD
QUIT
+34 ;
+35 ; No EFTs found, display the message below in the list area
+36 SET ^TMP("RCPM-WL",$JOB,1,0)="THERE ARE NO EFTs MATCHING YOUR SELECTION CRITERIA"
+37 SET VALMCNT=0
+38 QUIT
+39 ;
EFTCHK(EFTIEN,ERATIN,ERATOT,ERATR) ; Check for partially matched EFTs
+1 ; Input: EFTIEN - IEN of the EFT being checked (#344.31)
+2 ; ERATIN - Payer TIN on the ERA record
+3 ; ERATOT - ERA Total Amount Paid
+4 ; ERATR - ERA Trace #
+5 ; Output: ^TMP($J,"RCPM_LIST,MATCHW,EFTSEQ)=A1^...^A11 Where
+6 ; MATCHW - Weighted number derived from partial matches
+7 ; EFTSEQ - Unique EFT Sequence #
+8 ; A1 - Number of matches between the ERA and the EFT
+9 ; A2 - Payer TIN # if matched, else ""
+10 ; A3 - Payer Trace # if matched, else ""
+11 ; A4 - Total Amount paid if matched else ""
+12 ; A5 - Matched weighted value
+13 ; 10 points for a match on Trace Number
+14 ; 5 points for a match on Total Amount
+15 ; 1 point for a match on TIN
+16 ; Only matches with a weigted value of 5 or more are displayed
+17 ; A6 - EFT IEN
+18 ; A7 - Deposit #
+19 ; A8 - Internal Deposit Date
+20 ; A9 - Payer Name/TIN (max 58 characters)
+21 ; A10- EFT Trace #
+22 ; A11- EFT Total Amount Paid
+23 NEW DEPDT,DEPNUM,EFTSEQ,EFTTOT,EFTTIN,EFTTR,MATCH,MATCHW,PAYNM,XX,YY
+24 ;
+25 ; IEN for 344.3
SET (EFTSEQ,XX)=$$GET1^DIQ(344.31,EFTIEN_",",.01,"I")
+26 ; Deposit #
SET DEPNUM=$$GET1^DIQ(344.3,XX_",",.06,"I")
+27 ; Deposit Date
SET DEPDT=$$GET1^DIQ(344.3,XX_",",.07,"I")
+28 if $EXTRACT(DEPNUM,1,3)="HAC"
QUIT
+29 SET MATCHW=0
SET MATCH=""
+30 ; EFT Transaction #
SET XX=$$GET1^DIQ(344.31,EFTIEN_",",.14,"I")
+31 ; EFT Sequence number
if XX'=""
SET EFTSEQ=EFTSEQ_"."_XX
+32 ; EFT Total Amount Paid
SET EFTTOT=$$GET1^DIQ(344.31,EFTIEN_",",.07,"I")
+33 ; EFT TIN
SET EFTTIN=$$GET1^DIQ(344.31,EFTIEN_",",.03,"I")
+34 SET EFTTIN=$$UP^XLFSTR(EFTTIN)
+35 ; EFT Trace #
SET EFTTR=$$GET1^DIQ(344.31,EFTIEN_",",.04,"I")
+36 SET EFTTR=$$UP^XLFSTR(EFTTR)
+37 ; Payer TIN match
IF EFTTIN=ERATIN
Begin DoDot:1
+38 SET MATCH=1
SET MATCHW=MATCHW+1
+39 SET $PIECE(MATCH,"^",2)=EFTTIN
End DoDot:1
+40 ; Trace # number match
IF EFTTR=ERATR
Begin DoDot:1
+41 SET XX=$PIECE(MATCH,"^",1)
SET MATCHW=MATCHW+10
+42 SET $PIECE(MATCH,"^",1)=XX+1
+43 SET $PIECE(MATCH,"^",3)=EFTTR
End DoDot:1
+44 ; Total Amount Paid match
IF EFTTOT=ERATOT
Begin DoDot:1
+45 SET XX=$PIECE(MATCH,"^",1)
SET MATCHW=MATCHW+5
+46 SET $PIECE(MATCH,"^",1)=XX+1
+47 SET $PIECE(MATCH,"^",4)=EFTTOT
End DoDot:1
+48 ; Only TIN match, skip
if MATCHW<5
QUIT
+49 ; EFT IEN
SET $PIECE(MATCH,"^",6)=EFTIEN
+50 ; Deposit #
SET $PIECE(MATCH,"^",7)=DEPNUM
+51 ; Deposit Date (internal)
SET $PIECE(MATCH,"^",8)=DEPDT
+52 ; EFT Payer Name
SET PAYNM=$$GET1^DIQ(344.31,EFTIEN_",",.02,"I")
+53 SET XX=PAYNM_"/"_EFTTIN
+54 if $LENGTH(XX)>73
SET XX=$EXTRACT(PAYNM,1,79-$LENGTH(EFTTIN))_"/"_EFTTIN
+55 SET $PIECE(MATCH,"^",9)=XX
+56 SET $PIECE(MATCH,"^",10)=EFTTR
+57 SET $PIECE(MATCH,"^",11)=EFTTOT
+58 SET ^TMP($JOB,"RCPM_LIST",MATCHW,EFTSEQ)=MATCH
+59 QUIT
+60 ;
FILTEFT(EFTIEN) ; Check to see if the EFT passes filter checks
+1 ; Input: EFTIEN - IEN for the EFT (#344.31)
+2 ; ^TMP("RCPM_PARAMS",$J,"RCPAYR") - Payer Selection - 'A','S' or 'R'
+3 ; ^TMP("RCPM_PARAMS",$J,"RCTYPE") - M/P/T Selection - 'A','M', 'P' or 'T'
+4 ; ^TMP("RCDPEU1",$J) - Selected payers if ALL not selected
+5 ; Returns: 1 if EFT passes filter checks, 0 otherwise
+6 NEW RCFLAG,RCPAY,RCTYPE,XX
+7 SET XX=$GET(^TMP("RCPM_PARAMS",$JOB,"RCPAYR"))
+8 SET RCPAY=$PIECE(XX,"^",1)
+9 SET RCTYPE=$GET(^TMP("RCPM_PARAMS",$JOB,"RCTYPE"))
+10 ;
+11 ; Payer filter check
+12 IF RCPAY'="A"
Begin DoDot:1
+13 SET XX=$$ISSEL^RCDPEU1(344.31,EFTIEN)
End DoDot:1
if 'XX
QUIT 0
+14 ;
+15 ; M/P/T filter check
+16 IF RCTYPE'="A"
Begin DoDot:1
+17 SET XX=$$ISTYPE^RCDPEU1(344.31,EFTIEN,RCTYPE)
End DoDot:1
if 'XX
QUIT 0
+18 QUIT 1
+19 ;
BLD ; Build listman dislay
+1 ; Input: ^TMP($J,"RCPM_LIST,MATCHW,EFTSEQ)=A1^...^A11 Where:
+2 ; MATCHW - Weighted number derived from partial matches
+3 ; EFTSEQ - Unique EFT Sequence #
+4 ; A1 - Number of matches between the ERA and the EFT
+5 ; A2 - Payer TIN # if matched, else ""
+6 ; A3 - Payer Trace # if matched, else ""
+7 ; A4 - Total Amount paid if matched else ""
+8 ; A5 - Matched weighted value
+9 ; 10 points for a match on Trace Number
+10 ; 5 points for a match on Total Amount
+11 ; 1 point for a match on TIN
+12 ; Only matches with a weigted value of 5 or more are displayed
+13 ; A6 - EFT IEN
+14 ; A7 - Deposit #
+15 ; A8 - Internal Deposit Date
+16 ; A9 - Payer Name/TIN (max 58 characters)
+17 ; A10- EFT Trace #
+18 ; A11- EFT Total Amount Paid
+19 NEW CTR,EFTSEQ,MATCH,MATCHW
+20 SET CTR=1
+21 SET VALMCNT=0
+22 SET MATCHW=""
+23 FOR
Begin DoDot:1
+24 SET MATCHW=$ORDER(^TMP($JOB,"RCPM_LIST",MATCHW),-1)
+25 if MATCHW=""
QUIT
+26 SET EFTSEQ=""
+27 FOR
Begin DoDot:2
+28 SET EFTSEQ=$ORDER(^TMP($JOB,"RCPM_LIST",MATCHW,EFTSEQ))
+29 if EFTSEQ=""
QUIT
+30 SET MATCH=^TMP($JOB,"RCPM_LIST",MATCHW,EFTSEQ)
+31 DO DISPEFT(MATCH,EFTSEQ,.CTR,.VALMCNT)
End DoDot:2
if EFTSEQ=""
QUIT
End DoDot:1
if MATCHW=""
QUIT
+32 ;
+33 KILL ^TMP($JOB,"RCPM_LIST")
+34 SET VALMSG="Enter ?? for more actions and help"
+35 QUIT
+36 ;
DISPEFT(MATCH,EFTSEQ,CTR,VALMCNT) ; Build the display for one EFT
+1 ; Input: MATCH - A1^...^A11 Where:
+2 ; A1 - Number of matches between the ERA and the EFT
+3 ; A2 - Payer TIN # if matched, else ""
+4 ; A3 - Payer Trace # if matched, else ""
+5 ; A4 - Total Amount paid if matched else ""
+6 ; A5 - Matched weighted value
+7 ; 10 points for a match on Trace Number
+8 ; 5 points for a match on Total Amount
+9 ; 1 point for a match on TIN
+10 ; Only matches with a weigted value of 5 or more are displayed
+11 ; A6 - EFT IEN
+12 ; A7 - Deposit #
+13 ; A8 - Internal Deposit Date
+14 ; A9 - Payer Name/TIN (max 58 characters)
+15 ; A10- EFT Trace #
+16 ; A11- EFT Total Amount Paid
+17 ; EFTSEQ - Unique EFT sequence #
+18 ; CTR - Current EFT counter
+19 ; VALMCNT - Current Listman body line counter
+20 ; Output: CTR - Updated EFT counter
+21 ; VALMCNT - Updated Listman body line counter
+22 NEW EFTIEN,X,XX,TT
+23 ; EFT IEN
SET EFTIEN=$PIECE(MATCH,"^",6)
+24 ;
+25 ; Build first display line of the EFT
+26 ; Trace Number
SET YY=$PIECE(MATCH,"^",10)
+27 SET X=$EXTRACT(CTR_$JUSTIFY("",4),1,4)_" "_$EXTRACT(EFTSEQ_$JUSTIFY("",10),1,10)_" "_$EXTRACT(YY_$JUSTIFY("",50),1,50)
+28 ; Total Amount Paid
SET X=X_" "_$JUSTIFY($PIECE(MATCH,"^",11),12,2)
+29 DO SET(X,CTR,EFTIEN,.VALMCNT)
+30 ;
+31 ; Build second display line of the EFT
+32 SET XX=$PIECE(MATCH,"^",9)
+33 ; Payer Name/TIN
SET X=" "_$EXTRACT(XX_$JUSTIFY("",73),1,73)
+34 DO SET(X,CTR,EFTIEN,.VALMCNT)
+35 ; Display blank line
DO SET(" ",CTR,"",.VALMCNT)
+36 SET CTR=CTR+1
+37 SET VALMSG="Enter ?? for more actions and help"
+38 QUIT
+39 ;
SET(X,RCSEQ,EFTIEN,VALMCNT) ; Set listman body and selection arrays
+1 ; Input: X - Data to set into the display line
+2 ; RCSEQ - Selectable line #
+3 ; EFTIEN - IEN of the EFT record (#344.31)
+4 ; VALMCNT - Current Display line counter
+5 ; ^TMP("RCPM-WL",$J) - Current global array of body display lines
+6 ; ^TMP("RCPM-WL_WLDX",$J,RCSEQ) -VALMCNT_"^"_EFTIEN
+7 ; Output: VALMCNT - Updated Display line counter
+8 ; ^TMP("RCPM--WL",$J,VALMCNT,0) - Updated display lines with new line
+9 ; ^TMP("RCPM-WL_WLDX",$J,RCSEQ) -VALMCNT_"^"_ERAIEN
+10 SET VALMCNT=VALMCNT+1
SET ^TMP("RCPM-WL",$JOB,VALMCNT,0)=X
+11 if $GET(RCSEQ)
SET ^TMP("RCPM-WL",$JOB,"IDX",VALMCNT,RCSEQ)=$GET(EFTIEN)
+12 if $GET(EFTIEN)
SET ^TMP("RCPM-WL_WLDX",$JOB,RCSEQ)=VALMCNT_"^"_EFTIEN
+13 QUIT
+14 ;
HELP ;EP from listman template RCDPE EFT PARTIAL MATCH
+1 ; help code
+2 SET X="?"
DO DISP^XQORM1
WRITE !!
+3 QUIT
+4 ;
EXIT ;EP from listman template RCDPE EFT PARTIAL MATCH
+1 ; Exit code
+2 KILL ^TMP("RCPM_PARAMS",$JOB),^TMP("RCDPEU1",$JOB)
+3 KILL ^TMP("RCPM-WL",$JOB),^TMP("RCPM-WL_WLDX",$JOB),^TMP($JOB,"RCPM_LIST")
+4 QUIT
+5 ;
SELEFT ;EP from RCDPE EFT PARTIAL MATCH SELECT
+1 ; Input: None
+2 ; Output: ^TMP($J,"SELEFT")-EFTIEN if an EFT was selected
+3 NEW PCNT,PROMPT,RCEFT,SEL
+4 DO FULL^VALM1
+5 SET VALM("ENTITY")="#"
+6 DO EN^VALM2($GET(XQORNOD(0)),"S")
+7 SET PCNT=$ORDER(VALMY(0))
+8 if 'PCNT
QUIT
+9 SET RCEFT=$PIECE(^TMP("RCPM-WL_WLDX",$JOB,PCNT),"^",2)
+10 if RCEFT=""
QUIT
+11 SET VALMBCK="R"
+12 SET RCQUIT=$$SHOWM(RCEFT)
+13 IF RCQUIT
SET VALMBCK="Q"
+14 QUIT
+15 ;
SHOWM(RCEFT) ; Show EFT details and ask user if this is the correct one
+1 ; Input : RCEFT - IEN of EFT from file 344.31
+2 ; Returns : 1 - If match was made, 0 - to refresh patial match list, -1 to exit
+3 ;
+4 NEW DEPDT,DEPNUM,RCQUIT
+5 DO GETDINFO^RCDPEM2(RCEFT,.DEPNUM,.DEPDT)
+6 WRITE !
+7 SET DIC="^RCY(344.31,"
SET DR="0"
SET DA=RCEFT
DO EN^DIQ
+8 WRITE " DEPOSIT NUMBER: ",DEPNUM,?40,"DEPOSIT DATE: ",DEPDT
+9 WRITE !
+10 SET DIR("A")="ARE YOU SURE THIS IS THE EFT YOU WANT TO MATCH?: "
SET DIR(0)="YA"
SET DIR("B")="YES"
DO ^DIR
KILL DIR
+11 IF $DATA(DUOUT)!$DATA(DTOUT)
SET RCQUIT=1
QUIT -1
+12 ; G ML1 CJE*4.5*332
IF Y'=1
QUIT 0
+13 ; Go to the Manual match, we have the ERA and EFT
+14 SET RCQUIT=0
+15 DO M12A^RCDPEM2
+16 IF RCQUIT
QUIT -1
+17 QUIT 1
