- 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 Feb 18, 2025@23:07:45 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 ;
