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

PRCASVC.m

Go to the documentation of this file.
  1. PRCASVC ;SF-ISC/YJK - ACCEPT, AMMEND AND CANCEL AR BILL ;9/6/95 2:09 PM
  1. 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.
  1. REL ;Accept bill into AR
  1. N PRCABN,TRCARE,X,Y ; PRCA*4.5*392
  1. ; PRCA*4.5*392
  1. S TRCARE=$S(PRCASV("CAT")=31:1,1:0) ; set to 1 for Tricare Patient charges
  1. I TRCARE S PRCASV("AMT")=$P(PRCASV("FY"),U,2),$P(PRCASV("FY"),U,2)=0 ; clear 'original amount' for Tricare Patient charges
  1. ;
  1. 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
  1. D FY
  1. I TRCARE S $P(PRCASV("FY"),U,2)=PRCASV("AMT") ; PRCA*4.5*392
  1. 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,"^"))
  1. S DIE="^PRCA(430,",DR="[PRCASV REL]",DA=PRCASV("ARREC") D ^DIE
  1. Q3 K PRCAT,PRCAORA,PRCADEBT,DIE,DR,%
  1. ; set the fund for the bill (set in routine rcxfmsuf)
  1. S:'$G(DA) DA=PRCASV("ARREC") S %=$$GETFUNDB^RCXFMSUF(DA)
  1. I "^27^28^"[("^"_PRCASV("CAT")_"^") D
  1. .N P
  1. .;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")),"^"))
  1. .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
  1. .S $P(^PRCA(430,DA,11),"^",18,999)=""
  1. I PRCASV("CAT")=27 S $P(^PRCA(430,+PRCASV("ARREC"),0),"^",5)=$O(^PRCA(430.6,"B","CHMPV",0))
  1. I PRCASV("CAT")=29 S $P(^PRCA(430,DA,11),"^",18,999)=""
  1. ;
  1. ; prca*4.5*274 - for TRICARE claims, set the station# (field# 257) from the PRCASV("SITE") value
  1. I "^30^31^32^"[("^"_PRCASV("CAT")_"^") D
  1. .N RCCARE,P
  1. .S:'$G(PRCASV("SITE")) PRCASV("SITE")=$P($$SITE^VASITE,"^",3)
  1. .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")),"^"))
  1. .S $P(^PRCA(430,DA,11),"^",18)=""
  1. .S RCCARE=$$TYP^IBRFN(DA),RCCARE(1)=$S(RCCARE="I":8028,RCCARE="O":8029,1:8030),$P(^PRCA(430,DA,11),"^",6)=RCCARE(1)
  1. ;
  1. I PRCASV("CAT")=47 D ;PRCA*4.5*315/BAA
  1. .N RCCARE,P
  1. .S:'$G(PRCASV("SITE")) PRCASV("SITE")=$P($$SITE^VASITE,"^",3)
  1. .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")),"^"))
  1. .S $P(^PRCA(430,DA,11),"^",18)=""
  1. .S RCCARE=$$TYP^IBRFN(DA),RCCARE(1)=$S(RCCARE="I":"841Z",RCCARE="O":"842Z",1:"842Z"),$P(^PRCA(430,DA,11),"^",6)=RCCARE(1)
  1. ;
  1. I PRCASV("CAT")=75 D ;PRCA*4.5*338 Tricare DES
  1. .N RCCARE,P
  1. .S:'$G(PRCASV("SITE")) PRCASV("SITE")=$P($$SITE^VASITE,"^",3)
  1. .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")),"^"))
  1. .S $P(^PRCA(430,DA,11),"^",18)=""
  1. .S RCCARE=$$TYP^IBRFN(DA),RCCARE(1)="8085",$P(^PRCA(430,DA,11),"^",6)=RCCARE(1)
  1. ;
  1. I PRCASV("CAT")=76 D ;PRCA*4.5*338 Tricare Spinal
  1. .N RCCARE,P
  1. .S:'$G(PRCASV("SITE")) PRCASV("SITE")=$P($$SITE^VASITE,"^",3)
  1. .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")),"^"))
  1. .S $P(^PRCA(430,DA,11),"^",18)=""
  1. .S RCCARE=$$TYP^IBRFN(DA),RCCARE(1)=$S(RCCARE="I":"8086",RCCARE="O":"8087",1:"8088"),$P(^PRCA(430,DA,11),"^",6)=RCCARE(1)
  1. ;
  1. I PRCASV("CAT")=77 D ;PRCA*4.5*338 Tricare TBI
  1. .N RCCARE,P
  1. .S:'$G(PRCASV("SITE")) PRCASV("SITE")=$P($$SITE^VASITE,"^",3)
  1. .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")),"^"))
  1. .S $P(^PRCA(430,DA,11),"^",18)=""
  1. .S RCCARE=$$TYP^IBRFN(DA),RCCARE(1)=$S(RCCARE="I":"8089",RCCARE="O":"8090",1:"8091"),$P(^PRCA(430,DA,11),"^",6)=RCCARE(1)
  1. ;
  1. I PRCASV("CAT")=78 D ;PRCA*4.5*338 Tricare Blind Rehab
  1. .N RCCARE,P
  1. .S:'$G(PRCASV("SITE")) PRCASV("SITE")=$P($$SITE^VASITE,"^",3)
  1. .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")),"^"))
  1. .S $P(^PRCA(430,DA,11),"^",18)=""
  1. .S RCCARE=$$TYP^IBRFN(DA),RCCARE(1)=$S(RCCARE="I":"8092",RCCARE="O":"8093",1:"8094"),$P(^PRCA(430,DA,11),"^",6)=RCCARE(1)
  1. ;
  1. ;
  1. I PRCASV("CAT")=79 D ;PRCA*4.5*338 Tricare Dental
  1. .N RCCARE,P
  1. .S:'$G(PRCASV("SITE")) PRCASV("SITE")=$P($$SITE^VASITE,"^",3)
  1. .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")),"^"))
  1. .S $P(^PRCA(430,DA,11),"^",18)=""
  1. .S RCCARE=$$TYP^IBRFN(DA),RCCARE(1)="8096",$P(^PRCA(430,DA,11),"^",6)=RCCARE(1)
  1. ;
  1. I PRCASV("CAT")=80 D ;PRCA*4.5*338 Tricare Pharmacy
  1. .N RCCARE,P
  1. .S:'$G(PRCASV("SITE")) PRCASV("SITE")=$P($$SITE^VASITE,"^",3)
  1. .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")),"^"))
  1. .S $P(^PRCA(430,DA,11),"^",18)=""
  1. .S RCCARE=$$TYP^IBRFN(DA),RCCARE(1)="8095",$P(^PRCA(430,DA,11),"^",6)=RCCARE(1)
  1. I $G(PRCASV("MEDCA"))!$G(PRCASV("MEDURE")) D MEDICARE
  1. I TRCARE S PRCABN=PRCASV("ARREC") D TRAN^PRCASER S PRCASV("IBTRAN")=PRCAEN ; file transaction for Tricare charges PRCA*4.5*392
  1. K DA
  1. Q
  1. ;
  1. ;
  1. FY K:$D(^PRCA(430,PRCASV("ARREC"),2)) ^(2) S PRCAK1=1,PRCAORA=0,^PRCA(430,PRCASV("ARREC"),2,0)="^430.01IA^^"
  1. 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)=""
  1. EXITFY K PRCAK1,J,PRCAMT Q
  1. 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
  1. 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
  1. K DA Q
  1. ;
  1. MEDICARE ;Setup Medicare Supplemental amounts
  1. N DR,DIE
  1. I $G(PRCASV("MEDCA")) S DIE="^PRCA(430,",DR="131////"_PRCASV("MEDCA") D ^DIE
  1. I $G(PRCASV("MEDURE")) S DIE="^PRCA(430,",DR="132////"_PRCASV("MEDURE") D ^DIE
  1. K PRCASV("MEDCA"),PRCASV("MEDURE")
  1. Q ;MEDICARE
  1. ;