RCDPEU1 ;AITC/CJE - ELECTRONIC PAYER UTILITIES ; 7/1/19 1:08pm
;;4.5;Accounts Receivable;**326,332,349,432,446**;Mar 20, 1995;Build 15
;Per VA Directive 6402, this routine should not be modified.
Q
SELPAY(PARAM) ; EP
; New all purpose payer selection subroutine. Based off file 344.6
; Including options to include only given payer types (CHAMPVA/Medical/Pharmacy/Tricare/All)
; and to filter selection to include only payers that have entries in file 344.4 or 344.31
; This subroutine may be used to replace all previous payer seletion prompts.
; Input - PARAM array of parameters passed by reference
; PARAM("TYPE") - Types of payers to include in the selection (optional defaults to A)
; C - CHAMPVA, P - Pharmacy, T - Tricare, M - Medical (neither P nor T), A - All
; PARAM("FILE") - Only include payers that have entries on the ERA or EFT file (optional)
; 344.4 - ERA, 344.31 - EFT
; PARAM("SRCH") - Search by payer name or TIN (optional defaults to N)
; N - Payer Name, T - TIN
; PARAM("SELC") - Seclect individual payers, or range of payers (optional defaults to S)
; S - Selected payers, R - Range of payers
; PARAM("DICA") - Text that will be used to prompt the user (optional)
; defaults to "Select payer "_$S(PARAM("SRCH")="N":"name",1:"TIN")
;
; Output - ^TMP("RCDPEU1",$J,PAYERIEN)=""
; ^TMP("RCDPEU1",$J,"N",NAME,PAYERIEN)=""
; ^TMP("RCDPEU1",$J,"T",TIN,PAYERIEN)=""
; Where:
; PAYERIEN = Internal entry number of the payer from file 344.6
; NAME = Payer name, TIN = Payer TIN
; FLAG = Pharmacy or Tricare or Medical flag based on Pharmacy and Tricare flags from file 344.6
; T - has tricare flag, P - has pharmacy flag, M - has neither T or P flag.
;
; Returns - 1 - Success, -1 - Abort
;
N RCA,RET,RETURN,QUIT
;
D INIT
S RETURN=1
;
S QUIT=0
I PARAM("SELC")="R" D ;
. S RCA="Select START range for payer names: "
. F S RET=$$PROMPT(.PARAM,RCA) Q:(RET'=0) D RMESS
. I RET=-1 S RETURN=-1 Q
. S RCA="Select END range for payer names: "
. F S RET=$$PROMPT(.PARAM,RCA) Q:(RET'=0) D RMESS
. I RET=-1 S RETURN=-1 Q
. D EXPAND
;
I PARAM("SELC")="S" D ;
. S QUIT=0
. F D Q:QUIT ;
. . S RET=$$PROMPT(.PARAM,PARAM("DICA"))
. . I RET=-1 S RETURN=-1,QUIT=1 Q
. . I RET=0 D ;
. . . I $D(^TMP("RCDPEU1",$J)) S QUIT=1
. . . E D RMESS
;
I RETURN=-1 D CLEAN Q -1
S RETURN=$S($D(^TMP("RCDPEU1",$J)):1,1:-1)
Q RETURN
;
PROMPT(PARAM,RCA) ; Prompt for a payer from file 344.6 with various filter options
; Input: PARAM - array of parameters defined in subroutine SELPAY above
; Output: ^TMP("RCDPEU1",$J) as defined in subroutine SELPAY above
; Returns: 1 - Payer selected
; 0 - No payer selected
; -1 - user typed '^' or timed out
;
N DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,RETURN,X,Y
S RETURN=1
;
I PARAM("SRCH")="N" D ; Select payers by name
. S DIC=344.6
. S DIC(0)="QEA"
. S DIC("A")=RCA
. S DIC("S")="I $$CHKPAY^RCDPEU1(Y,"""_PARAM("TYPE")_""","""_PARAM("FILE")_""")"
. I PARAM("SELC")="R",$D(^TMP("RCDPEU1",$J)) D ; Choosing second name of a range
. . S DIC("S")=DIC("S")_",$$CHKRNG^RCDPEU1(Y)" ; only offer payer names that follow start range
. D ^DIC
. I $D(DTOUT)!$D(DUOUT) S RETURN=-1 Q
. I Y=-1 S RETURN=0 Q
. D ADDPAY(+Y)
;
I PARAM("SRCH")="T" D ; Select payers by TIN
. N RET
. S DIR("A")="Select Insurance Company TIN"
. S DIR(0)="FO^1:30"
. S DIR("?")="Enter the TIN of the payer or '??' to list payers"
. S DIR("??")="^D TLIST^RCDPEU1"
. D ^DIR
. I $D(DTOUT)!$D(DUOUT) S RETURN=-1 Q
. I Y="" S RETURN=0 Q
. S RET=$$SRCHTIN(Y,.PARAM)
. I RET=-1 S RETURN=-1 Q
. I RET'="" D ADDTIN(RET)
Q RETURN
;
EXPAND ; Expand range of payer names given start and end points.
; Input: Start and end points of the range in the global ^TMP("RCDPEU1",$J) documented in SELPAY above.
; Output: More enntries in ^TMP("RCDPEU1",$J), one for each matching payer in the range.
N K1,NAME
S NAME(1)=$O(^TMP("RCDPEU1",$J,"N",""))
S NAME(2)=$O(^TMP("RCDPEU1",$J,"N",""),-1) ; Note if user picks same name as start and end range 1=2
;
D EXPANDX(NAME(1))
;
S K1=NAME(1)
F S K1=$O(^RCY(344.6,"B",K1)) Q:K1=""!(K1]NAME(2)) D EXPANDX(K1)
Q
EXPANDX(NAME) ; Add all payers with the same name into the list
; Input: NAME - Payer Name
; PARAM - Input parameters
; Output: ^TMP("RCDPEU1",$J)
N PAYIEN
S PAYIEN=""
F S PAYIEN=$O(^RCY(344.6,"B",NAME,PAYIEN)) Q:PAYIEN="" D ;
. I $$CHKPAY(PAYIEN,PARAM("TYPE"),PARAM("FILE")) D ADDPAY(PAYIEN)
Q
;
ADDPAY(PAYIEN) ; Add payer to the output array.
; Input - PAYIEN = Internal entry number from file #344.6
; Output - New entries in ^TMP("RCDPEU1",$J
N NAME,TIN
S ^TMP("RCDPEU1",$J,PAYIEN)=""
S NAME=$$GET1^DIQ(344.6,PAYIEN_",",.01,"E")
S TIN=$$GET1^DIQ(344.6,PAYIEN_",",.02,"E")
S ^TMP("RCDPEU1",$J,"N",NAME,TIN,PAYIEN)=""
S ^TMP("RCDPEU1",$J,"T",TIN,NAME,PAYIEN)=""
Q
ADDTIN(TIN) ; Add all payers with TIN to the output array
; Input - Payer Identifer string (TIN) matching one or more entries in file #344.6
N PAYIEN
S PAYIEN=""
F S PAYIEN=$O(^RCY(344.6,"C",TIN,PAYIEN)) Q:'PAYIEN D ;
. D ADDPAY(PAYIEN)
Q
SRCHTIN(RCX,PARAM) ; Given user input narrow down the TIN that the user wants
; Input: RCX - User input to use in TIN lookup.
; PARAM - array of input parameters (see subroutine SELPAY for detailed description)
N CNT,COUNT,DIR,DTOUT,DUOUT,K1,K2,K3,LIST,QUIT,RETURN,SPACE,SX,X,Y
I $D(^RCY(344.6,"C",RCX_" ")) D CHKTIN(RCX_" ",.PARAM,.LIST)
S K1=RCX_" "
F S K1=$O(^RCY(344.6,"C",K1)) Q:K1=""!($E(K1,1,$L(RCX))'=RCX) D ;
. D CHKTIN(K1,.PARAM,.LIST)
;
I '$D(LIST) D Q 0
. W !,"No matching TIN found",!
;
S COUNT=0,K1=""
F S K1=$O(LIST("T",K1)) Q:K1="" D ;
. S COUNT=COUNT+1
. S LIST(COUNT)=K1
; Show results and let user pick a TIN by sequence number or TIN
S (COUNT,K1,K2,K3,RETURN)="",(CNT,QUIT,SX)=0
F S COUNT=$O(LIST(COUNT)) Q:'COUNT D I QUIT Q
. S CNT=CNT+1
. W !,$J(COUNT_".",4)_" " S SPACE=0
. S K1=LIST(COUNT)
. F S K2=$O(LIST("T",K1,K2)) Q:K2="" D I QUIT Q
. . I SPACE W !," "
. . W $E(K1_$J("",31),1,30)
. . W $E(K2,1,42)
. . I 'SPACE S SPACE=1
S DIR(0)="NO^1:"_CNT_":0"
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q -1
I Y S RETURN=LIST(Y)
Q RETURN
;
CHKPAY(PAYIEN,TYPE,FILE) ; Check if payer meets the filter requirements
; Input: PAYIEN - Internal entry number of the payer from file 344.6
; TYPE - C - CHAMPVA, M - Medical, P - Pharmacy, T- Tricare, A - All
; FILE - 344.4 - ERA, 344.31 EFT - Payer must have entries in the given file
; Return: 1 - Payer matches the filter criteria, otherwise 0.
;
N NAME,FLAG,RETURN,TIN
I TYPE="A",FILE="" Q 1
;
S RETURN=1
I TYPE'="A" D I 'RETURN Q 0
. S RETURN=$$CHKTYPE(PAYIEN,TYPE)
;
I FILE D I 'RETURN Q 0
. S NAME=$$GET1^DIQ(344.6,PAYIEN_",",.01,"I")
. S TIN=$$GET1^DIQ(344.6,PAYIEN_",",.02,"I")
. I '$D(^RCY(FILE,"APT",NAME,TIN)) S RETURN=0
Q 1
CHKRNG(PAYIEN) ; Check if second picked payer name follows the first
; Input: PAYIEN = Internal entry number of payer from file #344.6
; ^TMP("RCDPEU1",$J global array contains previously picked payer
; Return: 1 - if PAYIEN's name follows that of payer in ^TMP, otherwise 0
;
N NAME,RETURN
S RETURN=0
S NAME(1)=$O(^TMP("RCDPEU1",$J,"N",""))
S NAME(2)=$$GET1^DIQ(344.6,PAYIEN_",",.01,"E")
I NAME(2)]NAME(1)!(NAME(2)=NAME(1)) S RETURN=1
Q RETURN
;
CHKTIN(TIN,PARAM,OUT) ; Given a TIN check filter criteria and add passing entries to the OUT array
; Input: TIN = Payer Identifier string that matches one or more payers in file #344.6
; PARAM = Input parameter array. See subroutine SELPAY for detailed documentation
; Output: OUT (passed by reference) array of payers matching filter parameters. Sorted by TIN then NAME
N PAYIEN
S PAYIEN=""
F S PAYIEN=$O(^RCY(344.6,"C",TIN,PAYIEN)) Q:PAYIEN="" D ;
. I $$CHKPAY(PAYIEN,PARAM("TYPE"),PARAM("FILE")) D ;
. . N PNAME
. . S PNAME=$$GET1^DIQ(344.6,PAYIEN_",",.01,"E")
. . I PNAME="" Q
. . S OUT("T",TIN,PNAME,PAYIEN)=""
Q
TLIST ; List TINS for user help. Only TINS matching filter criteria are displayed.
N COUNT,PAYIEN,QUIT,TIN
S (QUIT,COUNT)=0
S TIN=""
F S TIN=$O(^RCY(344.6,"C",TIN)) Q:TIN="" D I QUIT Q
. S PAYIEN=""
. F S PAYIEN=$O(^RCY(344.6,"C",TIN,PAYIEN)) Q:PAYIEN="" D I QUIT Q
. . I '$$CHKPAY(PAYIEN,$G(PARAM("TYPE"),"A"),$G(PARAM("FILE"))) Q
. . S COUNT=COUNT+1
. . I COUNT>21 S COUNT=1 I '$$GOON^VALM1() S QUIT=1 Q
. . W !,$E(TIN_$J("",30),1,30)_" "_$E($$GET1^DIQ(344.6,PAYIEN_",",.01,"E"),1,39)
Q
INIT ; Initialize parameters and return array
; Input - PARAM array see comments for SELPAY above
;
S PARAM("TYPE")=$G(PARAM("TYPE"),"A")
S PARAM("FILE")=$G(PARAM("FILE"))
S PARAM("SRCH")=$G(PARAM("SRCH"),"N")
S PARAM("SELC")=$G(PARAM("SELC"),"S")
S PARAM("DICA")=$G(PARAM("DICA"),"Select payer "_$S(PARAM("SRCH")="N":"name",1:"TIN")_": ")
;
K ^TMP("RCDPEU1",$J)
Q
CLEAN ; Clean up output array if user aborts
K ^TMP("RCDPEU1",$J)
Q
RTYPE(DEF) ;EP
; Input: DEF - Value to use a default
; Returns: -1 - User ^ or timed out
; A - User selected ALL
; C - User selected CHAMPVA
; M - User selected MEDICAL
; P - User selected PHARMACY
; B - User selected BOTH
N DA,DIR,DTOUT,DUOUT,X,Y,DIRUT,DIROUT,RCTYPE,RETURN
S RCTYPE=""
S DIR("?")="Enter the type of payer to include"
S DIR(0)="SA^C:CHAMPVA;M:MEDICAL;P:PHARMACY;T:TRICARE;A:ALL" ; PRCA*4.5*432
S DIR("A")="(C)HAMPVA, (M)EDICAL, (P)HARMACY, (T)RICARE or (A)LL: " ; PRCA*4.5*432
S DIR("B")=$S($G(DEF)'="":DEF,1:"ALL")
D ^DIR
K DIR
I $D(DTOUT)!$D(DUOUT) Q -1
Q:Y="" "A"
S RETURN=$E(Y)
; If CHAMPVA, Pharmacy or Tricare chosen, check if payers exist and if not give warning
I (RETURN="P"&('$D(^RCY(344.6,"ARX",1)))) D WARN("pharmacy")
I (RETURN="T"&('$D(^RCY(344.6,"ATR",1)))) D WARN("tricare")
I (RETURN="C"&('$D(^RCY(344.6,"ACH",1)))) D WARN("CHAMPVA") ; PRCA*4.5*432
Q RETURN
;
CLOSEDC(DEF) ;EP
; PRCA*4.5*349 - Added subroutine
; Input: DEF - Value to use a default
; Optional, Defaults to ""
; Returns: -1 - User ^ or timed out
; A - User selected ALL
; C - User selected CLOSED
N DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,RCCLM,RETURN,X,Y
S RCCLM=""
S DIR("?")="Enter ALL to select all claims or CLOSED to select only closed claims."
S DIR(0)="SA^A:ALL;C:CLOSED"
S DIR("A")="Include (A)LL Claims or only (C)LOSED Claims: " ; PRCA*4.5*446 fix typo "Inlcude" -> "Include"
S DIR("B")=$S($G(DEF)'="":DEF,1:"ALL")
D ^DIR
K DIR
I $D(DTOUT)!$D(DUOUT) Q -1
Q:Y="" "A"
S RETURN=$E(Y)
Q RETURN
;
PAYTYPE(NAME,TIN,TYPE) ; EP
; Is a payer Medical, Pharmacy or Tricare based on flags in the payer exclusion file.
; Inputs: NAME - The free text name of the payer
; TIN - The ID if the payer
; TYPE - M : Medical, P : Pharmacy, T: Tricare
; Returns : 1 - Yes, payer matches type, 0 - No, payer does not match type
N IEN,FLAG
S IEN=$$GETPAY(NAME,TIN)
I 'IEN Q 0
Q $$CHKTYPE(IEN,TYPE)
;
GETPAY(NAME,TIN) ; EP - Get payer IEN given name and TIN
; Inputs: NAME - The free text name of the payer
; TIN - The ID if the payer
; Returns: Internal entry number from file 344.6
I NAME=""!(TIN)="" Q 0
Q +$O(^RCY(344.6,"CPID",NAME,TIN,""))
;
CHKTYPE(IEN,TYPE) ; EP
; Inputs: IEN - Internal entry number from file 344.6
; TYPE - C - CHAMPVA, M : Medical, P : Pharmacy, T: Tricare, A: All
; Returns: 1 if the payer matches the type, otherwise 0
I TYPE="A" Q 1
S FLAG("P")=+$$GET1^DIQ(344.6,IEN_",",.09,"I")
S FLAG("T")=+$$GET1^DIQ(344.6,IEN_",",.1,"I")
S FLAG("C")=+$$GET1^DIQ(344.6,IEN_",",.15,"I") ; PRCA*4.5*432
;
I TYPE="T",FLAG("T") Q 1
I TYPE="P",FLAG("P") Q 1
I TYPE="C",FLAG("C") Q 1 ; PRCA*4.5*432
I TYPE="M",'FLAG("P"),'FLAG("T"),'FLAG("C") Q 1 ; PRCA*4.5*432
Q 0
ISTYPE(FILE,IEN,TYPE) ; EP
; Check if payer is a given type based on IEN from a FILE
; Input: FILE - file from which to get Payer name and TIN
; allowed values 344.4 - ERA, 344.31 - EFT, 361.1 - EOB
; IEN - Internal entry number of entry in FILE
; TYPE - C : CHAMPVA, M : Medical, P : Pharmacy, T: Tricare
; Return 1 - payer matches type, else 0.
I TYPE="A" Q 1
N IEN3444,NAME,TIN
; For EOB try to get Payer from associated ERA, if none exists use TIN only to check the type.
I FILE=361.1 D I FILE=361.1 Q $$EOBTYP(IEN,TYPE) ;
. S IEN3444=$$EOBERA(IEN)
. I IEN3444 S FILE=344.4,IEN=IEN3444
;
S NAME=$$GETNAME(FILE,IEN)
S TIN=$$GETTIN(FILE,IEN)
I NAME=""!(TIN="") Q 0
Q $$PAYTYPE(NAME,TIN,TYPE)
;
ISSEL(FILE,IEN,RCJOB) ; EP
; Check if payer was selected by the user give the file and IEN
; Input: FILE - file from which to get Payer name and TIN
; allowed values 344.4 - ERA, 344.31 - EFT, 361.1 - EOB
; IEN - Internal entry number of entry in FILE
; Return 1 - payer was selected, else 0.
;
N IEN3444,NAME,RETURN,TIN
S RETURN=0
S RCJOB=$G(RCJOB,$J)
I FILE=361.1 D I FILE=361.1 Q RETURN
. S IEN3444=$$EOBERA(IEN)
. I IEN3444 D ;
. . S FILE=344.4,IEN=IEN3444
. E D ;
. . S TIN=$$GET1^DIQ(361.1,IEN_",",.03,"E")
. . I $D(^TMP("RCDPEU1",RCJOB,"T",TIN))
;
S NAME=$$GETNAME(FILE,IEN)
S TIN=$$GETTIN(FILE,IEN)
I NAME=""!(TIN="") Q 0
I $D(^TMP("RCDPEU1",RCJOB,"N",NAME,TIN)) S RETURN=1
Q RETURN
;
GETNAME(FILE,IEN) ; Get Payer Name give file and IEN
N FIELD
S FIELD=$S(FILE=344.4:.06,1:.02)
Q $$GET1^DIQ(FILE,IEN_",",FIELD,"E")
;
GETTIN(FILE,IEN) ; Get Payer TIN give file and IEN
N FIELD
S FIELD=.03
Q $$GET1^DIQ(FILE,IEN_",",FIELD,"E")
;
PAYRNG(MIXED,BLANKLN,NMORTIN,PROMPT) ; How does the user want to select payers?
; Input: MIXED - 1 to display prompts in mixed case
; Optional, defaults to 0
; BLANKLN - 0 skip initial blank line
; Optional, defaults to 1
; NMORTIN - 1 to look-up Payer by Payer Name, 2 to look-up by TIN
; 0 or undefined - pre-326 behavior, look-up by payer name and don't include TIN in output array.
; Optional, defaults to 0
; PROMPT - Alternative prompt
;
; Output: ^TMP("RCSELPAY",$J) - Array of selected Payers
; Returns: A - All, S - Selected, R - Range, (-1) - User '^' or timeout
;
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,RTNFLG,TIN,X,XX,Y
S:'$D(MIXED) MIXED=0
S:'$D(BLANKLN) BLANKLN=1
S:'$D(NMORTIN) NMORTIN=0
I '$D(PROMPT) S PROMPT=$S(MIXED:"Run Report for",1:"RUN REPORT FOR") ; PRCA*4.5*332
;
S RTNFLG=0
;
; Select option required (All, Selected or Range)
I NMORTIN=2 D
. S DIR(0)="SA^A:ALL;S:SPECIFIC"
. S:MIXED DIR("A")=PROMPT_" (A)LL or (S)PECIFIC Insurance Companies?: " ; PRCA*4.5*332
. S:'MIXED DIR("A")=PROMPT_" (A)LL OR (S)PECIFIC INSURANCE COMPANIES?: " ; PRCA*4.5*332
E D
. S DIR(0)="SA^A:ALL;S:SPECIFIC;R:RANGE"
. S:MIXED DIR("A")=PROMPT_" (A)LL, (S)PECIFIC, or (R)ANGE of Insurance Companies?: " ; PRCA*4.5*332
. S:'MIXED DIR("A")=PROMPT_" (A)LL, (S)PECIFIC, OR (R)ANGE OF INSURANCE COMPANIES?: " ; PRCA*4.5*332
. S DIR("?",2)="Enter 'RANGE' to select an Insurance Company range."
S DIR("B")="ALL"
S DIR("?",1)="Enter 'ALL' to select all Insurance Companies."
S DIR("?")="Enter 'SPECIFIC' to select specific Insurance Companies."
W:BLANKLN ! ; PRCA*4.5*318 - Added condition for BLANKLN
D ^DIR K DIR
;
; Abort on ^ exit or timeout
I $D(DTOUT)!$D(DUOUT) S RTNFLG=-1 Q RTNFLG
;
Q Y
EOBERA(IEN3611) ; Get ERA that corresponds to an EOB so we can find payers.
; Input IEN3611 - Internal entry from file 361.1 EOB
; Returns - Internal entry number from file 344.4 ERA
; use reverse $Order to get the latest ERA in case there is more than one.
Q $O(^RCY(344.4,"ADET",+IEN3611,"A"),-1)
;
EOBTYP(IEN3611,TYPE) ; If EOB has no ERA, use TIN from EOB to determine M/P/T type
; Input IEN3611 - Internal entry from file 361.1 EOB
; TYPE - M : Medical, P : Pharmacy, T: Tricare
; Returns - 1 at least one payer with TIN is of type TYPE
N IEN,TIN
S RETURN=0
S TIN=$$GET1^DIQ(361.1,IEN3611_",",.03,"E")
I TIN'="" D ;
. S IEN=""
. F S IEN=$O(^RCY(344.6,"C",TIN_" ",IEN)) Q:'IEN D Q:RETURN=1
. . S RETURN=$$CHKTYPE(IEN,TYPE)
Q RETURN
;
RMESS ; Output message that entry is required.
W !!,"You must select "
W $S(PARAM("SELC")="R":"a",1:"at least one")_" "
W $S(PARAM("SRCH")="N":"payer",1:"TIN"),*7,!
Q
;
WARN(TYPE) ; Warn user that no payers of TYPE have been flagged
; Input: TYPE - C=CHAMPVA, P=Pharmacy, T=Tricare
; Output: warning message to screen.
W !!,"WARNING - There are no "_TYPE_" payers flagged in the system."
W !," Please use the Identify Payers option to flag payers.",*7
Q
;
ASKAUTO(DEF) ; EP from RCDPENR2 - added for PRCA*4.5*349
; Input: DEF - Value to use a default, optional, defaults to "BOTH"
; Returns: -1 - User ^ or timed out
; A - Include autoposted only
; N - Include manually posted only
; B - Include both types
;
N DA,DIR,DTOUT,DUOUT,X,Y,DIRUT,DIROUT,RCTYPE,RETURN
S RCTYPE=""
S DIR("?",1)="Enter 'A' to include only auto-posted entries"
S DIR("?",2)=" 'M' to include only manually posted entries"
S DIR("?")=" 'B' to include both"
S DIR(0)="SA^A:AUTO-POSTED;M:MANUALLY POSTED;B:BOTH"
S DIR("A")="(A)UTO-POSTED, (M)ANUALLY POSTED, (B)OTH: "
S DIR("B")=$S($G(DEF)'="":DEF,1:"BOTH")
D ^DIR
K DIR
I $D(DTOUT)!$D(DUOUT) Q -1
Q:Y="" "B"
S RETURN=$E(Y)
Q $S(RETURN="M":"N",1:RETURN) ; N=NON-AUTO-POSTED same as MANUAL
;
CHKEFT(EFTDA) ; EP from RCDPENR3 - Check to see if a EFT is posted - added for PRCA*4.5*349
; Input EFTDA - Internal entru number from 344.31
; Returns 1 if EFT is posted, otherwise 0
;
N ERAREC,IEN344,RETURN,POSTSTAT
S RETURN=0
S ERAREC=+$$GET1^DIQ(344.31,EFTDA_",",.1,"I") ; Pointer to ERA record
I ERAREC D ;
. S POSTSTAT=$$GET1^DIQ(344.4,ERAREC_",",.14,"I")
. I POSTSTAT,"125"[POSTSTAT S RETURN=1 ; Matched to posted, manually posted or partialy posted ERA
E I $$GET1^DIQ(344.31,EFTDA_",",.08,"I")=2 D ; EFT matched to Paper EOB, check if receipt is processed
. S IEN344=$O(^RCY(344,"AEFT",EFTDA,0))
. I IEN344,$$GET1^DIQ(344,IEN344_",",.14,"I")'=1 S RETURN=1
Q RETURN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEU1 18991 printed Sep 23, 2025@19:21:39 Page 2
RCDPEU1 ;AITC/CJE - ELECTRONIC PAYER UTILITIES ; 7/1/19 1:08pm
+1 ;;4.5;Accounts Receivable;**326,332,349,432,446**;Mar 20, 1995;Build 15
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
SELPAY(PARAM) ; EP
+1 ; New all purpose payer selection subroutine. Based off file 344.6
+2 ; Including options to include only given payer types (CHAMPVA/Medical/Pharmacy/Tricare/All)
+3 ; and to filter selection to include only payers that have entries in file 344.4 or 344.31
+4 ; This subroutine may be used to replace all previous payer seletion prompts.
+5 ; Input - PARAM array of parameters passed by reference
+6 ; PARAM("TYPE") - Types of payers to include in the selection (optional defaults to A)
+7 ; C - CHAMPVA, P - Pharmacy, T - Tricare, M - Medical (neither P nor T), A - All
+8 ; PARAM("FILE") - Only include payers that have entries on the ERA or EFT file (optional)
+9 ; 344.4 - ERA, 344.31 - EFT
+10 ; PARAM("SRCH") - Search by payer name or TIN (optional defaults to N)
+11 ; N - Payer Name, T - TIN
+12 ; PARAM("SELC") - Seclect individual payers, or range of payers (optional defaults to S)
+13 ; S - Selected payers, R - Range of payers
+14 ; PARAM("DICA") - Text that will be used to prompt the user (optional)
+15 ; defaults to "Select payer "_$S(PARAM("SRCH")="N":"name",1:"TIN")
+16 ;
+17 ; Output - ^TMP("RCDPEU1",$J,PAYERIEN)=""
+18 ; ^TMP("RCDPEU1",$J,"N",NAME,PAYERIEN)=""
+19 ; ^TMP("RCDPEU1",$J,"T",TIN,PAYERIEN)=""
+20 ; Where:
+21 ; PAYERIEN = Internal entry number of the payer from file 344.6
+22 ; NAME = Payer name, TIN = Payer TIN
+23 ; FLAG = Pharmacy or Tricare or Medical flag based on Pharmacy and Tricare flags from file 344.6
+24 ; T - has tricare flag, P - has pharmacy flag, M - has neither T or P flag.
+25 ;
+26 ; Returns - 1 - Success, -1 - Abort
+27 ;
+28 NEW RCA,RET,RETURN,QUIT
+29 ;
+30 DO INIT
+31 SET RETURN=1
+32 ;
+33 SET QUIT=0
+34 ;
IF PARAM("SELC")="R"
Begin DoDot:1
+35 SET RCA="Select START range for payer names: "
+36 FOR
SET RET=$$PROMPT(.PARAM,RCA)
if (RET'=0)
QUIT
DO RMESS
+37 IF RET=-1
SET RETURN=-1
QUIT
+38 SET RCA="Select END range for payer names: "
+39 FOR
SET RET=$$PROMPT(.PARAM,RCA)
if (RET'=0)
QUIT
DO RMESS
+40 IF RET=-1
SET RETURN=-1
QUIT
+41 DO EXPAND
End DoDot:1
+42 ;
+43 ;
IF PARAM("SELC")="S"
Begin DoDot:1
+44 SET QUIT=0
+45 ;
FOR
Begin DoDot:2
+46 SET RET=$$PROMPT(.PARAM,PARAM("DICA"))
+47 IF RET=-1
SET RETURN=-1
SET QUIT=1
QUIT
+48 ;
IF RET=0
Begin DoDot:3
+49 IF $DATA(^TMP("RCDPEU1",$JOB))
SET QUIT=1
+50 IF '$TEST
DO RMESS
End DoDot:3
End DoDot:2
if QUIT
QUIT
End DoDot:1
+51 ;
+52 IF RETURN=-1
DO CLEAN
QUIT -1
+53 SET RETURN=$SELECT($DATA(^TMP("RCDPEU1",$JOB)):1,1:-1)
+54 QUIT RETURN
+55 ;
PROMPT(PARAM,RCA) ; Prompt for a payer from file 344.6 with various filter options
+1 ; Input: PARAM - array of parameters defined in subroutine SELPAY above
+2 ; Output: ^TMP("RCDPEU1",$J) as defined in subroutine SELPAY above
+3 ; Returns: 1 - Payer selected
+4 ; 0 - No payer selected
+5 ; -1 - user typed '^' or timed out
+6 ;
+7 NEW DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,RETURN,X,Y
+8 SET RETURN=1
+9 ;
+10 ; Select payers by name
IF PARAM("SRCH")="N"
Begin DoDot:1
+11 SET DIC=344.6
+12 SET DIC(0)="QEA"
+13 SET DIC("A")=RCA
+14 SET DIC("S")="I $$CHKPAY^RCDPEU1(Y,"""_PARAM("TYPE")_""","""_PARAM("FILE")_""")"
+15 ; Choosing second name of a range
IF PARAM("SELC")="R"
IF $DATA(^TMP("RCDPEU1",$JOB))
Begin DoDot:2
+16 ; only offer payer names that follow start range
SET DIC("S")=DIC("S")_",$$CHKRNG^RCDPEU1(Y)"
End DoDot:2
+17 DO ^DIC
+18 IF $DATA(DTOUT)!$DATA(DUOUT)
SET RETURN=-1
QUIT
+19 IF Y=-1
SET RETURN=0
QUIT
+20 DO ADDPAY(+Y)
End DoDot:1
+21 ;
+22 ; Select payers by TIN
IF PARAM("SRCH")="T"
Begin DoDot:1
+23 NEW RET
+24 SET DIR("A")="Select Insurance Company TIN"
+25 SET DIR(0)="FO^1:30"
+26 SET DIR("?")="Enter the TIN of the payer or '??' to list payers"
+27 SET DIR("??")="^D TLIST^RCDPEU1"
+28 DO ^DIR
+29 IF $DATA(DTOUT)!$DATA(DUOUT)
SET RETURN=-1
QUIT
+30 IF Y=""
SET RETURN=0
QUIT
+31 SET RET=$$SRCHTIN(Y,.PARAM)
+32 IF RET=-1
SET RETURN=-1
QUIT
+33 IF RET'=""
DO ADDTIN(RET)
End DoDot:1
+34 QUIT RETURN
+35 ;
EXPAND ; Expand range of payer names given start and end points.
+1 ; Input: Start and end points of the range in the global ^TMP("RCDPEU1",$J) documented in SELPAY above.
+2 ; Output: More enntries in ^TMP("RCDPEU1",$J), one for each matching payer in the range.
+3 NEW K1,NAME
+4 SET NAME(1)=$ORDER(^TMP("RCDPEU1",$JOB,"N",""))
+5 ; Note if user picks same name as start and end range 1=2
SET NAME(2)=$ORDER(^TMP("RCDPEU1",$JOB,"N",""),-1)
+6 ;
+7 DO EXPANDX(NAME(1))
+8 ;
+9 SET K1=NAME(1)
+10 FOR
SET K1=$ORDER(^RCY(344.6,"B",K1))
if K1=""!(K1]NAME(2))
QUIT
DO EXPANDX(K1)
+11 QUIT
EXPANDX(NAME) ; Add all payers with the same name into the list
+1 ; Input: NAME - Payer Name
+2 ; PARAM - Input parameters
+3 ; Output: ^TMP("RCDPEU1",$J)
+4 NEW PAYIEN
+5 SET PAYIEN=""
+6 ;
FOR
SET PAYIEN=$ORDER(^RCY(344.6,"B",NAME,PAYIEN))
if PAYIEN=""
QUIT
Begin DoDot:1
+7 IF $$CHKPAY(PAYIEN,PARAM("TYPE"),PARAM("FILE"))
DO ADDPAY(PAYIEN)
End DoDot:1
+8 QUIT
+9 ;
ADDPAY(PAYIEN) ; Add payer to the output array.
+1 ; Input - PAYIEN = Internal entry number from file #344.6
+2 ; Output - New entries in ^TMP("RCDPEU1",$J
+3 NEW NAME,TIN
+4 SET ^TMP("RCDPEU1",$JOB,PAYIEN)=""
+5 SET NAME=$$GET1^DIQ(344.6,PAYIEN_",",.01,"E")
+6 SET TIN=$$GET1^DIQ(344.6,PAYIEN_",",.02,"E")
+7 SET ^TMP("RCDPEU1",$JOB,"N",NAME,TIN,PAYIEN)=""
+8 SET ^TMP("RCDPEU1",$JOB,"T",TIN,NAME,PAYIEN)=""
+9 QUIT
ADDTIN(TIN) ; Add all payers with TIN to the output array
+1 ; Input - Payer Identifer string (TIN) matching one or more entries in file #344.6
+2 NEW PAYIEN
+3 SET PAYIEN=""
+4 ;
FOR
SET PAYIEN=$ORDER(^RCY(344.6,"C",TIN,PAYIEN))
if 'PAYIEN
QUIT
Begin DoDot:1
+5 DO ADDPAY(PAYIEN)
End DoDot:1
+6 QUIT
SRCHTIN(RCX,PARAM) ; Given user input narrow down the TIN that the user wants
+1 ; Input: RCX - User input to use in TIN lookup.
+2 ; PARAM - array of input parameters (see subroutine SELPAY for detailed description)
+3 NEW CNT,COUNT,DIR,DTOUT,DUOUT,K1,K2,K3,LIST,QUIT,RETURN,SPACE,SX,X,Y
+4 IF $DATA(^RCY(344.6,"C",RCX_" "))
DO CHKTIN(RCX_" ",.PARAM,.LIST)
+5 SET K1=RCX_" "
+6 ;
FOR
SET K1=$ORDER(^RCY(344.6,"C",K1))
if K1=""!($EXTRACT(K1,1,$LENGTH(RCX))'=RCX)
QUIT
Begin DoDot:1
+7 DO CHKTIN(K1,.PARAM,.LIST)
End DoDot:1
+8 ;
+9 IF '$DATA(LIST)
Begin DoDot:1
+10 WRITE !,"No matching TIN found",!
End DoDot:1
QUIT 0
+11 ;
+12 SET COUNT=0
SET K1=""
+13 ;
FOR
SET K1=$ORDER(LIST("T",K1))
if K1=""
QUIT
Begin DoDot:1
+14 SET COUNT=COUNT+1
+15 SET LIST(COUNT)=K1
End DoDot:1
+16 ; Show results and let user pick a TIN by sequence number or TIN
+17 SET (COUNT,K1,K2,K3,RETURN)=""
SET (CNT,QUIT,SX)=0
+18 FOR
SET COUNT=$ORDER(LIST(COUNT))
if 'COUNT
QUIT
Begin DoDot:1
+19 SET CNT=CNT+1
+20 WRITE !,$JUSTIFY(COUNT_".",4)_" "
SET SPACE=0
+21 SET K1=LIST(COUNT)
+22 FOR
SET K2=$ORDER(LIST("T",K1,K2))
if K2=""
QUIT
Begin DoDot:2
+23 IF SPACE
WRITE !," "
+24 WRITE $EXTRACT(K1_$JUSTIFY("",31),1,30)
+25 WRITE $EXTRACT(K2,1,42)
+26 IF 'SPACE
SET SPACE=1
End DoDot:2
IF QUIT
QUIT
End DoDot:1
IF QUIT
QUIT
+27 SET DIR(0)="NO^1:"_CNT_":0"
+28 DO ^DIR
+29 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT -1
+30 IF Y
SET RETURN=LIST(Y)
+31 QUIT RETURN
+32 ;
CHKPAY(PAYIEN,TYPE,FILE) ; Check if payer meets the filter requirements
+1 ; Input: PAYIEN - Internal entry number of the payer from file 344.6
+2 ; TYPE - C - CHAMPVA, M - Medical, P - Pharmacy, T- Tricare, A - All
+3 ; FILE - 344.4 - ERA, 344.31 EFT - Payer must have entries in the given file
+4 ; Return: 1 - Payer matches the filter criteria, otherwise 0.
+5 ;
+6 NEW NAME,FLAG,RETURN,TIN
+7 IF TYPE="A"
IF FILE=""
QUIT 1
+8 ;
+9 SET RETURN=1
+10 IF TYPE'="A"
Begin DoDot:1
+11 SET RETURN=$$CHKTYPE(PAYIEN,TYPE)
End DoDot:1
IF 'RETURN
QUIT 0
+12 ;
+13 IF FILE
Begin DoDot:1
+14 SET NAME=$$GET1^DIQ(344.6,PAYIEN_",",.01,"I")
+15 SET TIN=$$GET1^DIQ(344.6,PAYIEN_",",.02,"I")
+16 IF '$DATA(^RCY(FILE,"APT",NAME,TIN))
SET RETURN=0
End DoDot:1
IF 'RETURN
QUIT 0
+17 QUIT 1
CHKRNG(PAYIEN) ; Check if second picked payer name follows the first
+1 ; Input: PAYIEN = Internal entry number of payer from file #344.6
+2 ; ^TMP("RCDPEU1",$J global array contains previously picked payer
+3 ; Return: 1 - if PAYIEN's name follows that of payer in ^TMP, otherwise 0
+4 ;
+5 NEW NAME,RETURN
+6 SET RETURN=0
+7 SET NAME(1)=$ORDER(^TMP("RCDPEU1",$JOB,"N",""))
+8 SET NAME(2)=$$GET1^DIQ(344.6,PAYIEN_",",.01,"E")
+9 IF NAME(2)]NAME(1)!(NAME(2)=NAME(1))
SET RETURN=1
+10 QUIT RETURN
+11 ;
CHKTIN(TIN,PARAM,OUT) ; Given a TIN check filter criteria and add passing entries to the OUT array
+1 ; Input: TIN = Payer Identifier string that matches one or more payers in file #344.6
+2 ; PARAM = Input parameter array. See subroutine SELPAY for detailed documentation
+3 ; Output: OUT (passed by reference) array of payers matching filter parameters. Sorted by TIN then NAME
+4 NEW PAYIEN
+5 SET PAYIEN=""
+6 ;
FOR
SET PAYIEN=$ORDER(^RCY(344.6,"C",TIN,PAYIEN))
if PAYIEN=""
QUIT
Begin DoDot:1
+7 ;
IF $$CHKPAY(PAYIEN,PARAM("TYPE"),PARAM("FILE"))
Begin DoDot:2
+8 NEW PNAME
+9 SET PNAME=$$GET1^DIQ(344.6,PAYIEN_",",.01,"E")
+10 IF PNAME=""
QUIT
+11 SET OUT("T",TIN,PNAME,PAYIEN)=""
End DoDot:2
End DoDot:1
+12 QUIT
TLIST ; List TINS for user help. Only TINS matching filter criteria are displayed.
+1 NEW COUNT,PAYIEN,QUIT,TIN
+2 SET (QUIT,COUNT)=0
+3 SET TIN=""
+4 FOR
SET TIN=$ORDER(^RCY(344.6,"C",TIN))
if TIN=""
QUIT
Begin DoDot:1
+5 SET PAYIEN=""
+6 FOR
SET PAYIEN=$ORDER(^RCY(344.6,"C",TIN,PAYIEN))
if PAYIEN=""
QUIT
Begin DoDot:2
+7 IF '$$CHKPAY(PAYIEN,$GET(PARAM("TYPE"),"A"),$GET(PARAM("FILE")))
QUIT
+8 SET COUNT=COUNT+1
+9 IF COUNT>21
SET COUNT=1
IF '$$GOON^VALM1()
SET QUIT=1
QUIT
+10 WRITE !,$EXTRACT(TIN_$JUSTIFY("",30),1,30)_" "_$EXTRACT($$GET1^DIQ(344.6,PAYIEN_",",.01,"E"),1,39)
End DoDot:2
IF QUIT
QUIT
End DoDot:1
IF QUIT
QUIT
+11 QUIT
INIT ; Initialize parameters and return array
+1 ; Input - PARAM array see comments for SELPAY above
+2 ;
+3 SET PARAM("TYPE")=$GET(PARAM("TYPE"),"A")
+4 SET PARAM("FILE")=$GET(PARAM("FILE"))
+5 SET PARAM("SRCH")=$GET(PARAM("SRCH"),"N")
+6 SET PARAM("SELC")=$GET(PARAM("SELC"),"S")
+7 SET PARAM("DICA")=$GET(PARAM("DICA"),"Select payer "_$SELECT(PARAM("SRCH")="N":"name",1:"TIN")_": ")
+8 ;
+9 KILL ^TMP("RCDPEU1",$JOB)
+10 QUIT
CLEAN ; Clean up output array if user aborts
+1 KILL ^TMP("RCDPEU1",$JOB)
+2 QUIT
RTYPE(DEF) ;EP
+1 ; Input: DEF - Value to use a default
+2 ; Returns: -1 - User ^ or timed out
+3 ; A - User selected ALL
+4 ; C - User selected CHAMPVA
+5 ; M - User selected MEDICAL
+6 ; P - User selected PHARMACY
+7 ; B - User selected BOTH
+8 NEW DA,DIR,DTOUT,DUOUT,X,Y,DIRUT,DIROUT,RCTYPE,RETURN
+9 SET RCTYPE=""
+10 SET DIR("?")="Enter the type of payer to include"
+11 ; PRCA*4.5*432
SET DIR(0)="SA^C:CHAMPVA;M:MEDICAL;P:PHARMACY;T:TRICARE;A:ALL"
+12 ; PRCA*4.5*432
SET DIR("A")="(C)HAMPVA, (M)EDICAL, (P)HARMACY, (T)RICARE or (A)LL: "
+13 SET DIR("B")=$SELECT($GET(DEF)'="":DEF,1:"ALL")
+14 DO ^DIR
+15 KILL DIR
+16 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT -1
+17 if Y=""
QUIT "A"
+18 SET RETURN=$EXTRACT(Y)
+19 ; If CHAMPVA, Pharmacy or Tricare chosen, check if payers exist and if not give warning
+20 IF (RETURN="P"&('$DATA(^RCY(344.6,"ARX",1))))
DO WARN("pharmacy")
+21 IF (RETURN="T"&('$DATA(^RCY(344.6,"ATR",1))))
DO WARN("tricare")
+22 ; PRCA*4.5*432
IF (RETURN="C"&('$DATA(^RCY(344.6,"ACH",1))))
DO WARN("CHAMPVA")
+23 QUIT RETURN
+24 ;
CLOSEDC(DEF) ;EP
+1 ; PRCA*4.5*349 - Added subroutine
+2 ; Input: DEF - Value to use a default
+3 ; Optional, Defaults to ""
+4 ; Returns: -1 - User ^ or timed out
+5 ; A - User selected ALL
+6 ; C - User selected CLOSED
+7 NEW DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,RCCLM,RETURN,X,Y
+8 SET RCCLM=""
+9 SET DIR("?")="Enter ALL to select all claims or CLOSED to select only closed claims."
+10 SET DIR(0)="SA^A:ALL;C:CLOSED"
+11 ; PRCA*4.5*446 fix typo "Inlcude" -> "Include"
SET DIR("A")="Include (A)LL Claims or only (C)LOSED Claims: "
+12 SET DIR("B")=$SELECT($GET(DEF)'="":DEF,1:"ALL")
+13 DO ^DIR
+14 KILL DIR
+15 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT -1
+16 if Y=""
QUIT "A"
+17 SET RETURN=$EXTRACT(Y)
+18 QUIT RETURN
+19 ;
PAYTYPE(NAME,TIN,TYPE) ; EP
+1 ; Is a payer Medical, Pharmacy or Tricare based on flags in the payer exclusion file.
+2 ; Inputs: NAME - The free text name of the payer
+3 ; TIN - The ID if the payer
+4 ; TYPE - M : Medical, P : Pharmacy, T: Tricare
+5 ; Returns : 1 - Yes, payer matches type, 0 - No, payer does not match type
+6 NEW IEN,FLAG
+7 SET IEN=$$GETPAY(NAME,TIN)
+8 IF 'IEN
QUIT 0
+9 QUIT $$CHKTYPE(IEN,TYPE)
+10 ;
GETPAY(NAME,TIN) ; EP - Get payer IEN given name and TIN
+1 ; Inputs: NAME - The free text name of the payer
+2 ; TIN - The ID if the payer
+3 ; Returns: Internal entry number from file 344.6
+4 IF NAME=""!(TIN)=""
QUIT 0
+5 QUIT +$ORDER(^RCY(344.6,"CPID",NAME,TIN,""))
+6 ;
CHKTYPE(IEN,TYPE) ; EP
+1 ; Inputs: IEN - Internal entry number from file 344.6
+2 ; TYPE - C - CHAMPVA, M : Medical, P : Pharmacy, T: Tricare, A: All
+3 ; Returns: 1 if the payer matches the type, otherwise 0
+4 IF TYPE="A"
QUIT 1
+5 SET FLAG("P")=+$$GET1^DIQ(344.6,IEN_",",.09,"I")
+6 SET FLAG("T")=+$$GET1^DIQ(344.6,IEN_",",.1,"I")
+7 ; PRCA*4.5*432
SET FLAG("C")=+$$GET1^DIQ(344.6,IEN_",",.15,"I")
+8 ;
+9 IF TYPE="T"
IF FLAG("T")
QUIT 1
+10 IF TYPE="P"
IF FLAG("P")
QUIT 1
+11 ; PRCA*4.5*432
IF TYPE="C"
IF FLAG("C")
QUIT 1
+12 ; PRCA*4.5*432
IF TYPE="M"
IF 'FLAG("P")
IF 'FLAG("T")
IF 'FLAG("C")
QUIT 1
+13 QUIT 0
ISTYPE(FILE,IEN,TYPE) ; EP
+1 ; Check if payer is a given type based on IEN from a FILE
+2 ; Input: FILE - file from which to get Payer name and TIN
+3 ; allowed values 344.4 - ERA, 344.31 - EFT, 361.1 - EOB
+4 ; IEN - Internal entry number of entry in FILE
+5 ; TYPE - C : CHAMPVA, M : Medical, P : Pharmacy, T: Tricare
+6 ; Return 1 - payer matches type, else 0.
+7 IF TYPE="A"
QUIT 1
+8 NEW IEN3444,NAME,TIN
+9 ; For EOB try to get Payer from associated ERA, if none exists use TIN only to check the type.
+10 ;
IF FILE=361.1
Begin DoDot:1
+11 SET IEN3444=$$EOBERA(IEN)
+12 IF IEN3444
SET FILE=344.4
SET IEN=IEN3444
End DoDot:1
IF FILE=361.1
QUIT $$EOBTYP(IEN,TYPE)
+13 ;
+14 SET NAME=$$GETNAME(FILE,IEN)
+15 SET TIN=$$GETTIN(FILE,IEN)
+16 IF NAME=""!(TIN="")
QUIT 0
+17 QUIT $$PAYTYPE(NAME,TIN,TYPE)
+18 ;
ISSEL(FILE,IEN,RCJOB) ; EP
+1 ; Check if payer was selected by the user give the file and IEN
+2 ; Input: FILE - file from which to get Payer name and TIN
+3 ; allowed values 344.4 - ERA, 344.31 - EFT, 361.1 - EOB
+4 ; IEN - Internal entry number of entry in FILE
+5 ; Return 1 - payer was selected, else 0.
+6 ;
+7 NEW IEN3444,NAME,RETURN,TIN
+8 SET RETURN=0
+9 SET RCJOB=$GET(RCJOB,$JOB)
+10 IF FILE=361.1
Begin DoDot:1
+11 SET IEN3444=$$EOBERA(IEN)
+12 ;
IF IEN3444
Begin DoDot:2
+13 SET FILE=344.4
SET IEN=IEN3444
End DoDot:2
+14 ;
IF '$TEST
Begin DoDot:2
+15 SET TIN=$$GET1^DIQ(361.1,IEN_",",.03,"E")
+16 IF $DATA(^TMP("RCDPEU1",RCJOB,"T",TIN))
End DoDot:2
End DoDot:1
IF FILE=361.1
QUIT RETURN
+17 ;
+18 SET NAME=$$GETNAME(FILE,IEN)
+19 SET TIN=$$GETTIN(FILE,IEN)
+20 IF NAME=""!(TIN="")
QUIT 0
+21 IF $DATA(^TMP("RCDPEU1",RCJOB,"N",NAME,TIN))
SET RETURN=1
+22 QUIT RETURN
+23 ;
GETNAME(FILE,IEN) ; Get Payer Name give file and IEN
+1 NEW FIELD
+2 SET FIELD=$SELECT(FILE=344.4:.06,1:.02)
+3 QUIT $$GET1^DIQ(FILE,IEN_",",FIELD,"E")
+4 ;
GETTIN(FILE,IEN) ; Get Payer TIN give file and IEN
+1 NEW FIELD
+2 SET FIELD=.03
+3 QUIT $$GET1^DIQ(FILE,IEN_",",FIELD,"E")
+4 ;
PAYRNG(MIXED,BLANKLN,NMORTIN,PROMPT) ; How does the user want to select payers?
+1 ; Input: MIXED - 1 to display prompts in mixed case
+2 ; Optional, defaults to 0
+3 ; BLANKLN - 0 skip initial blank line
+4 ; Optional, defaults to 1
+5 ; NMORTIN - 1 to look-up Payer by Payer Name, 2 to look-up by TIN
+6 ; 0 or undefined - pre-326 behavior, look-up by payer name and don't include TIN in output array.
+7 ; Optional, defaults to 0
+8 ; PROMPT - Alternative prompt
+9 ;
+10 ; Output: ^TMP("RCSELPAY",$J) - Array of selected Payers
+11 ; Returns: A - All, S - Selected, R - Range, (-1) - User '^' or timeout
+12 ;
+13 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,RTNFLG,TIN,X,XX,Y
+14 if '$DATA(MIXED)
SET MIXED=0
+15 if '$DATA(BLANKLN)
SET BLANKLN=1
+16 if '$DATA(NMORTIN)
SET NMORTIN=0
+17 ; PRCA*4.5*332
IF '$DATA(PROMPT)
SET PROMPT=$SELECT(MIXED:"Run Report for",1:"RUN REPORT FOR")
+18 ;
+19 SET RTNFLG=0
+20 ;
+21 ; Select option required (All, Selected or Range)
+22 IF NMORTIN=2
Begin DoDot:1
+23 SET DIR(0)="SA^A:ALL;S:SPECIFIC"
+24 ; PRCA*4.5*332
if MIXED
SET DIR("A")=PROMPT_" (A)LL or (S)PECIFIC Insurance Companies?: "
+25 ; PRCA*4.5*332
if 'MIXED
SET DIR("A")=PROMPT_" (A)LL OR (S)PECIFIC INSURANCE COMPANIES?: "
End DoDot:1
+26 IF '$TEST
Begin DoDot:1
+27 SET DIR(0)="SA^A:ALL;S:SPECIFIC;R:RANGE"
+28 ; PRCA*4.5*332
if MIXED
SET DIR("A")=PROMPT_" (A)LL, (S)PECIFIC, or (R)ANGE of Insurance Companies?: "
+29 ; PRCA*4.5*332
if 'MIXED
SET DIR("A")=PROMPT_" (A)LL, (S)PECIFIC, OR (R)ANGE OF INSURANCE COMPANIES?: "
+30 SET DIR("?",2)="Enter 'RANGE' to select an Insurance Company range."
End DoDot:1
+31 SET DIR("B")="ALL"
+32 SET DIR("?",1)="Enter 'ALL' to select all Insurance Companies."
+33 SET DIR("?")="Enter 'SPECIFIC' to select specific Insurance Companies."
+34 ; PRCA*4.5*318 - Added condition for BLANKLN
if BLANKLN
WRITE !
+35 DO ^DIR
KILL DIR
+36 ;
+37 ; Abort on ^ exit or timeout
+38 IF $DATA(DTOUT)!$DATA(DUOUT)
SET RTNFLG=-1
QUIT RTNFLG
+39 ;
+40 QUIT Y
EOBERA(IEN3611) ; Get ERA that corresponds to an EOB so we can find payers.
+1 ; Input IEN3611 - Internal entry from file 361.1 EOB
+2 ; Returns - Internal entry number from file 344.4 ERA
+3 ; use reverse $Order to get the latest ERA in case there is more than one.
+4 QUIT $ORDER(^RCY(344.4,"ADET",+IEN3611,"A"),-1)
+5 ;
EOBTYP(IEN3611,TYPE) ; If EOB has no ERA, use TIN from EOB to determine M/P/T type
+1 ; Input IEN3611 - Internal entry from file 361.1 EOB
+2 ; TYPE - M : Medical, P : Pharmacy, T: Tricare
+3 ; Returns - 1 at least one payer with TIN is of type TYPE
+4 NEW IEN,TIN
+5 SET RETURN=0
+6 SET TIN=$$GET1^DIQ(361.1,IEN3611_",",.03,"E")
+7 ;
IF TIN'=""
Begin DoDot:1
+8 SET IEN=""
+9 FOR
SET IEN=$ORDER(^RCY(344.6,"C",TIN_" ",IEN))
if 'IEN
QUIT
Begin DoDot:2
+10 SET RETURN=$$CHKTYPE(IEN,TYPE)
End DoDot:2
if RETURN=1
QUIT
End DoDot:1
+11 QUIT RETURN
+12 ;
RMESS ; Output message that entry is required.
+1 WRITE !!,"You must select "
+2 WRITE $SELECT(PARAM("SELC")="R":"a",1:"at least one")_" "
+3 WRITE $SELECT(PARAM("SRCH")="N":"payer",1:"TIN"),*7,!
+4 QUIT
+5 ;
WARN(TYPE) ; Warn user that no payers of TYPE have been flagged
+1 ; Input: TYPE - C=CHAMPVA, P=Pharmacy, T=Tricare
+2 ; Output: warning message to screen.
+3 WRITE !!,"WARNING - There are no "_TYPE_" payers flagged in the system."
+4 WRITE !," Please use the Identify Payers option to flag payers.",*7
+5 QUIT
+6 ;
ASKAUTO(DEF) ; EP from RCDPENR2 - added for PRCA*4.5*349
+1 ; Input: DEF - Value to use a default, optional, defaults to "BOTH"
+2 ; Returns: -1 - User ^ or timed out
+3 ; A - Include autoposted only
+4 ; N - Include manually posted only
+5 ; B - Include both types
+6 ;
+7 NEW DA,DIR,DTOUT,DUOUT,X,Y,DIRUT,DIROUT,RCTYPE,RETURN
+8 SET RCTYPE=""
+9 SET DIR("?",1)="Enter 'A' to include only auto-posted entries"
+10 SET DIR("?",2)=" 'M' to include only manually posted entries"
+11 SET DIR("?")=" 'B' to include both"
+12 SET DIR(0)="SA^A:AUTO-POSTED;M:MANUALLY POSTED;B:BOTH"
+13 SET DIR("A")="(A)UTO-POSTED, (M)ANUALLY POSTED, (B)OTH: "
+14 SET DIR("B")=$SELECT($GET(DEF)'="":DEF,1:"BOTH")
+15 DO ^DIR
+16 KILL DIR
+17 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT -1
+18 if Y=""
QUIT "B"
+19 SET RETURN=$EXTRACT(Y)
+20 ; N=NON-AUTO-POSTED same as MANUAL
QUIT $SELECT(RETURN="M":"N",1:RETURN)
+21 ;
CHKEFT(EFTDA) ; EP from RCDPENR3 - Check to see if a EFT is posted - added for PRCA*4.5*349
+1 ; Input EFTDA - Internal entru number from 344.31
+2 ; Returns 1 if EFT is posted, otherwise 0
+3 ;
+4 NEW ERAREC,IEN344,RETURN,POSTSTAT
+5 SET RETURN=0
+6 ; Pointer to ERA record
SET ERAREC=+$$GET1^DIQ(344.31,EFTDA_",",.1,"I")
+7 ;
IF ERAREC
Begin DoDot:1
+8 SET POSTSTAT=$$GET1^DIQ(344.4,ERAREC_",",.14,"I")
+9 ; Matched to posted, manually posted or partialy posted ERA
IF POSTSTAT
IF "125"[POSTSTAT
SET RETURN=1
End DoDot:1
+10 ; EFT matched to Paper EOB, check if receipt is processed
IF '$TEST
IF $$GET1^DIQ(344.31,EFTDA_",",.08,"I")=2
Begin DoDot:1
+11 SET IEN344=$ORDER(^RCY(344,"AEFT",EFTDA,0))
+12 IF IEN344
IF $$GET1^DIQ(344,IEN344_",",.14,"I")'=1
SET RETURN=1
End DoDot:1
+13 QUIT RETURN
