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