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

RCDPESP5.m

Go to the documentation of this file.
  1. RCDPESP5 ;ALB/SAB - ePayment Lockbox Site Parameters Definition - Files 344.71 ;29 Jan 2019 18:00:14
  1. ;;4.5;Accounts Receivable;**304,321,326,332,345,349**;Mar 20, 1995;Build 44
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. Q
  1. ;
  1. PRTCARC(PAID,RCARCTYP) ; Display current entries that have been defined for
  1. ; inclusion or exclusion into - PAID added - PRCA*4.5*326
  1. ; PRCA4*5*345 - Added RCARCTYP parameter
  1. ; Input: PAID: 0 - Auto-Decrease CARCs for Paid claim lines
  1. ; 1 - Auto-Decrease CARCs for No-Pay claim lines
  1. ; RCARCTYP: 0 - Medical Auto-Decrease CARCs
  1. ; 1 - Rx Auto-Decrease CARCs
  1. ; 2 - TRICARE Auto-Decrease CARCs
  1. ; Optional, defaults to 0
  1. ;
  1. N FIELD,RCCIEN,RCCODE,RCCT,RCCODE,RCDATA,RCDESC,RCI,RCSTAT,Y
  1. S:'$D(RCARCTYP) RCARCTYP=0 ; PRCA4*5*345 - Added line
  1. ; Print Header
  1. W !," CARC Description"_$J("Max. Amt",55),!," "_$$EQLSGNS^RCDPESP2(73)
  1. ;
  1. ; Loop and print entries
  1. S RCCT=0
  1. S RCCODE="" F S RCCODE=$O(^RCY(344.62,"B",RCCODE)) Q:RCCODE="" D ; PRCA*4.5*349 - Sort CARC entries by CARC code instead of by most recently entered
  1. . S RCI=0 F S RCI=$O(^RCY(344.62,"B",RCCODE,RCI)) Q:'RCI D ; PRCA*4.5*349 - Sort CARC entries by CARC code instead of by most recently entered
  1. . . N RCCARCD
  1. . . S RCDATA=$G(^RCY(344.62,RCI,0)) Q:RCDATA=""
  1. . . S RCCIEN=$O(^RC(345,"B",RCCODE,""))
  1. . . S RCDESC=$G(^RC(345,RCCIEN,1,1,0))
  1. . . ;
  1. . . ; PRCA*4.5*345, PRCA*4.5*349 - Added Rx and TRICARE checks below
  1. . . ; determine enable/disable CARC audit field
  1. . . I RCARCTYP=0 S FIELD=$S(PAID:.02,1:.08) ; Medical CARC
  1. . . I RCARCTYP=1 S FIELD=2.01 ; Pharmacy CARC
  1. . . I RCARCTYP=2 S FIELD=$S(PAID:3.01,1:3.07) ; TRICARE CARC
  1. . . ;
  1. . . S RCSTAT=$$GET1^DIQ(344.62,RCI,FIELD,"I")
  1. . . Q:RCSTAT'=1
  1. . . S RCCT=RCCT+1
  1. . . I $L(RCDESC)>50 S RCDESC=$E(RCDESC,1,50)_" ..."
  1. . . D GETCODES^RCDPCRR(RCCODE,"","B",$$DT^XLFDT,"RCCARCD","1^70")
  1. . . ; Amount field to display PRCA*4.5*349 - Add TRICARE
  1. . . I RCARCTYP=0 S FIELD=$S(PAID:.06,1:.12) ; Medical CARC
  1. . . I RCARCTYP=1 S FIELD=2.05 ; Pharmacy CARC
  1. . . I RCARCTYP=2 S FIELD=$S(PAID:3.05,1:3.11) ; TRICARE CARC
  1. . . ;
  1. . . S Y=" "_$$PAD^RCDPESPA(RCCODE,6)_$$PAD^RCDPESPA(RCDESC,55)_$J($$GET1^DIQ(344.62,RCI,FIELD,"I"),9)
  1. . . I $P(RCCARCD("CARC",RCCODE,RCCIEN),U,3)'="" S Y=Y_" (I)" ; if inactive, display (I)
  1. . . W !,Y
  1. ;
  1. I RCCT=0 W !," NO CARC/AMOUNTS ENTERED"
  1. Q
  1. ;
  1. GETREASN(RCCARC) ; EP from ^RCDPESP7 - Get the reason for modification
  1. N DA,DIR,DTOUT,DUOUT,X,Y,DIRUT,DIROUT
  1. S DIR("?")="Enter reason for enabling/disabling, or changing the Maximum Dollar decrease amount for CARC "_RCCARC_" (3-50 chars)."
  1. S DIR(0)="FA^3:50"
  1. S DIR("A")="COMMENT: "
  1. S DIR("PRE")="S X=$$TRIM^XLFSTR(X,""LR"")" ; comment required and should be significant
  1. D ^DIR
  1. K DIR
  1. I $G(DUOUT) S Y=-1
  1. Q Y
  1. ;
  1. UPDDATA(RCCIEN,RCSTAT,RCAMT,RCRSN,PAID,RCARCTYP) ; EP from RCDPESP7 - Update the database and audit log
  1. ; PAID added PRCA*4.5*326
  1. ; PRCA4*5*345 - Added RCARCTYP
  1. ; Input: RCCIEN - IEN of the CARC (#344.62(
  1. ; RCSTAT - 1 - Enabling Auto-Decrease, 0 - Disabling
  1. ; RCAMT - Auto-Decrease amount for the CARC
  1. ; RCRSN - Comment
  1. ; PAID - 1 - Paid CARC list, 0 - No-Pay CARC List
  1. ; RCARCTYP - 0 - Medical Claims, 1 - Rx Claims, 2 - TRICARE Claims
  1. N DA,DR,DIC,DIE,DTOUT,X,Y
  1. ; replaced //// with /// in following 5 lines - PRCA*4.5*321
  1. S DA=RCCIEN,(DIC,DIE)="^RCY(344.62,"
  1. ; BEGIN - PRCA*4.5*326
  1. ; CARCs for Paid Medical Claims PRCA4*5*345 - added RCARCTYP=0
  1. I PAID=1,RCARCTYP=0 D
  1. . S DR=".02///"_RCSTAT_";"
  1. . S DR=DR_".05///"_$$DT^XLFDT_";" ; PRCA*4.5*326
  1. . S DR=DR_".04///"_DUZ_";"
  1. . S DR=DR_".06///"_RCAMT_";"
  1. . S DR=DR_".07///"_RCRSN_";"
  1. ;
  1. ; CARCs for PAID Rx Claims PRCA*4.5*345 - added If statement
  1. I PAID=1,RCARCTYP=1 D
  1. . S DR="2.01///"_RCSTAT_";"
  1. . S DR=DR_"2.04///"_$$DT^XLFDT_";"
  1. . S DR=DR_"2.03///"_DUZ_";"
  1. . S DR=DR_"2.05///"_RCAMT_";"
  1. . S DR=DR_"2.06///"_RCRSN_";"
  1. ;
  1. ; CARCs for PAID TRICARE Claims PRCA*4.5*349 - added If statment
  1. I PAID=1,RCARCTYP=2 D
  1. . S DR="3.01///"_RCSTAT_";"
  1. . S DR=DR_"3.04///"_$$DT^XLFDT_";"
  1. . S DR=DR_"3.03///"_DUZ_";"
  1. . S DR=DR_"3.05///"_RCAMT_";"
  1. . S DR=DR_"3.06///"_RCRSN_";"
  1. ;
  1. ; CARCs for No-pay Medical Claims PRCA4*5*345 - added RCARCTYP=0
  1. I PAID=0,RCARCTYP=0 D
  1. . S DR=".08///"_RCSTAT_";"
  1. . S DR=DR_".11///"_$$DT^XLFDT_";"
  1. . S DR=DR_".10///"_DUZ_";"
  1. . S DR=DR_".12///"_RCAMT_";"
  1. . S DR=DR_".13///"_RCRSN_";"
  1. ; END - PRCA*4.5*326
  1. ;
  1. ;
  1. ; CARCs for No-pay TRICARE claims PRCA*4.5*349 - added If statement
  1. I PAID=0,RCARCTYP=2 D
  1. . S DR="3.07///"_RCSTAT_";"
  1. . S DR=DR_"3.1///"_$$DT^XLFDT_";"
  1. . S DR=DR_"3.09///"_DUZ_";"
  1. . S DR=DR_"3.11///"_RCAMT_";"
  1. . S DR=DR_"3.12///"_RCRSN_";"
  1. ;
  1. L +^RCY(344.62,RCCIEN):10 E Q ; PRCA*4.5*326 timeout condition added
  1. D ^DIE
  1. L -^RCY(344.62,RCCIEN)
  1. Q ; PRCA*4.5*326 - return value removed
  1. ;
  1. ADDDATA(RCCARC,RCAMT,RCRSN,PAID,RCARCTYP) ; EP from RCDPESP7 - Add new entry to the table
  1. ; PAID added PRCA*4.5*326
  1. ; PRCA4*5*345 - Added RCARCTYP
  1. ; Input: RCCARC - IEN of the CARC being added
  1. ; RCAMT - Auto-Decrease Amount
  1. ; RCRSN - Comment
  1. ; PAID - 1 - Paid Claims, 0 - No-Pay Claims
  1. ; RCARCTYP - 0 - Medical, 1 - Rx, 2 - TRICARE
  1. N MSGROOT,RCENTRY,RCROOT
  1. ;
  1. ; BEGIN - PRCA*4.5*326
  1. ; Set up array for Paid Medical Claims PRCA4*5*345 - Added RCARCTYP
  1. I PAID=1,RCARCTYP=0 D
  1. . S RCENTRY(344.62,"+1,",.01)=RCCARC ; CARC Code
  1. . S RCENTRY(344.62,"+1,",.02)=1 ; Enabled status
  1. . S RCENTRY(344.62,"+1,",.03)=$$DT^XLFDT ; Date added PRCA*4.5*326
  1. . S RCENTRY(344.62,"+1,",.04)=DUZ ; User
  1. . S RCENTRY(344.62,"+1,",.06)=RCAMT ; Max amount
  1. . S RCENTRY(344.62,"+1,",.07)=RCRSN ; Comment
  1. ;
  1. ; Set up array for Paid RX Claims PRCA4*5*345 - Added If statement
  1. I PAID=1,RCARCTYP=1 D
  1. . S RCENTRY(344.62,"+1,",.01)=RCCARC ; CARC Code
  1. . S RCENTRY(344.62,"+1,",2.01)=1 ; Enabled status
  1. . S RCENTRY(344.62,"+1,",2.02)=$$DT^XLFDT ; Date added
  1. . S RCENTRY(344.62,"+1,",2.03)=DUZ ; User
  1. . S RCENTRY(344.62,"+1,",2.05)=RCAMT ; Max amount
  1. . S RCENTRY(344.62,"+1,",2.06)=RCRSN ; Comment
  1. ;
  1. ; Set up array for paid TRICARE Claims PRCA*4.5*349 - Added If statement
  1. I PAID=1,RCARCTYP=2 D
  1. . S RCENTRY(344.62,"+1,",.01)=RCCARC ; CARC Code
  1. . S RCENTRY(344.62,"+1,",3.01)=1 ; Enabled status
  1. . S RCENTRY(344.62,"+1,",3.02)=$$DT^XLFDT ; Date added
  1. . S RCENTRY(344.62,"+1,",3.03)=DUZ ; User
  1. . S RCENTRY(344.62,"+1,",3.05)=RCAMT ; Max amount
  1. . S RCENTRY(344.62,"+1,",3.06)=RCRSN ; Comment
  1. ;
  1. ; Set up array for No-Pay Medical Claims PRCA4*5*345 - Added RCARCTYP
  1. I PAID=0,RCARCTYP=0 D
  1. . S RCENTRY(344.62,"+1,",.01)=RCCARC ; CARC Code
  1. . S RCENTRY(344.62,"+1,",.08)=1 ; Enabled status
  1. . S RCENTRY(344.62,"+1,",.09)=$$DT^XLFDT ; Date/Time added
  1. . S RCENTRY(344.62,"+1,",.10)=DUZ ; User
  1. . S RCENTRY(344.62,"+1,",.12)=RCAMT ; Max amount
  1. . S RCENTRY(344.62,"+1,",.13)=RCRSN ; Comment
  1. ; END - PRCA*4.5*326
  1. ;
  1. ; Set up array for No-Pay TRICARE Claims PRCA*4.5*349 - Added If statement
  1. I PAID=0,RCARCTYP=2 D
  1. . S RCENTRY(344.62,"+1,",.01)=RCCARC ; CARC Code
  1. . S RCENTRY(344.62,"+1,",3.07)=1 ; Enabled status
  1. . S RCENTRY(344.62,"+1,",3.08)=$$DT^XLFDT ; Date added
  1. . S RCENTRY(344.62,"+1,",3.09)=DUZ ; User
  1. . S RCENTRY(344.62,"+1,",3.11)=RCAMT ; Max amount
  1. . S RCENTRY(344.62,"+1,",3.12)=RCRSN ; Comment
  1. ;file entry
  1. D UPDATE^DIE(,"RCENTRY","RCROOT","MSGROOT")
  1. Q
  1. ;
  1. AUDIT() ;EP from RCDPESP
  1. ; File Audit Trail entry
  1. ;
  1. N EMEDANS,ERXANS,MEDANS,RCPRM,RXANS
  1. W !
  1. ; Get existing answers for Medical and Pharmacy paper bills
  1. S RCPRM("oldMed")=$$GET1^DIQ(342,"1,",7.05,"I")
  1. S RCPRM("oldPharm")=$$GET1^DIQ(342,"1,",7.06,"I")
  1. ; Get existing (#7.09) AUTO-AUDIT TRICARE EDI BILLS [9S]
  1. S RCPRM("oldTri")=$$GET1^DIQ(342,"1,",7.09,"I")
  1. ;
  1. ; Get existing answers for Medical and Pharmacy EDI (electronic) bills ; PRCA*4.5*321
  1. S RCPRM("eOldMed")=$$GET1^DIQ(342,"1,",7.07,"I") ; PRCA*4.5*321
  1. S RCPRM("eOldPharm")=$$GET1^DIQ(342,"1,",7.08,"I") ; PRCA*4.5*321
  1. ;
  1. ; Get Medical paper bills
  1. S MEDANS=$$GETAUDIT(1)
  1. Q:MEDANS=-1 1
  1. ;
  1. ; File Medical paper bills
  1. I MEDANS'=RCPRM("oldMed") D
  1. . N RCAUDVAL
  1. . D FILEANS(7.05,MEDANS)
  1. . ; FILE NUMBER^FIELD NUMBER^IEN^NEW VALUE^OLD VALUE^COMMENT
  1. . S RCAUDVAL(1)="342^7.05^1^"_MEDANS_U_RCPRM("oldMed")_U_"Updating the Medical Auto-Audit of paper bills"
  1. . D AUDIT^RCDPESP(.RCAUDVAL)
  1. ;
  1. ; Get Pharmacy paper bills
  1. S RXANS=$$GETAUDIT(2)
  1. Q:RXANS=-1 1
  1. ;
  1. ; File Pharmacy paper bills
  1. I RXANS'=RCPRM("oldPharm") D
  1. . N RCAUDVAL
  1. . D FILEANS(7.06,RXANS)
  1. . S RCAUDVAL(1)="342^7.06^1^"_RXANS_U_RCPRM("oldPharm")_U_"Updating the Pharmacy Auto-Audit of paper bills"
  1. . D AUDIT^RCDPESP(.RCAUDVAL)
  1. ;
  1. ; BEGIN PRCA*4.5*321
  1. ; Get Medical electronic bills
  1. S EMEDANS=$$GETAUDIT(3)
  1. Q:EMEDANS=-1 1
  1. ;
  1. ; File Medical electronic bills
  1. I EMEDANS'=RCPRM("eOldMed") D
  1. . N RCAUDVAL
  1. . D FILEANS(7.07,EMEDANS)
  1. . ; FILE NUMBER^FIELD NUMBER^IEN^NEW VALUE^OLD VALUE^COMMENT
  1. . S RCAUDVAL(1)="342^7.07^1^"_EMEDANS_U_RCPRM("eOldMed")_U_"Updating the Medical Auto-Audit of electronic bills"
  1. . D AUDIT^RCDPESP(.RCAUDVAL)
  1. ;
  1. ; Get Pharmacy electronic bills
  1. S ERXANS=$$GETAUDIT(4)
  1. Q:ERXANS=-1 1
  1. ;
  1. ; File Pharmacy electronic bills
  1. I ERXANS'=RCPRM("eOldPharm") D
  1. . N RCAUDVAL
  1. . D FILEANS(7.08,ERXANS)
  1. . S RCAUDVAL(1)="342^7.08^1^"_ERXANS_U_RCPRM("eOldPharm")_U_"Updating the Pharmacy Auto-Audit of electronic bills"
  1. . D AUDIT^RCDPESP(.RCAUDVAL)
  1. ; END PRCA*4.5*321
  1. ;
  1. S RCPRM("newTri")=$$GETAUDIT(5)
  1. Q:RCPRM("newTri")=-1 1
  1. ; (#7.09) AUTO-AUDIT TRICARE EDI BILLS [9S] - PRCA*4.5*332
  1. I RCPRM("newTri")'=RCPRM("oldTri") D
  1. . N RCAUDVAL
  1. . D FILEANS(7.09,RCPRM("newTri"))
  1. . ; FILE NUMBER^FIELD NUMBER^IEN^NEW VALUE^OLD VALUE^COMMENT
  1. . S RCAUDVAL(1)="342^7.09^1^"_RCPRM("newTri")_U_RCPRM("oldTri")_U_"Updating the Auto-Audit of Tricare bills"
  1. . D AUDIT^RCDPESP(.RCAUDVAL)
  1. ;
  1. Q 0
  1. ;
  1. GETAUDIT(FLAG) ; Retrieve the parameter for the bill type
  1. ; BEGIN PRCA*4.5*321
  1. ;FLAG - What audit type (1=Med Paper, 2=RX Paper, 3=Med EDI, 4=Rx EDI, 5=Tricare)
  1. Q:'$G(FLAG) -1
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,FLDNO,RCANS,TYPL,TYPU,X,Y
  1. S TYPL=$S(FLAG>2:"electronic",1:"paper")
  1. S TYPU=$S(FLAG>2:"ELECTRONIC",1:"PAPER")
  1. S FLDNO=$S(FLAG=1:7.05,FLAG=2:7.06,FLAG=3:7.07,FLAG=4:7.08,FLAG=5:7.09,1:0)
  1. Q:'FLDNO -1
  1. ;
  1. ; Prompt for Medical Auto-audit
  1. D:$G(FLAG)#2=1
  1. . S DIR("A")="ENABLE AUTO-AUDIT FOR MEDICAL "_TYPU_" BILLS (Y/N): "
  1. . S DIR("?",1)="Allow a site to automatically audit their Medical "_TYPL_" Bills"
  1. . S DIR("?",2)="during the AR Nightly Process."
  1. . S DIR("?",3)=" "
  1. . S RCANS=$$GET1^DIQ(342,"1,",FLDNO)
  1. ;
  1. ; Prompt for Pharmacy Auto-audit
  1. D:$G(FLAG)#2=0
  1. . S DIR("A")="ENABLE AUTO-AUDIT FOR PHARMACY "_TYPU_" BILLS (Y/N): "
  1. . S DIR("?",1)="Allow a site to automatically audit their Pharmacy "_TYPL_" Bills"
  1. . S DIR("?",2)="during the AR Nightly Process."
  1. . S DIR("?",3)=" "
  1. . S RCANS=$$GET1^DIQ(342,"1,",FLDNO)
  1. ; END PRCA*4.5*321
  1. ;
  1. ; Prompt for Tricare Auto-audit PRCA*4.5*332
  1. D:$G(FLAG)=5
  1. . S DIR("A")="ENABLE AUTO-AUDIT FOR TRICARE BILLS (Y/N): "
  1. . S DIR("?",1)="Allow a site to automatically audit their Tricare Bills"
  1. . S DIR("?",2)="during the AR Nightly Process."
  1. . S DIR("?",3)=" "
  1. . S RCANS=$$GET1^DIQ(342,"1,",7.09)
  1. ;
  1. S DIR(0)="YAO"
  1. S DIR("?")="Enter Yes or No to select automatic processing of "_TYPL_" bills." ; PRCA*4.5*321
  1. S DIR("B")=$S($G(RCANS)'="":RCANS,1:"No")
  1. D ^DIR K DIR
  1. I Y="" Q ""
  1. I $D(DTOUT)!$D(DUOUT)!(Y="") Q -1
  1. Q Y
  1. ;
  1. FILEANS(FIELD,ANS) ; File the answer
  1. N DR,DIE,DA,DTOUT,DIDEL,X,Y
  1. ;
  1. ; Update Transaction
  1. S DR=FIELD_"///"_ANS ; Original Confirmation #
  1. S DIE="^RC(342,",DA=1 D ^DIE
  1. Q
  1. ;
  1. ;BEGIN PRCA*4.5*326
  1. CARCDSP(RCMAX,RCARCTYP) ; EP ^RCDPESP7
  1. ; Input: RCMAX - Maximum CARC amount
  1. ; RCARCTYP - 0 - Medical CARCs, 1 - Rx CARCs
  1. N RCCHECK
  1. ;
  1. ; Check for CARCs that will be reset to the new maximum and display
  1. S RCCHECK=0
  1. ; PRCA4*5*345 - Added RCARCTYP to next 2 lines
  1. D CHECK^RCDPESPB(RCMAX,1,1,.RCCHECK,RCARCTYP) ; Paid line CARCs
  1. I RCARCTYP'=1 D CHECK^RCDPESPB(RCMAX,0,1,.RCCHECK,RCARCTYP) ; No-Pay line CARCs
  1. ;
  1. ; Finish if none found
  1. Q:'RCCHECK 1
  1. ;
  1. ; Ask if OK to proceed and reduce these CARCs
  1. N DIR,DTOUT,DUOUT
  1. S DIR(0)="YA"
  1. S DIR("A")="Do you want to continue (Y/N)? "
  1. W ! D ^DIR
  1. I $D(DUOUT)!$D(DTOUT) Q "QUIT" ; Abort
  1. ;
  1. ; Go back and re-enter maximum amount
  1. I 'Y Q 0
  1. S RCCHECK=0 ; Update the CARCs previously displayed
  1. ; PRCA4*5*345 - Added RCARCTYP to next 2 lines
  1. D CHECK^RCDPESPB(RCMAX,1,0,.RCCHECK,RCARCTYP) ; Update paid line CARCs
  1. I RCARCTYP'=1 D CHECK^RCDPESPB(RCMAX,0,0,.RCCHECK,RCARCTYP) ; Update no-pay line CARCs
  1. Q 1