RCDPEM9 ;OIFO-BAYPINES/PJH - PAYER SELECTION ;10/18/11 6:17pm
;;4.5;Accounts Receivable;**276,284,318,326,332**;Mar 20, 1995;Build 40
;;Per VA Directive 6402, this routine should not be modified.
;
; PRCA*4.5*318 - Added parameters MIXED and BLANKLN
; PRCA*4.5*326 - Extensive rewrite to include selection/sort by payer TIN in the Auto Post Report
GETPAY(FILE,MIXED,BLANKLN,NMORTIN,SHOWTIN) ; Let user select payer for filter
; Input: FILE - File to retrieve Payers from either #344.4 OR ##344.31
; 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
; SHOWTIN - 1 to append the Payer Name or Payer TIN when displaying payers
; Optional, defaults to 0
; Output: ^TMP("RCSELPAY",$J) - Array of selected Payers
; Returns: A1^A2^A3 Where:
; A1 - -1 - None selected
; 1 - Range of payers
; 2 - All payers selected
; 3 - Specific payers
; A2 - From Range (When a from/thru range is selected by user)
; A3 - Thru Range (When a from/thru range is selected by user)
N CNT,DIR,DIROUT,DIRUT,DTOUT,DUOUT,I,IEN,INDX
N RCANS,RCANS2,RCINC,RCINSF,RCINST,RCPAY,RNG1,RNG2,RTNFLG,TIN,X,XX,Y
S:'$D(MIXED) MIXED=0 ; PRCA*4.5*318 - Added logic for MIXED and BLANKLN
S:'$D(BLANKLN) BLANKLN=1
S:'$D(NMORTIN) NMORTIN=0
S:'$D(SHOWTIN) SHOWTIN=0
;
S RTNFLG=0,INDX=1,RNG1="",RNG2=""
K ^TMP("RCSELPAY",$J) ; Clear list of selected Payers
;
; Select option required (All, Selected or Range)
I NMORTIN=2 D
. S DIR(0)="SA^A:ALL;S:SPECIFIC"
. S:MIXED DIR("A")="Run Report for (A)LL or (S)PECIFIC Insurance Companies?: "
. S:'MIXED DIR("A")="RUN REPORT FOR (A)LL OR (S)PECIFIC INSURANCE COMPANIES?: "
E D
. S DIR(0)="SA^A:ALL;S:SPECIFIC;R:RANGE"
. S:MIXED DIR("A")="Run Report for (A)LL, (S)PECIFIC, or (R)ANGE of Insurance Companies?: "
. S:'MIXED DIR("A")="RUN REPORT FOR (A)LL, (S)PECIFIC, OR (R)ANGE OF INSURANCE COMPANIES?: "
. 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
;
; ALL payers
; Switch to use new Payer Name/Payer TIN index
I Y="A" D
. S CNT=0,RCPAY="",RTNFLG=2
. F S RCPAY=$O(^RCY(FILE,"C",RCPAY)) Q:RCPAY="" D
. . S CNT=CNT+1,IEN=$O(^RCY(FILE,"C",RCPAY,""))
. . S TIN=$$GET1^DIQ(FILE,IEN,.03,"E")
. . S XX=$S(NMORTIN=2:TIN_"/"_RCPAY,NMORTIN=1:RCPAY_"/"_TIN,1:RCPAY)
. . S ^TMP("RCSELPAY",$J,CNT)=XX
;
; Selected Payers
I Y="S" D
. D GLIST(FILE,NMORTIN),GETPAYS(CNT,MIXED,NMORTIN) ; PRCA*4.5*318 - Added parameter MIXED
;
; Range of Payers
I Y="R" D
. D GLIST(FILE,NMORTIN),GETPAYR(MIXED,BLANKLN) ; PRCA*4.5*318 - Added parameters MIXED and BLANKLN
;
K:RTNFLG'=2 ^TMP("RCPAYER",$J) ; Clear list of all payers
K:RTNFLG=-1 ^TMP("RCSELPAY",$J) ; Aborting, clear any selected payers
;
; PRCA*4.5*284 - Update return value to include from/thru range. See above for documentation
Q RTNFLG_"^"_RNG1_"^"_RNG2 ; Return value
;
GLIST(FILE,NMORTIN) ; Build list for this file
; Input: FILE - File to retrieve Payers from either #344.4 OR ##344.31
; NMORTIN - 2 - lookup by TIN, 1 - lookup by Payer Name, 0 - pre 326 behavior
; Output: ^TMP("RCPAYER",$J,A1)=A2 Where:
; A1 - Counter
; A2 - Payer Name/TIN if NMORTIN=1, TIN/Payer Name if NMORTIN=2, else Payer Name
; ^TMP("RCPAYER",$J,"B",B1,B2)=B3 Where:
; B1 - Payer TIN if NMORTIN=2, else Payer Name
; B2 - Counter
; B3 - Payer Name if NMORTIN=0 or 1, else Payer TIN
N IEN,PAYNAM,TIN
K ^TMP("RCPAYER",$J) ; Clear workfile
I NMORTIN=2 D Q ; Build list of Payers by TIN
. S CNT=0,TIN=""
. F S TIN=$O(^RCY(FILE,"ATP",TIN)) Q:TIN="" D
. . S PAYNAM=""
. . F S PAYNAM=$O(^RCY(FILE,"ATP",TIN,PAYNAM)) Q:PAYNAM="" D
. . . S CNT=CNT+1
. . . S ^TMP("RCPAYER",$J,CNT)=TIN_"/"_PAYNAM
. . . S ^TMP("RCPAYER",$J,"B",TIN,CNT)=PAYNAM
;
S CNT=0,PAYNAM=""
F S PAYNAM=$O(^RCY(FILE,"APT",PAYNAM)) Q:PAYNAM="" D
. S TIN=""
. F S TIN=$O(^RCY(FILE,"APT",PAYNAM,TIN)) Q:TIN="" D
. . S CNT=CNT+1
. . S ^TMP("RCPAYER",$J,CNT)=$S(NMORTIN=1:PAYNAM_"/"_TIN,1:PAYNAM)
. . S ^TMP("RCPAYER",$J,"B",PAYNAM,CNT)=TIN
Q
;
; PRCA*4.5*318 - Added parameter & logic for MIXED
GETPAYS(CNT,MIXED,NMORTIN) ; Select Specific payer for filter
; Input: CNT - Number of Payers
; MIXED - 1 to display prompts in mixed case
; Optional, defaults to 0
; NMORTIN - 2 to lookup by TIN, 1 to lookup by Payer, 0 - Pre 326 behavior
; Optional, defaults to 0
; Output: RTNFLG -1 - No Payer selected
; 3 - At least one Payer selected
S:'$D(MIXED) MIXED=0
S:'$D(NMORTIN) NMORTIN=0
K ^TMP("RCDPEM9",$J)
F Q:RTNFLG'=0 D
. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
. S DIR("A")="SELECT INSURANCE COMPANY"
. S:MIXED DIR("A")="Select Insurance Company "_$S(NMORTIN=2:"TIN",1:"NAME") ; PRCA*4.5*318
. S DIR(0)="FO^1:30"
. S DIR("?")="ENTER THE "_$S(NMORTIN=2:"TIN",1:"NAME")_" OF THE PAYER OR '??' TO LIST PAYERS"
. ; PRCA*4.5*318 - Added MIXED
. S:MIXED DIR("?")="Enter the "_$S(NMORTIN=2:"TIN",1:"name")_" of the payer or '??' to list payers"
. S DIR("??")="^D LIST^RCDPEM9(CNT)"
. D ^DIR K DIR
. ;
. ; User pressed ENTER
. I Y="",'$D(DTOUT) S RTNFLG=$S($D(^TMP("RCSELPAY",$J)):3,1:-1) Q
. ;
. ; First check for exits
. I $D(DUOUT)!$D(DTOUT)!$D(DIRUT)!$D(DIROUT) S RTNFLG=-1 Q
. S (RCANS,RCANS2)="",RCANS=Y
. I NMORTIN=2 D Q ; TIN lookup
. . I '$D(^TMP("RCPAYER",$J,"B",RCANS)) D Q
. . . W " ??"
. . I $D(^TMP("RCDPEM9",$J,RCANS)) D Q
. . . W:'MIXED " ?? PAYER ALREADY SELECTED"
. . . W:MIXED " ?? Payer already selected"
. . D SELTIN(RCANS,.INDX)
. ;
. ; Check for Partial Match on user input
. I '(RCANS?.N) D Q:'$G(RCANS2)
. . S RCANS2=$O(^TMP("RCPAYER",$J,"B",RCANS,RCANS2))
. . D:'RCANS2 PART(NMORTIN,RCANS,.INDX)
. S:$G(RCANS2) RCANS=RCANS2
. I RCANS="" W " ??" Q
. I RCANS?.N,((+RCANS<1)!(+RCANS>CNT)) W " ??" Q
. I RCANS'?.N W " ??" Q
. I $D(^TMP("RCDPEM9",$J,RCANS)) D Q
. . W:'MIXED " ?? PAYER ALREADY SELECTED"
. . W:MIXED " ?? Payer already selected"
. S ^TMP("RCDPEM9",$J,RCANS)=""
. W " ",^TMP("RCPAYER",$J,RCANS)
. S ^TMP("RCSELPAY",$J,INDX)=$G(^TMP("RCPAYER",$J,RCANS))
. S INDX=INDX+1
K ^TMP("RCDPEM9",$J)
Q
;
SELTIN(TIN,INDX) ; Show all the payers with the selected TIN and ask the user
; if they want to select the TIN
; Input: TIN - User Selected TIN
; INDX - Current # of selected Payers
; ^TMP("RCPAYER",$J,"B") - Array of TINs on file
; ^TMP("RCSELPAY",$J,A1)= A2/A3 Current Selected Payers Where:
; A1 - Counter
; A2 - Selected TIN
; A3 - Selected PAYER
; Output: INDX - Updated # of selected Payers
; ^TMP("RCSELPAY",$J,A1)= A2/A3 Updated Selected Payers Where:
; A1 - Counter
; A2 - Selected TIN
; A3 - Selected PAYER
N CTR,DIR,DIROUT,DIRUT,DTOUT,DUOUT,SELPAY,X,Y
W !,"The following Payers with TIN ",TIN," have ERAs on file"
D PART(2,TIN,INDX,.SELPAY)
S DIR(0)="Y"
S DIR("A")="Select this TIN"
S DIR("B")="YES"
D ^DIR
Q:$D(DTOUT)!$D(DUOUT)
Q:Y=0
M ^TMP("RCSELPAY",$J)=SELPAY("RCSELPAY")
S INDX=$O(SELPAY("RCSELPAY",""),-1)+1
Q
;
LIST(CNT) ; Display all the Payers
; Prompt users for stations to be used for filtering
; Input: CNT - Total # of Payers in tmp file
; ^TMP("RCPAYER",$J,A1)=A2 Where:
; A1 - Counter
; A2 - Payer Name/TIN if NMORTIN=1, TIN/Payer Name if NMORTIN=2, else Payer Name
N I
F I=1:1:CNT D
. W !,I,".",?5,$G(^TMP("RCPAYER",$J,I))
Q
;
PART(NMORTIN,RCANS,INDX,SELPAY) ; Give the user a list of partial matches
; Input: NMORTIN - 2 - Lookup by Payer TIN, 0 or 1 - Lookup by Payer Name
; RCANS - User Payer or TIN selection
; INDX - Current # of selected Payers (only passed if NMORTIN=2)
; Output: SELPAY()- Array of selected Payers (only returned if NMORTIN=2)
; ^TMP("RCPAYER",$J,A1)=A2 Where:
; A1 - Counter
; A2 - Payer Name/TIN if NMORTIN=1, TIN/Payer Name if NMORTIN=2, else Payer Name
; ^TMP("RCPAYER",$J,"B",B1,B2)=B3 Where:
; B1 - Payer TIN if NMORTIN=0, else Payer Name
; B2 - Counter
; B3 - Payer Name if NMORTIN=0 or 1, else Payer TIN
; Output: List of Payers that meet the partial match
N RCPAR,CNT,CTR,RCSAVE
S CNT=0,RCPAR=RCANS,RCPAR=$O(^TMP("RCPAYER",$J,"B",RCPAR),-1)
F D Q:RCPAR=""
. S RCPAR=$O(^TMP("RCPAYER",$J,"B",RCPAR))
. Q:RCPAR=""
. I $E(RCPAR,1,$L(RCANS))'[RCANS S RCPAR="" Q
. S CTR=0
. F D Q:CTR=""
. . S CTR=$O(^TMP("RCPAYER",$J,"B",RCPAR,CTR))
. . Q:CTR=""
. . W !,?5
. . W:NMORTIN'=2 CTR,"."
. . W ^TMP("RCPAYER",$J,CTR)
. . I NMORTIN=2 D
. . . S SELPAY("RCSELPAY",INDX)=^TMP("RCPAYER",$J,CTR),INDX=INDX+1
. . S CNT=CNT+1
. . I CNT=1 S RCSAVE=^TMP("RCPAYER",$J,CTR)
W:'CNT " ??"
I NMORTIN'=2,CNT=1 D ; one match by name, select it automatically
. S ^TMP("RCSELPAY",$J,INDX)=RCSAVE,INDX=INDX+1
. W " - SELECTED"
Q
;
; PRCA*4.5*318 - Added parameters & logic for MIXED & BLANKLN
GETPAYR(MIXED,BLANKLN) ;select payer for filter, range
; called from ^RCDPEAR1
; Input: MIXED - 1 to display prompts in mixed case
; Optional, defaults to 0
; BLANKLN - 0 skip initial blank line
; Optional, defaults to 1
;
S:'$D(MIXED) MIXED=0 ; PRCA*4.5*318
S:'$D(BLANKLN) BLANKLN=1
;
N DIR,DTOUT,DUOUT,DIRUT,DIROUT,INDX,X,Y,RCINSF,RCINST,NUM
S DIR("?")="ENTER THE NAME OF THE PAYER OR '??' TO LIST PAYERS"
S DIR("??")="^D LIST^RCDPEM9(CNT)"
S DIR(0)="FA^1:30^K:X'?1.U.E X"
S DIR("A")="START WITH INSURANCE COMPANY NAME: "
S DIR("B")=$E($O(^TMP("RCPAYER",$J,"B","")),1,30)
I MIXED D ;PRCA*4.5*318
. S DIR("?")="Enter the name of the payer or '??' to list payers"
. S DIR("A")="Start with Insurance Company name: "
D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)!(Y="") S RTNFLG=-1 Q
S RCINSF=Y
S DIR("?")="ENTER THE NAME OF THE PAYER OR '??' TO LIST PAYERS"
S DIR("??")="^D LIST^RCDPEM9(CNT)"
S DIR(0)="FA^1:30^K:X'?1.U.E X"
S DIR("A")="GO TO INSURANCE COMPANY NAME: "
I MIXED D ;PRCA*4.5*318
. S DIR("?")="Enter the name of the payer or '??' to list payers"
. S DIR("A")="Go to Insurance Company name: "
S DIR("B")=$E($O(^TMP("RCPAYER",$J,"B",""),-1),1,30)
; PRCA*4.5*318 - added conditional for MIXED & BLANKLN
F W:BLANKLN ! D ^DIR Q:$S($D(DTOUT)!$D(DUOUT):1,1:RCINSF']Y) D
. W:'MIXED !,"'GO TO' NAME MUST COME AFTER 'START WITH' NAME"
. W:MIXED !,"'GO TO' name must come after 'START WITH' name"
K DIR
I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT)!(Y="") S RTNFLG=-1 Q
S RCINST=Y_"Z" ;entry of "ABC" will pick up "ABC INSURANCE" if "Z" is appended
;If the first name is an exact match, back up to the previous entry
I $D(^TMP("RCPAYER",$J,"B",RCINSF)) S RCINSF=$O(^TMP("RCPAYER",$J,"B",RCINSF),-1)
; PRCA*4.5*284 - Save from/thru user responses in RNG1 & RNG2 to rebuild after report is queued. Will be returned to the calling program.
S RNG1=RCINSF,RNG2=RCINST
S INDX=1 F S RCINSF=$O(^TMP("RCPAYER",$J,"B",RCINSF)) Q:RCINSF="" Q:RCINSF]RCINST D
. S NUM=$O(^TMP("RCPAYER",$J,"B",RCINSF,""))
. S ^TMP("RCSELPAY",$J,INDX)=$G(^TMP("RCPAYER",$J,NUM))
. S INDX=INDX+1
;Set return value
I INDX=1 S RTNFLG=-1 Q ; no entries in selected range
S RTNFLG=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEM9 12770 printed Sep 23, 2025@19:20:56 Page 2
RCDPEM9 ;OIFO-BAYPINES/PJH - PAYER SELECTION ;10/18/11 6:17pm
+1 ;;4.5;Accounts Receivable;**276,284,318,326,332**;Mar 20, 1995;Build 40
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; PRCA*4.5*318 - Added parameters MIXED and BLANKLN
+5 ; PRCA*4.5*326 - Extensive rewrite to include selection/sort by payer TIN in the Auto Post Report
GETPAY(FILE,MIXED,BLANKLN,NMORTIN,SHOWTIN) ; Let user select payer for filter
+1 ; Input: FILE - File to retrieve Payers from either #344.4 OR ##344.31
+2 ; MIXED - 1 to display prompts in mixed case
+3 ; Optional, defaults to 0
+4 ; BLANKLN - 0 skip initial blank line
+5 ; Optional, defaults to 1
+6 ; NMORTIN - 1 to look-up Payer by Payer Name, 2 to look-up by TIN
+7 ; 0 or undefined - pre-326 behavior, look-up by payer name and don't include TIN in output array.
+8 ; Optional, defaults to 0
+9 ; SHOWTIN - 1 to append the Payer Name or Payer TIN when displaying payers
+10 ; Optional, defaults to 0
+11 ; Output: ^TMP("RCSELPAY",$J) - Array of selected Payers
+12 ; Returns: A1^A2^A3 Where:
+13 ; A1 - -1 - None selected
+14 ; 1 - Range of payers
+15 ; 2 - All payers selected
+16 ; 3 - Specific payers
+17 ; A2 - From Range (When a from/thru range is selected by user)
+18 ; A3 - Thru Range (When a from/thru range is selected by user)
+19 NEW CNT,DIR,DIROUT,DIRUT,DTOUT,DUOUT,I,IEN,INDX
+20 NEW RCANS,RCANS2,RCINC,RCINSF,RCINST,RCPAY,RNG1,RNG2,RTNFLG,TIN,X,XX,Y
+21 ; PRCA*4.5*318 - Added logic for MIXED and BLANKLN
if '$DATA(MIXED)
SET MIXED=0
+22 if '$DATA(BLANKLN)
SET BLANKLN=1
+23 if '$DATA(NMORTIN)
SET NMORTIN=0
+24 if '$DATA(SHOWTIN)
SET SHOWTIN=0
+25 ;
+26 SET RTNFLG=0
SET INDX=1
SET RNG1=""
SET RNG2=""
+27 ; Clear list of selected Payers
KILL ^TMP("RCSELPAY",$JOB)
+28 ;
+29 ; Select option required (All, Selected or Range)
+30 IF NMORTIN=2
Begin DoDot:1
+31 SET DIR(0)="SA^A:ALL;S:SPECIFIC"
+32 if MIXED
SET DIR("A")="Run Report for (A)LL or (S)PECIFIC Insurance Companies?: "
+33 if 'MIXED
SET DIR("A")="RUN REPORT FOR (A)LL OR (S)PECIFIC INSURANCE COMPANIES?: "
End DoDot:1
+34 IF '$TEST
Begin DoDot:1
+35 SET DIR(0)="SA^A:ALL;S:SPECIFIC;R:RANGE"
+36 if MIXED
SET DIR("A")="Run Report for (A)LL, (S)PECIFIC, or (R)ANGE of Insurance Companies?: "
+37 if 'MIXED
SET DIR("A")="RUN REPORT FOR (A)LL, (S)PECIFIC, OR (R)ANGE OF INSURANCE COMPANIES?: "
+38 SET DIR("?",2)="Enter 'RANGE' to select an Insurance Company range."
End DoDot:1
+39 SET DIR("B")="ALL"
+40 SET DIR("?",1)="Enter 'ALL' to select all Insurance Companies."
+41 SET DIR("?")="Enter 'SPECIFIC' to select specific Insurance Companies."
+42 ; PRCA*4.5*318 - Added condition for BLANKLN
if BLANKLN
WRITE !
+43 DO ^DIR
KILL DIR
+44 ;
+45 ; Abort on ^ exit or timeout
+46 IF $DATA(DTOUT)!$DATA(DUOUT)
SET RTNFLG=-1
QUIT RTNFLG
+47 ;
+48 ; ALL payers
+49 ; Switch to use new Payer Name/Payer TIN index
+50 IF Y="A"
Begin DoDot:1
+51 SET CNT=0
SET RCPAY=""
SET RTNFLG=2
+52 FOR
SET RCPAY=$ORDER(^RCY(FILE,"C",RCPAY))
if RCPAY=""
QUIT
Begin DoDot:2
+53 SET CNT=CNT+1
SET IEN=$ORDER(^RCY(FILE,"C",RCPAY,""))
+54 SET TIN=$$GET1^DIQ(FILE,IEN,.03,"E")
+55 SET XX=$SELECT(NMORTIN=2:TIN_"/"_RCPAY,NMORTIN=1:RCPAY_"/"_TIN,1:RCPAY)
+56 SET ^TMP("RCSELPAY",$JOB,CNT)=XX
End DoDot:2
End DoDot:1
+57 ;
+58 ; Selected Payers
+59 IF Y="S"
Begin DoDot:1
+60 ; PRCA*4.5*318 - Added parameter MIXED
DO GLIST(FILE,NMORTIN)
DO GETPAYS(CNT,MIXED,NMORTIN)
End DoDot:1
+61 ;
+62 ; Range of Payers
+63 IF Y="R"
Begin DoDot:1
+64 ; PRCA*4.5*318 - Added parameters MIXED and BLANKLN
DO GLIST(FILE,NMORTIN)
DO GETPAYR(MIXED,BLANKLN)
End DoDot:1
+65 ;
+66 ; Clear list of all payers
if RTNFLG'=2
KILL ^TMP("RCPAYER",$JOB)
+67 ; Aborting, clear any selected payers
if RTNFLG=-1
KILL ^TMP("RCSELPAY",$JOB)
+68 ;
+69 ; PRCA*4.5*284 - Update return value to include from/thru range. See above for documentation
+70 ; Return value
QUIT RTNFLG_"^"_RNG1_"^"_RNG2
+71 ;
GLIST(FILE,NMORTIN) ; Build list for this file
+1 ; Input: FILE - File to retrieve Payers from either #344.4 OR ##344.31
+2 ; NMORTIN - 2 - lookup by TIN, 1 - lookup by Payer Name, 0 - pre 326 behavior
+3 ; Output: ^TMP("RCPAYER",$J,A1)=A2 Where:
+4 ; A1 - Counter
+5 ; A2 - Payer Name/TIN if NMORTIN=1, TIN/Payer Name if NMORTIN=2, else Payer Name
+6 ; ^TMP("RCPAYER",$J,"B",B1,B2)=B3 Where:
+7 ; B1 - Payer TIN if NMORTIN=2, else Payer Name
+8 ; B2 - Counter
+9 ; B3 - Payer Name if NMORTIN=0 or 1, else Payer TIN
+10 NEW IEN,PAYNAM,TIN
+11 ; Clear workfile
KILL ^TMP("RCPAYER",$JOB)
+12 ; Build list of Payers by TIN
IF NMORTIN=2
Begin DoDot:1
+13 SET CNT=0
SET TIN=""
+14 FOR
SET TIN=$ORDER(^RCY(FILE,"ATP",TIN))
if TIN=""
QUIT
Begin DoDot:2
+15 SET PAYNAM=""
+16 FOR
SET PAYNAM=$ORDER(^RCY(FILE,"ATP",TIN,PAYNAM))
if PAYNAM=""
QUIT
Begin DoDot:3
+17 SET CNT=CNT+1
+18 SET ^TMP("RCPAYER",$JOB,CNT)=TIN_"/"_PAYNAM
+19 SET ^TMP("RCPAYER",$JOB,"B",TIN,CNT)=PAYNAM
End DoDot:3
End DoDot:2
End DoDot:1
QUIT
+20 ;
+21 SET CNT=0
SET PAYNAM=""
+22 FOR
SET PAYNAM=$ORDER(^RCY(FILE,"APT",PAYNAM))
if PAYNAM=""
QUIT
Begin DoDot:1
+23 SET TIN=""
+24 FOR
SET TIN=$ORDER(^RCY(FILE,"APT",PAYNAM,TIN))
if TIN=""
QUIT
Begin DoDot:2
+25 SET CNT=CNT+1
+26 SET ^TMP("RCPAYER",$JOB,CNT)=$SELECT(NMORTIN=1:PAYNAM_"/"_TIN,1:PAYNAM)
+27 SET ^TMP("RCPAYER",$JOB,"B",PAYNAM,CNT)=TIN
End DoDot:2
End DoDot:1
+28 QUIT
+29 ;
+30 ; PRCA*4.5*318 - Added parameter & logic for MIXED
GETPAYS(CNT,MIXED,NMORTIN) ; Select Specific payer for filter
+1 ; Input: CNT - Number of Payers
+2 ; MIXED - 1 to display prompts in mixed case
+3 ; Optional, defaults to 0
+4 ; NMORTIN - 2 to lookup by TIN, 1 to lookup by Payer, 0 - Pre 326 behavior
+5 ; Optional, defaults to 0
+6 ; Output: RTNFLG -1 - No Payer selected
+7 ; 3 - At least one Payer selected
+8 if '$DATA(MIXED)
SET MIXED=0
+9 if '$DATA(NMORTIN)
SET NMORTIN=0
+10 KILL ^TMP("RCDPEM9",$JOB)
+11 FOR
if RTNFLG'=0
QUIT
Begin DoDot:1
+12 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+13 SET DIR("A")="SELECT INSURANCE COMPANY"
+14 ; PRCA*4.5*318
if MIXED
SET DIR("A")="Select Insurance Company "_$SELECT(NMORTIN=2:"TIN",1:"NAME")
+15 SET DIR(0)="FO^1:30"
+16 SET DIR("?")="ENTER THE "_$SELECT(NMORTIN=2:"TIN",1:"NAME")_" OF THE PAYER OR '??' TO LIST PAYERS"
+17 ; PRCA*4.5*318 - Added MIXED
+18 if MIXED
SET DIR("?")="Enter the "_$SELECT(NMORTIN=2:"TIN",1:"name")_" of the payer or '??' to list payers"
+19 SET DIR("??")="^D LIST^RCDPEM9(CNT)"
+20 DO ^DIR
KILL DIR
+21 ;
+22 ; User pressed ENTER
+23 IF Y=""
IF '$DATA(DTOUT)
SET RTNFLG=$SELECT($DATA(^TMP("RCSELPAY",$JOB)):3,1:-1)
QUIT
+24 ;
+25 ; First check for exits
+26 IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIRUT)!$DATA(DIROUT)
SET RTNFLG=-1
QUIT
+27 SET (RCANS,RCANS2)=""
SET RCANS=Y
+28 ; TIN lookup
IF NMORTIN=2
Begin DoDot:2
+29 IF '$DATA(^TMP("RCPAYER",$JOB,"B",RCANS))
Begin DoDot:3
+30 WRITE " ??"
End DoDot:3
QUIT
+31 IF $DATA(^TMP("RCDPEM9",$JOB,RCANS))
Begin DoDot:3
+32 if 'MIXED
WRITE " ?? PAYER ALREADY SELECTED"
+33 if MIXED
WRITE " ?? Payer already selected"
End DoDot:3
QUIT
+34 DO SELTIN(RCANS,.INDX)
End DoDot:2
QUIT
+35 ;
+36 ; Check for Partial Match on user input
+37 IF '(RCANS?.N)
Begin DoDot:2
+38 SET RCANS2=$ORDER(^TMP("RCPAYER",$JOB,"B",RCANS,RCANS2))
+39 if 'RCANS2
DO PART(NMORTIN,RCANS,.INDX)
End DoDot:2
if '$GET(RCANS2)
QUIT
+40 if $GET(RCANS2)
SET RCANS=RCANS2
+41 IF RCANS=""
WRITE " ??"
QUIT
+42 IF RCANS?.N
IF ((+RCANS<1)!(+RCANS>CNT))
WRITE " ??"
QUIT
+43 IF RCANS'?.N
WRITE " ??"
QUIT
+44 IF $DATA(^TMP("RCDPEM9",$JOB,RCANS))
Begin DoDot:2
+45 if 'MIXED
WRITE " ?? PAYER ALREADY SELECTED"
+46 if MIXED
WRITE " ?? Payer already selected"
End DoDot:2
QUIT
+47 SET ^TMP("RCDPEM9",$JOB,RCANS)=""
+48 WRITE " ",^TMP("RCPAYER",$JOB,RCANS)
+49 SET ^TMP("RCSELPAY",$JOB,INDX)=$GET(^TMP("RCPAYER",$JOB,RCANS))
+50 SET INDX=INDX+1
End DoDot:1
+51 KILL ^TMP("RCDPEM9",$JOB)
+52 QUIT
+53 ;
SELTIN(TIN,INDX) ; Show all the payers with the selected TIN and ask the user
+1 ; if they want to select the TIN
+2 ; Input: TIN - User Selected TIN
+3 ; INDX - Current # of selected Payers
+4 ; ^TMP("RCPAYER",$J,"B") - Array of TINs on file
+5 ; ^TMP("RCSELPAY",$J,A1)= A2/A3 Current Selected Payers Where:
+6 ; A1 - Counter
+7 ; A2 - Selected TIN
+8 ; A3 - Selected PAYER
+9 ; Output: INDX - Updated # of selected Payers
+10 ; ^TMP("RCSELPAY",$J,A1)= A2/A3 Updated Selected Payers Where:
+11 ; A1 - Counter
+12 ; A2 - Selected TIN
+13 ; A3 - Selected PAYER
+14 NEW CTR,DIR,DIROUT,DIRUT,DTOUT,DUOUT,SELPAY,X,Y
+15 WRITE !,"The following Payers with TIN ",TIN," have ERAs on file"
+16 DO PART(2,TIN,INDX,.SELPAY)
+17 SET DIR(0)="Y"
+18 SET DIR("A")="Select this TIN"
+19 SET DIR("B")="YES"
+20 DO ^DIR
+21 if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+22 if Y=0
QUIT
+23 MERGE ^TMP("RCSELPAY",$JOB)=SELPAY("RCSELPAY")
+24 SET INDX=$ORDER(SELPAY("RCSELPAY",""),-1)+1
+25 QUIT
+26 ;
LIST(CNT) ; Display all the Payers
+1 ; Prompt users for stations to be used for filtering
+2 ; Input: CNT - Total # of Payers in tmp file
+3 ; ^TMP("RCPAYER",$J,A1)=A2 Where:
+4 ; A1 - Counter
+5 ; A2 - Payer Name/TIN if NMORTIN=1, TIN/Payer Name if NMORTIN=2, else Payer Name
+6 NEW I
+7 FOR I=1:1:CNT
Begin DoDot:1
+8 WRITE !,I,".",?5,$GET(^TMP("RCPAYER",$JOB,I))
End DoDot:1
+9 QUIT
+10 ;
PART(NMORTIN,RCANS,INDX,SELPAY) ; Give the user a list of partial matches
+1 ; Input: NMORTIN - 2 - Lookup by Payer TIN, 0 or 1 - Lookup by Payer Name
+2 ; RCANS - User Payer or TIN selection
+3 ; INDX - Current # of selected Payers (only passed if NMORTIN=2)
+4 ; Output: SELPAY()- Array of selected Payers (only returned if NMORTIN=2)
+5 ; ^TMP("RCPAYER",$J,A1)=A2 Where:
+6 ; A1 - Counter
+7 ; A2 - Payer Name/TIN if NMORTIN=1, TIN/Payer Name if NMORTIN=2, else Payer Name
+8 ; ^TMP("RCPAYER",$J,"B",B1,B2)=B3 Where:
+9 ; B1 - Payer TIN if NMORTIN=0, else Payer Name
+10 ; B2 - Counter
+11 ; B3 - Payer Name if NMORTIN=0 or 1, else Payer TIN
+12 ; Output: List of Payers that meet the partial match
+13 NEW RCPAR,CNT,CTR,RCSAVE
+14 SET CNT=0
SET RCPAR=RCANS
SET RCPAR=$ORDER(^TMP("RCPAYER",$JOB,"B",RCPAR),-1)
+15 FOR
Begin DoDot:1
+16 SET RCPAR=$ORDER(^TMP("RCPAYER",$JOB,"B",RCPAR))
+17 if RCPAR=""
QUIT
+18 IF $EXTRACT(RCPAR,1,$LENGTH(RCANS))'[RCANS
SET RCPAR=""
QUIT
+19 SET CTR=0
+20 FOR
Begin DoDot:2
+21 SET CTR=$ORDER(^TMP("RCPAYER",$JOB,"B",RCPAR,CTR))
+22 if CTR=""
QUIT
+23 WRITE !,?5
+24 if NMORTIN'=2
WRITE CTR,"."
+25 WRITE ^TMP("RCPAYER",$JOB,CTR)
+26 IF NMORTIN=2
Begin DoDot:3
+27 SET SELPAY("RCSELPAY",INDX)=^TMP("RCPAYER",$JOB,CTR)
SET INDX=INDX+1
End DoDot:3
+28 SET CNT=CNT+1
+29 IF CNT=1
SET RCSAVE=^TMP("RCPAYER",$JOB,CTR)
End DoDot:2
if CTR=""
QUIT
End DoDot:1
if RCPAR=""
QUIT
+30 if 'CNT
WRITE " ??"
+31 ; one match by name, select it automatically
IF NMORTIN'=2
IF CNT=1
Begin DoDot:1
+32 SET ^TMP("RCSELPAY",$JOB,INDX)=RCSAVE
SET INDX=INDX+1
+33 WRITE " - SELECTED"
End DoDot:1
+34 QUIT
+35 ;
+36 ; PRCA*4.5*318 - Added parameters & logic for MIXED & BLANKLN
GETPAYR(MIXED,BLANKLN) ;select payer for filter, range
+1 ; called from ^RCDPEAR1
+2 ; Input: MIXED - 1 to display prompts in mixed case
+3 ; Optional, defaults to 0
+4 ; BLANKLN - 0 skip initial blank line
+5 ; Optional, defaults to 1
+6 ;
+7 ; PRCA*4.5*318
if '$DATA(MIXED)
SET MIXED=0
+8 if '$DATA(BLANKLN)
SET BLANKLN=1
+9 ;
+10 NEW DIR,DTOUT,DUOUT,DIRUT,DIROUT,INDX,X,Y,RCINSF,RCINST,NUM
+11 SET DIR("?")="ENTER THE NAME OF THE PAYER OR '??' TO LIST PAYERS"
+12 SET DIR("??")="^D LIST^RCDPEM9(CNT)"
+13 SET DIR(0)="FA^1:30^K:X'?1.U.E X"
+14 SET DIR("A")="START WITH INSURANCE COMPANY NAME: "
+15 SET DIR("B")=$EXTRACT($ORDER(^TMP("RCPAYER",$JOB,"B","")),1,30)
+16 ;PRCA*4.5*318
IF MIXED
Begin DoDot:1
+17 SET DIR("?")="Enter the name of the payer or '??' to list payers"
+18 SET DIR("A")="Start with Insurance Company name: "
End DoDot:1
+19 DO ^DIR
KILL DIR
+20 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)!(Y="")
SET RTNFLG=-1
QUIT
+21 SET RCINSF=Y
+22 SET DIR("?")="ENTER THE NAME OF THE PAYER OR '??' TO LIST PAYERS"
+23 SET DIR("??")="^D LIST^RCDPEM9(CNT)"
+24 SET DIR(0)="FA^1:30^K:X'?1.U.E X"
+25 SET DIR("A")="GO TO INSURANCE COMPANY NAME: "
+26 ;PRCA*4.5*318
IF MIXED
Begin DoDot:1
+27 SET DIR("?")="Enter the name of the payer or '??' to list payers"
+28 SET DIR("A")="Go to Insurance Company name: "
End DoDot:1
+29 SET DIR("B")=$EXTRACT($ORDER(^TMP("RCPAYER",$JOB,"B",""),-1),1,30)
+30 ; PRCA*4.5*318 - added conditional for MIXED & BLANKLN
+31 FOR
if BLANKLN
WRITE !
DO ^DIR
if $SELECT($DATA(DTOUT)!$DATA(DUOUT)
QUIT
Begin DoDot:1
+32 if 'MIXED
WRITE !,"'GO TO' NAME MUST COME AFTER 'START WITH' NAME"
+33 if MIXED
WRITE !,"'GO TO' name must come after 'START WITH' name"
End DoDot:1
+34 KILL DIR
+35 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)!(Y="")
SET RTNFLG=-1
QUIT
+36 ;entry of "ABC" will pick up "ABC INSURANCE" if "Z" is appended
SET RCINST=Y_"Z"
+37 ;If the first name is an exact match, back up to the previous entry
+38 IF $DATA(^TMP("RCPAYER",$JOB,"B",RCINSF))
SET RCINSF=$ORDER(^TMP("RCPAYER",$JOB,"B",RCINSF),-1)
+39 ; PRCA*4.5*284 - Save from/thru user responses in RNG1 & RNG2 to rebuild after report is queued. Will be returned to the calling program.
+40 SET RNG1=RCINSF
SET RNG2=RCINST
+41 SET INDX=1
FOR
SET RCINSF=$ORDER(^TMP("RCPAYER",$JOB,"B",RCINSF))
if RCINSF=""
QUIT
if RCINSF]RCINST
QUIT
Begin DoDot:1
+42 SET NUM=$ORDER(^TMP("RCPAYER",$JOB,"B",RCINSF,""))
+43 SET ^TMP("RCSELPAY",$JOB,INDX)=$GET(^TMP("RCPAYER",$JOB,NUM))
+44 SET INDX=INDX+1
End DoDot:1
+45 ;Set return value
+46 ; no entries in selected range
IF INDX=1
SET RTNFLG=-1
QUIT
+47 SET RTNFLG=1
+48 QUIT
