PRCASVC ;SF-ISC/YJK - ACCEPT, AMMEND AND CANCEL AR BILL ;9/6/95 2:09 PM
V ;;4.5;Accounts Receivable;**1,21,48,90,136,138,249,274,315,338,392,419**;Mar 20, 1995;Build 5
;;Per VA Directive 6402, this routine should not be modified.
REL ;Accept bill into AR
N PRCABN,TRCARE,X,Y ; PRCA*4.5*392
; PRCA*4.5*392
S TRCARE=$S(PRCASV("CAT")=31:1,1:0) ; set to 1 for Tricare Patient charges
I TRCARE S PRCASV("AMT")=$P(PRCASV("FY"),U,2),$P(PRCASV("FY"),U,2)=0 ; clear 'original amount' for Tricare Patient charges
;
D ^PRCASVC6 G:$D(PRCAERR) Q3 S PRCADEBT=$O(^RCD(340,"B",PRCASV("DEBTOR"),0)) I 'PRCADEBT K DD,DO S DIC="^RCD(340,",DIC(0)="QL",X=PRCASV("DEBTOR"),DLAYGO=340 D FILE^DICN K DIC,DLAYGO,DO Q:Y<0 S PRCADEBT=+Y
D FY
I TRCARE S $P(PRCASV("FY"),U,2)=PRCASV("AMT") ; PRCA*4.5*392
S PRCAT=$P(^PRCA(430.2,PRCASV("CAT"),0),"^",6) F Y="IDNO^4","GPNO^6","GPNM^5","INPA^1" S:$D(PRCASV($P(Y,"^"))) $P(^PRCA(430,PRCASV("ARREC"),202),"^",$P(Y,"^",2))=PRCASV($P(Y,"^"))
S DIE="^PRCA(430,",DR="[PRCASV REL]",DA=PRCASV("ARREC") D ^DIE
Q3 K PRCAT,PRCAORA,PRCADEBT,DIE,DR,%
; set the fund for the bill (set in routine rcxfmsuf)
S:'$G(DA) DA=PRCASV("ARREC") S %=$$GETFUNDB^RCXFMSUF(DA)
I "^27^28^"[("^"_PRCASV("CAT")_"^") D
.N P
.;F P=6,8,10,15 S $P(^PRCA(430,DA,11),"^",P)=$S(P=6:1000,P=8:$G(PRCASV("SITE")),P=10:9,1:$P($G(PRCASV("FY")),"^"))
.F P=6,8,10,15 S $P(^PRCA(430,DA,11),"^",P)=$S(P=6:1000,P=8:$G(PRCASV("SITE")),P=10:"02",1:$P($G(PRCASV("FY")),"^")) ; PRCA*4.5*419
.S $P(^PRCA(430,DA,11),"^",18,999)=""
I PRCASV("CAT")=27 S $P(^PRCA(430,+PRCASV("ARREC"),0),"^",5)=$O(^PRCA(430.6,"B","CHMPV",0))
I PRCASV("CAT")=29 S $P(^PRCA(430,DA,11),"^",18,999)=""
;
; prca*4.5*274 - for TRICARE claims, set the station# (field# 257) from the PRCASV("SITE") value
I "^30^31^32^"[("^"_PRCASV("CAT")_"^") D
.N RCCARE,P
.S:'$G(PRCASV("SITE")) PRCASV("SITE")=$P($$SITE^VASITE,"^",3)
.F P=8,9,10,15 S $P(^PRCA(430,DA,11),"^",P)=$S(P=8:$G(PRCASV("SITE")),P=9:1,P=10:"02",1:$P($G(PRCASV("FY")),"^"))
.S $P(^PRCA(430,DA,11),"^",18)=""
.S RCCARE=$$TYP^IBRFN(DA),RCCARE(1)=$S(RCCARE="I":8028,RCCARE="O":8029,1:8030),$P(^PRCA(430,DA,11),"^",6)=RCCARE(1)
;
I PRCASV("CAT")=47 D ;PRCA*4.5*315/BAA
.N RCCARE,P
.S:'$G(PRCASV("SITE")) PRCASV("SITE")=$P($$SITE^VASITE,"^",3)
.F P=8,9,10,15 S $P(^PRCA(430,DA,11),"^",P)=$S(P=8:$G(PRCASV("SITE")),P=9:1,P=10:"02",1:$P($G(PRCASV("FY")),"^"))
.S $P(^PRCA(430,DA,11),"^",18)=""
.S RCCARE=$$TYP^IBRFN(DA),RCCARE(1)=$S(RCCARE="I":"841Z",RCCARE="O":"842Z",1:"842Z"),$P(^PRCA(430,DA,11),"^",6)=RCCARE(1)
;
I PRCASV("CAT")=75 D ;PRCA*4.5*338 Tricare DES
.N RCCARE,P
.S:'$G(PRCASV("SITE")) PRCASV("SITE")=$P($$SITE^VASITE,"^",3)
.F P=8,9,10,15 S $P(^PRCA(430,DA,11),"^",P)=$S(P=8:$G(PRCASV("SITE")),P=9:1,P=10:"02",1:$P($G(PRCASV("FY")),"^"))
.S $P(^PRCA(430,DA,11),"^",18)=""
.S RCCARE=$$TYP^IBRFN(DA),RCCARE(1)="8085",$P(^PRCA(430,DA,11),"^",6)=RCCARE(1)
;
I PRCASV("CAT")=76 D ;PRCA*4.5*338 Tricare Spinal
.N RCCARE,P
.S:'$G(PRCASV("SITE")) PRCASV("SITE")=$P($$SITE^VASITE,"^",3)
.F P=8,9,10,15 S $P(^PRCA(430,DA,11),"^",P)=$S(P=8:$G(PRCASV("SITE")),P=9:1,P=10:"02",1:$P($G(PRCASV("FY")),"^"))
.S $P(^PRCA(430,DA,11),"^",18)=""
.S RCCARE=$$TYP^IBRFN(DA),RCCARE(1)=$S(RCCARE="I":"8086",RCCARE="O":"8087",1:"8088"),$P(^PRCA(430,DA,11),"^",6)=RCCARE(1)
;
I PRCASV("CAT")=77 D ;PRCA*4.5*338 Tricare TBI
.N RCCARE,P
.S:'$G(PRCASV("SITE")) PRCASV("SITE")=$P($$SITE^VASITE,"^",3)
.F P=8,9,10,15 S $P(^PRCA(430,DA,11),"^",P)=$S(P=8:$G(PRCASV("SITE")),P=9:1,P=10:"02",1:$P($G(PRCASV("FY")),"^"))
.S $P(^PRCA(430,DA,11),"^",18)=""
.S RCCARE=$$TYP^IBRFN(DA),RCCARE(1)=$S(RCCARE="I":"8089",RCCARE="O":"8090",1:"8091"),$P(^PRCA(430,DA,11),"^",6)=RCCARE(1)
;
I PRCASV("CAT")=78 D ;PRCA*4.5*338 Tricare Blind Rehab
.N RCCARE,P
.S:'$G(PRCASV("SITE")) PRCASV("SITE")=$P($$SITE^VASITE,"^",3)
.F P=8,9,10,15 S $P(^PRCA(430,DA,11),"^",P)=$S(P=8:$G(PRCASV("SITE")),P=9:1,P=10:"02",1:$P($G(PRCASV("FY")),"^"))
.S $P(^PRCA(430,DA,11),"^",18)=""
.S RCCARE=$$TYP^IBRFN(DA),RCCARE(1)=$S(RCCARE="I":"8092",RCCARE="O":"8093",1:"8094"),$P(^PRCA(430,DA,11),"^",6)=RCCARE(1)
;
;
I PRCASV("CAT")=79 D ;PRCA*4.5*338 Tricare Dental
.N RCCARE,P
.S:'$G(PRCASV("SITE")) PRCASV("SITE")=$P($$SITE^VASITE,"^",3)
.F P=8,9,10,15 S $P(^PRCA(430,DA,11),"^",P)=$S(P=8:$G(PRCASV("SITE")),P=9:1,P=10:"02",1:$P($G(PRCASV("FY")),"^"))
.S $P(^PRCA(430,DA,11),"^",18)=""
.S RCCARE=$$TYP^IBRFN(DA),RCCARE(1)="8096",$P(^PRCA(430,DA,11),"^",6)=RCCARE(1)
;
I PRCASV("CAT")=80 D ;PRCA*4.5*338 Tricare Pharmacy
.N RCCARE,P
.S:'$G(PRCASV("SITE")) PRCASV("SITE")=$P($$SITE^VASITE,"^",3)
.F P=8,9,10,15 S $P(^PRCA(430,DA,11),"^",P)=$S(P=8:$G(PRCASV("SITE")),P=9:1,P=10:"02",1:$P($G(PRCASV("FY")),"^"))
.S $P(^PRCA(430,DA,11),"^",18)=""
.S RCCARE=$$TYP^IBRFN(DA),RCCARE(1)="8095",$P(^PRCA(430,DA,11),"^",6)=RCCARE(1)
I $G(PRCASV("MEDCA"))!$G(PRCASV("MEDURE")) D MEDICARE
I TRCARE S PRCABN=PRCASV("ARREC") D TRAN^PRCASER S PRCASV("IBTRAN")=PRCAEN ; file transaction for Tricare charges PRCA*4.5*392
K DA
Q
;
;
FY K:$D(^PRCA(430,PRCASV("ARREC"),2)) ^(2) S PRCAK1=1,PRCAORA=0,^PRCA(430,PRCASV("ARREC"),2,0)="^430.01IA^^"
F J=1:1 S X=$P(PRCASV("FY"),U,PRCAK1),PRCAMT=+$P(PRCASV("FY"),U,PRCAK1+1) D FY1 S PRCAK1=PRCAK1+2 Q:$P(PRCASV("FY"),U,PRCAK1)=""
EXITFY K PRCAK1,J,PRCAMT Q
FY1 S DA(1)=PRCASV("ARREC"),DIC="^PRCA(430,"_DA(1)_",2,",DIC(0)="QL",DLAYGO=430 D ^DIC K DIC,DLAYGO Q:Y<0 S DA=+Y
S PRCAORA=PRCAORA+PRCAMT,$P(^PRCA(430,PRCASV("ARREC"),0),"^",3)=PRCAORA,$P(^(7),"^")=PRCAORA,$P(^(2,DA,0),U,2)=PRCAMT,$P(^(0),"^",8)=PRCAMT
K DA Q
;
MEDICARE ;Setup Medicare Supplemental amounts
N DR,DIE
I $G(PRCASV("MEDCA")) S DIE="^PRCA(430,",DR="131////"_PRCASV("MEDCA") D ^DIE
I $G(PRCASV("MEDURE")) S DIE="^PRCA(430,",DR="132////"_PRCASV("MEDURE") D ^DIE
K PRCASV("MEDCA"),PRCASV("MEDURE")
Q ;MEDICARE
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCASVC 5959 printed Apr 09, 2024@20:46:38 Page 2
PRCASVC ;SF-ISC/YJK - ACCEPT, AMMEND AND CANCEL AR BILL ;9/6/95 2:09 PM
V ;;4.5;Accounts Receivable;**1,21,48,90,136,138,249,274,315,338,392,419**;Mar 20, 1995;Build 5
+1 ;;Per VA Directive 6402, this routine should not be modified.
REL ;Accept bill into AR
+1 ; PRCA*4.5*392
NEW PRCABN,TRCARE,X,Y
+2 ; PRCA*4.5*392
+3 ; set to 1 for Tricare Patient charges
SET TRCARE=$SELECT(PRCASV("CAT")=31:1,1:0)
+4 ; clear 'original amount' for Tricare Patient charges
IF TRCARE
SET PRCASV("AMT")=$PIECE(PRCASV("FY"),U,2)
SET $PIECE(PRCASV("FY"),U,2)=0
+5 ;
+6 DO ^PRCASVC6
if $DATA(PRCAERR)
GOTO Q3
SET PRCADEBT=$ORDER(^RCD(340,"B",PRCASV("DEBTOR"),0))
IF 'PRCADEBT
KILL DD,DO
SET DIC="^RCD(340,"
SET DIC(0)="QL"
SET X=PRCASV("DEBTOR")
SET DLAYGO=340
DO FILE^DICN
KILL DIC,DLAYGO,DO
if Y<0
QUIT
SET PRCADEBT=+Y
+7 DO FY
+8 ; PRCA*4.5*392
IF TRCARE
SET $PIECE(PRCASV("FY"),U,2)=PRCASV("AMT")
+9 SET PRCAT=$PIECE(^PRCA(430.2,PRCASV("CAT"),0),"^",6)
FOR Y="IDNO^4","GPNO^6","GPNM^5","INPA^1"
if $DATA(PRCASV($PIECE(Y,"^")))
SET $PIECE(^PRCA(430,PRCASV("ARREC"),202),"^",$PIECE(Y,"^",2))=PRCASV($PIECE(Y,"^"))
+10 SET DIE="^PRCA(430,"
SET DR="[PRCASV REL]"
SET DA=PRCASV("ARREC")
DO ^DIE
Q3 KILL PRCAT,PRCAORA,PRCADEBT,DIE,DR,%
+1 ; set the fund for the bill (set in routine rcxfmsuf)
+2 if '$GET(DA)
SET DA=PRCASV("ARREC")
SET %=$$GETFUNDB^RCXFMSUF(DA)
+3 IF "^27^28^"[("^"_PRCASV("CAT")_"^")
Begin DoDot:1
+4 NEW P
+5 ;F P=6,8,10,15 S $P(^PRCA(430,DA,11),"^",P)=$S(P=6:1000,P=8:$G(PRCASV("SITE")),P=10:9,1:$P($G(PRCASV("FY")),"^"))
+6 ; PRCA*4.5*419
FOR P=6,8,10,15
SET $PIECE(^PRCA(430,DA,11),"^",P)=$SELECT(P=6:1000,P=8:$GET(PRCASV("SITE")),P=10:"02",1:$PIECE($GET(PRCASV("FY")),"^"))
+7 SET $PIECE(^PRCA(430,DA,11),"^",18,999)=""
End DoDot:1
+8 IF PRCASV("CAT")=27
SET $PIECE(^PRCA(430,+PRCASV("ARREC"),0),"^",5)=$ORDER(^PRCA(430.6,"B","CHMPV",0))
+9 IF PRCASV("CAT")=29
SET $PIECE(^PRCA(430,DA,11),"^",18,999)=""
+10 ;
+11 ; prca*4.5*274 - for TRICARE claims, set the station# (field# 257) from the PRCASV("SITE") value
+12 IF "^30^31^32^"[("^"_PRCASV("CAT")_"^")
Begin DoDot:1
+13 NEW RCCARE,P
+14 if '$GET(PRCASV("SITE"))
SET PRCASV("SITE")=$PIECE($$SITE^VASITE,"^",3)
+15 FOR P=8,9,10,15
SET $PIECE(^PRCA(430,DA,11),"^",P)=$SELECT(P=8:$GET(PRCASV("SITE")),P=9:1,P=10:"02",1:$PIECE($GET(PRCASV("FY")),"^"))
+16 SET $PIECE(^PRCA(430,DA,11),"^",18)=""
+17 SET RCCARE=$$TYP^IBRFN(DA)
SET RCCARE(1)=$SELECT(RCCARE="I":8028,RCCARE="O":8029,1:8030)
SET $PIECE(^PRCA(430,DA,11),"^",6)=RCCARE(1)
End DoDot:1
+18 ;
+19 ;PRCA*4.5*315/BAA
IF PRCASV("CAT")=47
Begin DoDot:1
+20 NEW RCCARE,P
+21 if '$GET(PRCASV("SITE"))
SET PRCASV("SITE")=$PIECE($$SITE^VASITE,"^",3)
+22 FOR P=8,9,10,15
SET $PIECE(^PRCA(430,DA,11),"^",P)=$SELECT(P=8:$GET(PRCASV("SITE")),P=9:1,P=10:"02",1:$PIECE($GET(PRCASV("FY")),"^"))
+23 SET $PIECE(^PRCA(430,DA,11),"^",18)=""
+24 SET RCCARE=$$TYP^IBRFN(DA)
SET RCCARE(1)=$SELECT(RCCARE="I":"841Z",RCCARE="O":"842Z",1:"842Z")
SET $PIECE(^PRCA(430,DA,11),"^",6)=RCCARE(1)
End DoDot:1
+25 ;
+26 ;PRCA*4.5*338 Tricare DES
IF PRCASV("CAT")=75
Begin DoDot:1
+27 NEW RCCARE,P
+28 if '$GET(PRCASV("SITE"))
SET PRCASV("SITE")=$PIECE($$SITE^VASITE,"^",3)
+29 FOR P=8,9,10,15
SET $PIECE(^PRCA(430,DA,11),"^",P)=$SELECT(P=8:$GET(PRCASV("SITE")),P=9:1,P=10:"02",1:$PIECE($GET(PRCASV("FY")),"^"))
+30 SET $PIECE(^PRCA(430,DA,11),"^",18)=""
+31 SET RCCARE=$$TYP^IBRFN(DA)
SET RCCARE(1)="8085"
SET $PIECE(^PRCA(430,DA,11),"^",6)=RCCARE(1)
End DoDot:1
+32 ;
+33 ;PRCA*4.5*338 Tricare Spinal
IF PRCASV("CAT")=76
Begin DoDot:1
+34 NEW RCCARE,P
+35 if '$GET(PRCASV("SITE"))
SET PRCASV("SITE")=$PIECE($$SITE^VASITE,"^",3)
+36 FOR P=8,9,10,15
SET $PIECE(^PRCA(430,DA,11),"^",P)=$SELECT(P=8:$GET(PRCASV("SITE")),P=9:1,P=10:"02",1:$PIECE($GET(PRCASV("FY")),"^"))
+37 SET $PIECE(^PRCA(430,DA,11),"^",18)=""
+38 SET RCCARE=$$TYP^IBRFN(DA)
SET RCCARE(1)=$SELECT(RCCARE="I":"8086",RCCARE="O":"8087",1:"8088")
SET $PIECE(^PRCA(430,DA,11),"^",6)=RCCARE(1)
End DoDot:1
+39 ;
+40 ;PRCA*4.5*338 Tricare TBI
IF PRCASV("CAT")=77
Begin DoDot:1
+41 NEW RCCARE,P
+42 if '$GET(PRCASV("SITE"))
SET PRCASV("SITE")=$PIECE($$SITE^VASITE,"^",3)
+43 FOR P=8,9,10,15
SET $PIECE(^PRCA(430,DA,11),"^",P)=$SELECT(P=8:$GET(PRCASV("SITE")),P=9:1,P=10:"02",1:$PIECE($GET(PRCASV("FY")),"^"))
+44 SET $PIECE(^PRCA(430,DA,11),"^",18)=""
+45 SET RCCARE=$$TYP^IBRFN(DA)
SET RCCARE(1)=$SELECT(RCCARE="I":"8089",RCCARE="O":"8090",1:"8091")
SET $PIECE(^PRCA(430,DA,11),"^",6)=RCCARE(1)
End DoDot:1
+46 ;
+47 ;PRCA*4.5*338 Tricare Blind Rehab
IF PRCASV("CAT")=78
Begin DoDot:1
+48 NEW RCCARE,P
+49 if '$GET(PRCASV("SITE"))
SET PRCASV("SITE")=$PIECE($$SITE^VASITE,"^",3)
+50 FOR P=8,9,10,15
SET $PIECE(^PRCA(430,DA,11),"^",P)=$SELECT(P=8:$GET(PRCASV("SITE")),P=9:1,P=10:"02",1:$PIECE($GET(PRCASV("FY")),"^"))
+51 SET $PIECE(^PRCA(430,DA,11),"^",18)=""
+52 SET RCCARE=$$TYP^IBRFN(DA)
SET RCCARE(1)=$SELECT(RCCARE="I":"8092",RCCARE="O":"8093",1:"8094")
SET $PIECE(^PRCA(430,DA,11),"^",6)=RCCARE(1)
End DoDot:1
+53 ;
+54 ;
+55 ;PRCA*4.5*338 Tricare Dental
IF PRCASV("CAT")=79
Begin DoDot:1
+56 NEW RCCARE,P
+57 if '$GET(PRCASV("SITE"))
SET PRCASV("SITE")=$PIECE($$SITE^VASITE,"^",3)
+58 FOR P=8,9,10,15
SET $PIECE(^PRCA(430,DA,11),"^",P)=$SELECT(P=8:$GET(PRCASV("SITE")),P=9:1,P=10:"02",1:$PIECE($GET(PRCASV("FY")),"^"))
+59 SET $PIECE(^PRCA(430,DA,11),"^",18)=""
+60 SET RCCARE=$$TYP^IBRFN(DA)
SET RCCARE(1)="8096"
SET $PIECE(^PRCA(430,DA,11),"^",6)=RCCARE(1)
End DoDot:1
+61 ;
+62 ;PRCA*4.5*338 Tricare Pharmacy
IF PRCASV("CAT")=80
Begin DoDot:1
+63 NEW RCCARE,P
+64 if '$GET(PRCASV("SITE"))
SET PRCASV("SITE")=$PIECE($$SITE^VASITE,"^",3)
+65 FOR P=8,9,10,15
SET $PIECE(^PRCA(430,DA,11),"^",P)=$SELECT(P=8:$GET(PRCASV("SITE")),P=9:1,P=10:"02",1:$PIECE($GET(PRCASV("FY")),"^"))
+66 SET $PIECE(^PRCA(430,DA,11),"^",18)=""
+67 SET RCCARE=$$TYP^IBRFN(DA)
SET RCCARE(1)="8095"
SET $PIECE(^PRCA(430,DA,11),"^",6)=RCCARE(1)
End DoDot:1
+68 IF $GET(PRCASV("MEDCA"))!$GET(PRCASV("MEDURE"))
DO MEDICARE
+69 ; file transaction for Tricare charges PRCA*4.5*392
IF TRCARE
SET PRCABN=PRCASV("ARREC")
DO TRAN^PRCASER
SET PRCASV("IBTRAN")=PRCAEN
+70 KILL DA
+71 QUIT
+72 ;
+73 ;
FY if $DATA(^PRCA(430,PRCASV("ARREC"),2))
KILL ^(2)
SET PRCAK1=1
SET PRCAORA=0
SET ^PRCA(430,PRCASV("ARREC"),2,0)="^430.01IA^^"
+1 FOR J=1:1
SET X=$PIECE(PRCASV("FY"),U,PRCAK1)
SET PRCAMT=+$PIECE(PRCASV("FY"),U,PRCAK1+1)
DO FY1
SET PRCAK1=PRCAK1+2
if $PIECE(PRCASV("FY"),U,PRCAK1)=""
QUIT
EXITFY KILL PRCAK1,J,PRCAMT
QUIT
FY1 SET DA(1)=PRCASV("ARREC")
SET DIC="^PRCA(430,"_DA(1)_",2,"
SET DIC(0)="QL"
SET DLAYGO=430
DO ^DIC
KILL DIC,DLAYGO
if Y<0
QUIT
SET DA=+Y
+1 SET PRCAORA=PRCAORA+PRCAMT
SET $PIECE(^PRCA(430,PRCASV("ARREC"),0),"^",3)=PRCAORA
SET $PIECE(^(7),"^")=PRCAORA
SET $PIECE(^(2,DA,0),U,2)=PRCAMT
SET $PIECE(^(0),"^",8)=PRCAMT
+2 KILL DA
QUIT
+3 ;
MEDICARE ;Setup Medicare Supplemental amounts
+1 NEW DR,DIE
+2 IF $GET(PRCASV("MEDCA"))
SET DIE="^PRCA(430,"
SET DR="131////"_PRCASV("MEDCA")
DO ^DIE
+3 IF $GET(PRCASV("MEDURE"))
SET DIE="^PRCA(430,"
SET DR="132////"_PRCASV("MEDURE")
DO ^DIE
+4 KILL PRCASV("MEDCA"),PRCASV("MEDURE")
+5 ;MEDICARE
QUIT
+6 ;
