PRCACPV ;WASH-ISC@ALTOONA,PA/LDB - CHAMPVA FMS DOCUMENTS ;5/1/95 3:06 PM
V ;;4.5;Accounts Receivable;**1,48,90,119,204,192,235,295,315,338,357,365,392**;Mar 20, 1995;Build 10
;;Per VA Directive 6402, this routine should not be modified.
;
;Add CAT=47:"INELIGIBLE REIMB. ins. code for PRCA*4.5*315
EN(BILL,ERR) ;Send CHAMPVA SUBSISTENCE bill to FMS
N ADD,ADDR,AMT,BILL0,BNUM,CAT,DA,DIE,DOC,DR,ERROR,ENT,FY,GECSFMS,I,P,PAT,SITE,TXT,VA,VAERR,VADM,X,XMDUZ,XMTEXT,XMY,XMSUB,Y,TMPAMT,DESC
S ERR=-1
I '$G(BILL) S ERR="NO BILL NUMBER TO PROCESS" D ERR Q
S BILL0=$G(^PRCA(430,+BILL,0)) I BILL0']"" S ERR="BILL INFO CORRUPTED FOR BILL '"_BILL D ERR Q
;Allow all TRICARE categories to transmit to FMS - PRCA*4.5*295
;Add ineligible reimb ins *315
I "^27^28^30^31^32^47^80^"'[("^"_$P(BILL0,"^",2)_"^") Q
S SITE=$P($P(BILL0,"^"),"-") I SITE']"" S ERR="BILL NUMBER CORRUPTED" D ERR Q
S BNUM=$P(BILL0,"^")
S TMPAMT=$$CHKTCARE(+BILL),AMT=$J($S(+TMPAMT:$P(TMPAMT,U,2),1:$P(BILL0,U,3)),0,2) ; PRCA*4.5*392
S CAT=$P(BILL0,"^",2)
I "^27^31^"[("^"_CAT_"^") S PAT=$P($G(^PRCA(430,+BILL,0)),"^",9),PAT=$P($G(^RCD(340,+PAT,0)),"^"),PAT=$$NAM^RCFN01(PAT),PAT=$P(PAT,",",2)_" "_$P(PAT,",")
S FY=$$FY^RCFN01(DT)
S ADD=$$SADD^RCFN01(5)
;Add ineligible reimb ins *315
S DESC=$S(CAT=27:"CHAMPVA Subsistence",CAT=30:"TRICARE",CAT=31:"TRICARE PATIENT",CAT=32:"TRICARE Third Party",CAT=47:"INELIGIBLE HOSP. REIMB.",CAT=80:"TRICARE PHARMACY",1:"CHAMPVA Third Party")
F I=1:1:6 S ADDR(I)=$P(ADD,"^",I) I (I'=3),(ADDR(I)']"") S ERR="NO HOSPITAL ADDRESS FOUND FOR SITE GROUP" D ERR Q
I ERR>0 Q
;CALL TO GET VENDORID BELOW - CHECK NOT NECESSARY SINCE GENERIC
;VENDOR CODE ALWAYS RETURNED FOR THESE BILL TYPES
S VENDORID=$$VENDORID^RCXFMSUV(BILL)
I ADDR(6)["-" S ADDR(7)=$P(ADDR(6),"-",2),ADDR(6)=$P(ADDR(6),"-")
N FMSDT S FMSDT=$$FMSDATE^RCBEUTRA(DT)
S ^TMP("PRCACPV",$J,1)="BD2^"_$E(FMSDT,4,5)_"^"_$E(FMSDT,6,7)_"^"_$E(FMSDT,2,3)
S ^TMP("PRCACPV",$J,1)=^TMP("PRCACPV",$J,1)_"^^^^^^E^"_VENDORID_"^^"_AMT_"^^^^"_$E(ADDR(1),1,30)_"^"_$E(ADDR(2),1,30)_"^"_$E(ADDR(3),1,30)_"^"_$E(ADDR(4),1,19)_"^"_ADDR(5)_"^"_ADDR(6)_"^"_$G(ADDR(7))_"^"_"N^^^^^^W^~"
;Add ineligible reimb ins *315
S ^TMP("PRCACPV",$J,2)="LIN^~BDA^"_$$LINE^RCXFMSC1(BILL)_"^"_FY_"^^"_$S(CAT=28:"0160R1",CAT<30:"3220",CAT=47:"0160R1",1:"0160R1")_"^"_SITE_"^^^" ; patch PRCA*4.5*338
S:CAT<30 CAT("R")=1000
I CAT'<30 S CAT("R")=$P($G(^PRCA(430,+BILL,11)),U,6)
;Add ineligible reimb ins *315
S ^TMP("PRCACPV",$J,2)=^TMP("PRCACPV",$J,2)_CAT("R")_"^^^^^^^"_AMT_"^I^AR_INTERFACE^^^^"_$S(CAT<30:"09",CAT=47:"02",1:"02")_"^~"
D CONTROL^GECSUFMS("A",SITE,BNUM,"BD",10,0,"",DESC)
I '$D(GECSFMS("DA")) S ERR="COULD NOT ACCESS STACK FILE" D ERR Q
S DOC=$S($G(GECSFMS("DOC"))]"":$P(GECSFMS("DOC"),"^",3)_"-"_$P(GECSFMS("DOC"),"^",4),1:BNUM)
S DA=0 F S DA=$O(^TMP("PRCACPV",$J,DA)) Q:'DA D
. D SETCS^GECSSTAA(GECSFMS("DA"),^TMP("PRCACPV",$J,DA))
D OPEN^RCFMDRV1(DOC,6,"B"_+BILL,.ENT,.ERROR,+BILL)
I ERROR]"" S ERR="AR DOCUMENT MISSING - "_ERROR Q
D SETCODE^GECSSDCT(GECSFMS("DA"),"D RETN^RCFMFN02")
D SETSTAT^GECSSTAA(GECSFMS("DA"),"Q")
D SSTAT^RCFMFN02("B"_+BILL,1)
K ^TMP("PRCACPV",$J)
;
ERR ;Add ineligible reimb ins *315
I ERR'<0 S ERR="1^"_ERR D
.S TXT(1)="The following error has occurred while processing a "_$S(CAT=80:"TRICARE PHARMACY ",CAT=31:"TRICARE PATIENT ",CAT=47:"INELIGIBLE REIMB. INS. PATIENT",1:"CHAMPVA")
.S TXT(2)="bill: ("_$S($G(BNUM):BNUM,1:"BILL IFN - "_+BILL)_")"
.S TXT(3)=" "
.S TXT(4)=$P(ERR,"^",2)
.S TXT(5)=""
.S TXT(6)="You will need to use the BILLING DOCUMENT REGENERATION option to create the FMS document."
.S XMTEXT="TXT(",XMY("G.PRCA ERROR")=""
.S XMSUB=$S(CAT=31:"TRICARE PATIENT",CAT=30:"TRICARE",CAT=32:"TRICARE Third Party",CAT=47:"INELIGIBLE REIMB. INS. PATIENT",CAT=80:"TRICARE PHARMACY",1:"CHAMPVA")_" FMS DOC error",XMDUZ="ACCOUNTS RECEIVABLE PACKAGE"
.D ^XMD
Q
;
CHKTCARE(BILL) ; check if this is a Tricare Patient charge with orig. balance = 0 and only single "increase adjustment" transaction present PRCA*4.5*392
;
; BILL - file 430 ien
;
; returns "1 ^ increase adjustment amount" if check resolves to True, 0 otherwise
;
N CAT,N0,TN1,TRAN,TRTYPE
I BILL'>0 Q 0 ; invalid file 430 ien
S N0=$G(^PRCA(430,BILL,0)) I N0="" Q 0
I +$P(N0,U,3)'=0 Q 0 ; orig amount is not 0
I $$GET1^DIQ(430.2,$P(N0,U,2)_",",.01)'="TRICARE PATIENT" Q 0 ; not a Tricare Patient charge
S TRAN=+$O(^PRCA(433,"C",BILL,"")) I TRAN'>0 Q 0 ; can't find the first transaction
S TN1=$G(^PRCA(433,TRAN,1)) ; file 433 entry, node 1
I $$GET1^DIQ(430.3,$P(TN1,U,2)_",",.01)'="INCREASE ADJUSTMENT" Q 0 ; 1st transaction is not "increase adjustment"
I +$O(^PRCA(433,"C",BILL,TRAN))>0 Q 0 ; more than one transaction present
Q "1^"_+$P(TN1,U,5)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCACPV 4829 printed Nov 22, 2024@16:49:27 Page 2
PRCACPV ;WASH-ISC@ALTOONA,PA/LDB - CHAMPVA FMS DOCUMENTS ;5/1/95 3:06 PM
V ;;4.5;Accounts Receivable;**1,48,90,119,204,192,235,295,315,338,357,365,392**;Mar 20, 1995;Build 10
+1 ;;Per VA Directive 6402, this routine should not be modified.
+2 ;
+3 ;Add CAT=47:"INELIGIBLE REIMB. ins. code for PRCA*4.5*315
EN(BILL,ERR) ;Send CHAMPVA SUBSISTENCE bill to FMS
+1 NEW ADD,ADDR,AMT,BILL0,BNUM,CAT,DA,DIE,DOC,DR,ERROR,ENT,FY,GECSFMS,I,P,PAT,SITE,TXT,VA,VAERR,VADM,X,XMDUZ,XMTEXT,XMY,XMSUB,Y,TMPAMT,DESC
+2 SET ERR=-1
+3 IF '$GET(BILL)
SET ERR="NO BILL NUMBER TO PROCESS"
DO ERR
QUIT
+4 SET BILL0=$GET(^PRCA(430,+BILL,0))
IF BILL0']""
SET ERR="BILL INFO CORRUPTED FOR BILL '"_BILL
DO ERR
QUIT
+5 ;Allow all TRICARE categories to transmit to FMS - PRCA*4.5*295
+6 ;Add ineligible reimb ins *315
+7 IF "^27^28^30^31^32^47^80^"'[("^"_$PIECE(BILL0,"^",2)_"^")
QUIT
+8 SET SITE=$PIECE($PIECE(BILL0,"^"),"-")
IF SITE']""
SET ERR="BILL NUMBER CORRUPTED"
DO ERR
QUIT
+9 SET BNUM=$PIECE(BILL0,"^")
+10 ; PRCA*4.5*392
SET TMPAMT=$$CHKTCARE(+BILL)
SET AMT=$JUSTIFY($SELECT(+TMPAMT:$PIECE(TMPAMT,U,2),1:$PIECE(BILL0,U,3)),0,2)
+11 SET CAT=$PIECE(BILL0,"^",2)
+12 IF "^27^31^"[("^"_CAT_"^")
SET PAT=$PIECE($GET(^PRCA(430,+BILL,0)),"^",9)
SET PAT=$PIECE($GET(^RCD(340,+PAT,0)),"^")
SET PAT=$$NAM^RCFN01(PAT)
SET PAT=$PIECE(PAT,",",2)_" "_$PIECE(PAT,",")
+13 SET FY=$$FY^RCFN01(DT)
+14 SET ADD=$$SADD^RCFN01(5)
+15 ;Add ineligible reimb ins *315
+16 SET DESC=$SELECT(CAT=27:"CHAMPVA Subsistence",CAT=30:"TRICARE",CAT=31:"TRICARE PATIENT",CAT=32:"TRICARE Third Party",CAT=47:"INELIGIBLE HOSP. REIMB.",CAT=80:"TRICARE PHARMACY",1:"CHAMPVA Third Party")
+17 FOR I=1:1:6
SET ADDR(I)=$PIECE(ADD,"^",I)
IF (I'=3)
IF (ADDR(I)']"")
SET ERR="NO HOSPITAL ADDRESS FOUND FOR SITE GROUP"
DO ERR
QUIT
+18 IF ERR>0
QUIT
+19 ;CALL TO GET VENDORID BELOW - CHECK NOT NECESSARY SINCE GENERIC
+20 ;VENDOR CODE ALWAYS RETURNED FOR THESE BILL TYPES
+21 SET VENDORID=$$VENDORID^RCXFMSUV(BILL)
+22 IF ADDR(6)["-"
SET ADDR(7)=$PIECE(ADDR(6),"-",2)
SET ADDR(6)=$PIECE(ADDR(6),"-")
+23 NEW FMSDT
SET FMSDT=$$FMSDATE^RCBEUTRA(DT)
+24 SET ^TMP("PRCACPV",$JOB,1)="BD2^"_$EXTRACT(FMSDT,4,5)_"^"_$EXTRACT(FMSDT,6,7)_"^"_$EXTRACT(FMSDT,2,3)
+25 SET ^TMP("PRCACPV",$JOB,1)=^TMP("PRCACPV",$JOB,1)_"^^^^^^E^"_VENDORID_"^^"_AMT_"^^^^"_$EXTRACT(ADDR(1),1,30)_"^"_$EXTRACT(ADDR(2),1,30)_"^"_$EXTRACT(ADDR(3),1,30)_"^"_$EXTRACT(ADDR(4),1,19)_"^"_ADDR(5)_"^"_ADDR(6)_"^"_$GET(ADDR(7))_"^"_"N^^^^^^
W^~"
+26 ;Add ineligible reimb ins *315
+27 ; patch PRCA*4.5*338
SET ^TMP("PRCACPV",$JOB,2)="LIN^~BDA^"_$$LINE^RCXFMSC1(BILL)_"^"_FY_"^^"_$SELECT(CAT=28:"0160R1",CAT<30:"3220",CAT=47:"0160R1",1:"0160R1")_"^"_SITE_"^^^"
+28 if CAT<30
SET CAT("R")=1000
+29 IF CAT'<30
SET CAT("R")=$PIECE($GET(^PRCA(430,+BILL,11)),U,6)
+30 ;Add ineligible reimb ins *315
+31 SET ^TMP("PRCACPV",$JOB,2)=^TMP("PRCACPV",$JOB,2)_CAT("R")_"^^^^^^^"_AMT_"^I^AR_INTERFACE^^^^"_$SELECT(CAT<30:"09",CAT=47:"02",1:"02")_"^~"
+32 DO CONTROL^GECSUFMS("A",SITE,BNUM,"BD",10,0,"",DESC)
+33 IF '$DATA(GECSFMS("DA"))
SET ERR="COULD NOT ACCESS STACK FILE"
DO ERR
QUIT
+34 SET DOC=$SELECT($GET(GECSFMS("DOC"))]"":$PIECE(GECSFMS("DOC"),"^",3)_"-"_$PIECE(GECSFMS("DOC"),"^",4),1:BNUM)
+35 SET DA=0
FOR
SET DA=$ORDER(^TMP("PRCACPV",$JOB,DA))
if 'DA
QUIT
Begin DoDot:1
+36 DO SETCS^GECSSTAA(GECSFMS("DA"),^TMP("PRCACPV",$JOB,DA))
End DoDot:1
+37 DO OPEN^RCFMDRV1(DOC,6,"B"_+BILL,.ENT,.ERROR,+BILL)
+38 IF ERROR]""
SET ERR="AR DOCUMENT MISSING - "_ERROR
QUIT
+39 DO SETCODE^GECSSDCT(GECSFMS("DA"),"D RETN^RCFMFN02")
+40 DO SETSTAT^GECSSTAA(GECSFMS("DA"),"Q")
+41 DO SSTAT^RCFMFN02("B"_+BILL,1)
+42 KILL ^TMP("PRCACPV",$JOB)
+43 ;
ERR ;Add ineligible reimb ins *315
+1 IF ERR'<0
SET ERR="1^"_ERR
Begin DoDot:1
+2 SET TXT(1)="The following error has occurred while processing a "_$SELECT(CAT=80:"TRICARE PHARMACY ",CAT=31:"TRICARE PATIENT ",CAT=47:"INELIGIBLE REIMB. INS. PATIENT",1:"CHAMPVA")
+3 SET TXT(2)="bill: ("_$SELECT($GET(BNUM):BNUM,1:"BILL IFN - "_+BILL)_")"
+4 SET TXT(3)=" "
+5 SET TXT(4)=$PIECE(ERR,"^",2)
+6 SET TXT(5)=""
+7 SET TXT(6)="You will need to use the BILLING DOCUMENT REGENERATION option to create the FMS document."
+8 SET XMTEXT="TXT("
SET XMY("G.PRCA ERROR")=""
+9 SET XMSUB=$SELECT(CAT=31:"TRICARE PATIENT",CAT=30:"TRICARE",CAT=32:"TRICARE Third Party",CAT=47:"INELIGIBLE REIMB. INS. PATIENT",CAT=80:"TRICARE PHARMACY",1:"CHAMPVA")_" FMS DOC error"
SET XMDUZ="ACCOUNTS RECEIVABLE PACKAGE"
+10 DO ^XMD
End DoDot:1
+11 QUIT
+12 ;
CHKTCARE(BILL) ; check if this is a Tricare Patient charge with orig. balance = 0 and only single "increase adjustment" transaction present PRCA*4.5*392
+1 ;
+2 ; BILL - file 430 ien
+3 ;
+4 ; returns "1 ^ increase adjustment amount" if check resolves to True, 0 otherwise
+5 ;
+6 NEW CAT,N0,TN1,TRAN,TRTYPE
+7 ; invalid file 430 ien
IF BILL'>0
QUIT 0
+8 SET N0=$GET(^PRCA(430,BILL,0))
IF N0=""
QUIT 0
+9 ; orig amount is not 0
IF +$PIECE(N0,U,3)'=0
QUIT 0
+10 ; not a Tricare Patient charge
IF $$GET1^DIQ(430.2,$PIECE(N0,U,2)_",",.01)'="TRICARE PATIENT"
QUIT 0
+11 ; can't find the first transaction
SET TRAN=+$ORDER(^PRCA(433,"C",BILL,""))
IF TRAN'>0
QUIT 0
+12 ; file 433 entry, node 1
SET TN1=$GET(^PRCA(433,TRAN,1))
+13 ; 1st transaction is not "increase adjustment"
IF $$GET1^DIQ(430.3,$PIECE(TN1,U,2)_",",.01)'="INCREASE ADJUSTMENT"
QUIT 0
+14 ; more than one transaction present
IF +$ORDER(^PRCA(433,"C",BILL,TRAN))>0
QUIT 0
+15 QUIT "1^"_+$PIECE(TN1,U,5)
