Summary Table

Categories Total Count
PII 0
URL 0
DNS 0
EKL 0
IP 0
PORT 0
VsID 0
CF 0
AI 0
VPD 0
PL 0
Other 0

File Content

KIDS Distribution saved on May 24, 2018@10:01:51
TEST
**KIDS**:PRCA*4.5*338^

**INSTALL NAME**
PRCA*4.5*338
"BLD",10660,0)
PRCA*4.5*338^ACCOUNTS RECEIVABLE^0^3180524^y
"BLD",10660,4,0)
^9.64PA^430.2^1
"BLD",10660,4,430.2,0)
430.2
"BLD",10660,4,430.2,2,0)
^9.641^430.2^1
"BLD",10660,4,430.2,2,430.2,0)
ACCOUNTS RECEIVABLE CATEGORY (File-top level)
"BLD",10660,4,430.2,2,430.2,1,0)
^9.6411^1.03^3
"BLD",10660,4,430.2,2,430.2,1,1.01,0)
REFER TO DMC?
"BLD",10660,4,430.2,2,430.2,1,1.02,0)
REFER TO TOP?
"BLD",10660,4,430.2,2,430.2,1,1.03,0)
REFER TO CS?
"BLD",10660,4,430.2,222)
y^n^p^^^^n^^n
"BLD",10660,4,430.2,224)

"BLD",10660,4,"APDD",430.2,430.2)

"BLD",10660,4,"APDD",430.2,430.2,1.01)

"BLD",10660,4,"APDD",430.2,430.2,1.02)

"BLD",10660,4,"APDD",430.2,430.2,1.03)

"BLD",10660,4,"B",430.2,430.2)

"BLD",10660,6)
1^
"BLD",10660,6.3)
11
"BLD",10660,"ABPKG")
n
"BLD",10660,"INIT")
POSTINIT^PRCAP338
"BLD",10660,"KRN",0)
^9.67PA^779.2^20
"BLD",10660,"KRN",.4,0)
.4
"BLD",10660,"KRN",.4,"NM",0)
^9.68A^^
"BLD",10660,"KRN",.401,0)
.401
"BLD",10660,"KRN",.402,0)
.402
"BLD",10660,"KRN",.403,0)
.403
"BLD",10660,"KRN",.5,0)
.5
"BLD",10660,"KRN",.84,0)
.84
"BLD",10660,"KRN",3.6,0)
3.6
"BLD",10660,"KRN",3.8,0)
3.8
"BLD",10660,"KRN",9.2,0)
9.2
"BLD",10660,"KRN",9.8,0)
9.8
"BLD",10660,"KRN",9.8,"NM",0)
^9.68A^4^4
"BLD",10660,"KRN",9.8,"NM",1,0)
RCXFMSUR^^0^B108627445
"BLD",10660,"KRN",9.8,"NM",2,0)
RCXFMSUF^^0^B42318181
"BLD",10660,"KRN",9.8,"NM",3,0)
RCBEADJ^^0^B80995918
"BLD",10660,"KRN",9.8,"NM",4,0)
PRCAACC^^0^B8752523
"BLD",10660,"KRN",9.8,"NM","B","PRCAACC",4)

"BLD",10660,"KRN",9.8,"NM","B","RCBEADJ",3)

"BLD",10660,"KRN",9.8,"NM","B","RCXFMSUF",2)

"BLD",10660,"KRN",9.8,"NM","B","RCXFMSUR",1)

"BLD",10660,"KRN",19,0)
19
"BLD",10660,"KRN",19.1,0)
19.1
"BLD",10660,"KRN",101,0)
101
"BLD",10660,"KRN",409.61,0)
409.61
"BLD",10660,"KRN",771,0)
771
"BLD",10660,"KRN",779.2,0)
779.2
"BLD",10660,"KRN",870,0)
870
"BLD",10660,"KRN",8989.51,0)
8989.51
"BLD",10660,"KRN",8989.52,0)
8989.52
"BLD",10660,"KRN",8994,0)
8994
"BLD",10660,"KRN","B",.4,.4)

"BLD",10660,"KRN","B",.401,.401)

"BLD",10660,"KRN","B",.402,.402)

"BLD",10660,"KRN","B",.403,.403)

"BLD",10660,"KRN","B",.5,.5)

"BLD",10660,"KRN","B",.84,.84)

"BLD",10660,"KRN","B",3.6,3.6)

"BLD",10660,"KRN","B",3.8,3.8)

"BLD",10660,"KRN","B",9.2,9.2)

"BLD",10660,"KRN","B",9.8,9.8)

"BLD",10660,"KRN","B",19,19)

"BLD",10660,"KRN","B",19.1,19.1)

"BLD",10660,"KRN","B",101,101)

"BLD",10660,"KRN","B",409.61,409.61)

"BLD",10660,"KRN","B",771,771)

"BLD",10660,"KRN","B",779.2,779.2)

"BLD",10660,"KRN","B",870,870)

"BLD",10660,"KRN","B",8989.51,8989.51)

"BLD",10660,"KRN","B",8989.52,8989.52)

"BLD",10660,"KRN","B",8994,8994)

"BLD",10660,"QDEF")
^^^^NO^^^^NO^^YES
"BLD",10660,"QUES",0)
^9.62^^
"BLD",10660,"REQB",0)
^9.611^1^1
"BLD",10660,"REQB",1,0)
PRCA*4.5*310^1
"BLD",10660,"REQB","B","PRCA*4.5*310",1)

"FIA",430.2)
ACCOUNTS RECEIVABLE CATEGORY
"FIA",430.2,0)
^PRCA(430.2,
"FIA",430.2,0,0)
430.2I
"FIA",430.2,0,1)
y^n^p^^^^n^^n
"FIA",430.2,0,10)

"FIA",430.2,0,11)

"FIA",430.2,0,"RLRO")

"FIA",430.2,0,"VR")
4.5^PRCA
"FIA",430.2,430.2)
1
"FIA",430.2,430.2,1.01)

"FIA",430.2,430.2,1.02)

"FIA",430.2,430.2,1.03)

"INIT")
POSTINIT^PRCAP338
"MBREQ")
0
"PKG",53,-1)
1^1
"PKG",53,0)
ACCOUNTS RECEIVABLE^PRCA^FMS
"PKG",53,20,0)
^9.402P^1^1
"PKG",53,20,1,0)
2^^PRCAMRG
"PKG",53,20,1,1)

"PKG",53,20,"B",2,1)

"PKG",53,22,0)
^9.49I^1^1
"PKG",53,22,1,0)
4.5^3051119^2960627
"PKG",53,22,1,"PAH",1,0)
338^3180524^62
"QUES","XPF1",0)
Y
"QUES","XPF1","??")
^D REP^XPDH
"QUES","XPF1","A")
Shall I write over your |FLAG| File
"QUES","XPF1","B")
YES
"QUES","XPF1","M")
D XPF1^XPDIQ
"QUES","XPF2",0)
Y
"QUES","XPF2","??")
^D DTA^XPDH
"QUES","XPF2","A")
Want my data |FLAG| yours
"QUES","XPF2","B")
YES
"QUES","XPF2","M")
D XPF2^XPDIQ
"QUES","XPI1",0)
YO
"QUES","XPI1","??")
^D INHIBIT^XPDH
"QUES","XPI1","A")
Want KIDS to INHIBIT LOGONs during the install
"QUES","XPI1","B")
NO
"QUES","XPI1","M")
D XPI1^XPDIQ
"QUES","XPM1",0)
PO^VA(200,:EM
"QUES","XPM1","??")
^D MG^XPDH
"QUES","XPM1","A")
Enter the Coordinator for Mail Group '|FLAG|'
"QUES","XPM1","B")

"QUES","XPM1","M")
D XPM1^XPDIQ
"QUES","XPO1",0)
Y
"QUES","XPO1","??")
^D MENU^XPDH
"QUES","XPO1","A")
Want KIDS to Rebuild Menu Trees Upon Completion of Install
"QUES","XPO1","B")
NO
"QUES","XPO1","M")
D XPO1^XPDIQ
"QUES","XPZ1",0)
Y
"QUES","XPZ1","??")
^D OPT^XPDH
"QUES","XPZ1","A")
Want to DISABLE Scheduled Options, Menu Options, and Protocols
"QUES","XPZ1","B")
YES
"QUES","XPZ1","M")
D XPZ1^XPDIQ
"QUES","XPZ2",0)
Y
"QUES","XPZ2","??")
^D RTN^XPDH
"QUES","XPZ2","A")
Want to MOVE routines to other CPUs
"QUES","XPZ2","B")
NO
"QUES","XPZ2","M")
D XPZ2^XPDIQ
"RTN")
5
"RTN","PRCAACC")
0^4^B8752523
"RTN","PRCAACC",1,0)
PRCAACC ;WASH-ISC@ALTOONA,PA/CMS-AR ACCRUAL TOTALS ;10/19/10 1:36pm
"RTN","PRCAACC",2,0)
;;4.5;Accounts Receivable;**60,74,90,101,157,203,220,273,310,338**;Mar 20, 1995;Build 11
"RTN","PRCAACC",3,0)
;Per VA Directive 6402, this routine should not be modified.
"RTN","PRCAACC",4,0)
NEW PRCAQUE,PRCADEV,PRCA,ZTSK
"RTN","PRCAACC",5,0)
S PRCA("MESS")="Do you wish to queue this report" D QUE^PRCAQUE G:'$D(PRCAQUE) Q
"RTN","PRCAACC",6,0)
I $D(IO("Q")) S ZTRTN="DQ^PRCAACC",ZTDESC="AR Accrual Totals" D ^%ZTLOAD G Q
"RTN","PRCAACC",7,0)
DQ ;
"RTN","PRCAACC",8,0)
U IO
"RTN","PRCAACC",9,0)
NEW BILLN,COM,TOT,STAT,X,Y
"RTN","PRCAACC",10,0)
S BILLN=0
"RTN","PRCAACC",11,0)
D COM G:$O(COM(""))="" RPT
"RTN","PRCAACC",12,0)
F STAT=42,16 F S BILLN=$O(^PRCA(430,"AC",STAT,BILLN)) Q:'BILLN I $$ACCK(BILLN) D
"RTN","PRCAACC",13,0)
.S X=(","_$P(^PRCA(430,BILLN,0),"^",2)_",")
"RTN","PRCAACC",14,0)
.S TOT(X)=$G(TOT(X))+$G(^PRCA(430,BILLN,7))
"RTN","PRCAACC",15,0)
.QUIT
"RTN","PRCAACC",16,0)
RPT D NOW^%DTC W @IOF,!!,?23,"Accrual Totals Report",!?20,"As of: " S Y=% X ^DD("DD") W Y,!
"RTN","PRCAACC",17,0)
S X="",$P(X,"=",80)="" W X
"RTN","PRCAACC",18,0)
W:$O(COM(""))="" !!,"WARNING: Accruals are *NOT* set-up correctly.",!,"No RX accrual common numbering series are set-up in AR Bill Number File!",!!
"RTN","PRCAACC",19,0)
S TOT=$G(TOT(",22,"))+$G(TOT(",23,")) I TOT W !!!,"RX CO-PAYMENT Accrual Amount: $",$FN(TOT,",",2)
"RTN","PRCAACC",20,0)
I $G(TOT(",18,"))>0 W !!!,"C (MEANS TEST) Accrual Amount: $",$FN(TOT(",18,"),",",2)
"RTN","PRCAACC",21,0)
W !!!!,"Includes Common Numbering Series:",! S COM="" F S COM=$O(COM(COM)) Q:COM="" W !,COM,?20,COM(COM)
"RTN","PRCAACC",22,0)
Q D ^%ZISC S IOP=IO(0) D ^%ZIS K IOP,IO("Q") Q
"RTN","PRCAACC",23,0)
ACCK(BN) ;Check BILLN to see if Accrual
"RTN","PRCAACC",24,0)
N ACC,ACTDATE,CAT,FUND,DB
"RTN","PRCAACC",25,0)
S CAT=+$P(^PRCA(430,BN,0),"^",2)
"RTN","PRCAACC",26,0)
; field 12, ACCRUED ? where 0=no 1=yes, 2=could be either
"RTN","PRCAACC",27,0)
S ACC=+$P($G(^PRCA(430.2,CAT,0)),"^",9)
"RTN","PRCAACC",28,0)
; it could be either accrued or non-accrued
"RTN","PRCAACC",29,0)
I ACC=2 D
"RTN","PRCAACC",30,0)
. S FUND=$P($G(^PRCA(430,BN,11)),"^",17)
"RTN","PRCAACC",31,0)
. S ACC=$S(FUND=5014:1,FUND=2431:1,1:0)
"RTN","PRCAACC",32,0)
. I $E(FUND,1,4)=5287 S ACC=$$PTACCT(FUND)
"RTN","PRCAACC",33,0)
. ; special case with Workman's Comp
"RTN","PRCAACC",34,0)
. I ACC=0,CAT=6,FUND="" D
"RTN","PRCAACC",35,0)
. . S DB=$P($G(^RCD(340,+$P($G(^PRCA(430,BN,0)),U,9),0)),U)
"RTN","PRCAACC",36,0)
. . I DB[";DPT"!($P($G(^PRCA(430,BN,0)),U,7)'="") S ACC=1
"RTN","PRCAACC",37,0)
;
"RTN","PRCAACC",38,0)
; public law states that bills in the category ineligible (1),
"RTN","PRCAACC",39,0)
; emerg/human (2), torts (10), or medicare (21) which are older
"RTN","PRCAACC",40,0)
; than oct 1, 1992 should be treated as non-accrued.
"RTN","PRCAACC",41,0)
I CAT=1!(CAT=2)!(CAT=10)!(CAT=21) D
"RTN","PRCAACC",42,0)
. S ACTDATE=$P($G(^PRCA(430,BN,6)),"^",21) I 'ACTDATE S ACTDATE=DT
"RTN","PRCAACC",43,0)
. I ACTDATE<2921001 S ACC=0
"RTN","PRCAACC",44,0)
. ;
"RTN","PRCAACC",45,0)
. ; patch157 changes ineligibles. an ineligible created before
"RTN","PRCAACC",46,0)
. ; oct 1, 1992 or after sep 30, 2000 will be non-accrued.
"RTN","PRCAACC",47,0)
. ; otherwise it will be accrued.
"RTN","PRCAACC",48,0)
. I CAT=1,ACTDATE>3000930 S ACC=0
"RTN","PRCAACC",49,0)
;
"RTN","PRCAACC",50,0)
Q ACC
"RTN","PRCAACC",51,0)
COM ;Find Accrual common numbering series
"RTN","PRCAACC",52,0)
S COM=0
"RTN","PRCAACC",53,0)
F S COM=$O(^PRCA(430.4,COM)) Q:'COM I $P(^PRCA(430.4,COM,0),"^",6) S COM($P(^PRCA(430.4,COM,0),"^"))=$P($G(^DIC(49,$P(^(0),"^",5),0)),"^",1)
"RTN","PRCAACC",54,0)
Q
"RTN","PRCAACC",55,0)
PTACCT(FUND) ;Determines whether Point Accounts are accrued
"RTN","PRCAACC",56,0)
;returns 1 for accrued funds 528701,528702,528703,528704,528709,528711
"RTN","PRCAACC",57,0)
;returns 0 for any other fund
"RTN","PRCAACC",58,0)
;PRCA*4.5*310/DRF Added 528713 to accrued funds
"RTN","PRCAACC",59,0)
;PRCA*4.5*338/OB Added 528714 to accrued funds
"RTN","PRCAACC",60,0)
I FUND'[5287 Q 0
"RTN","PRCAACC",61,0)
S X=$E(FUND,5,6),X=$S(X="09"!(X="11")!(X="13")!(X="14"):1,X<"05":1,1:0)
"RTN","PRCAACC",62,0)
Q X
"RTN","PRCAACC",63,0)
ADDPTEDT() ;Effective date of additional point accounts
"RTN","PRCAACC",64,0)
; (528705 - 528708 and 528710)
"RTN","PRCAACC",65,0)
;Effective date of switch from 4032 to 528709
"RTN","PRCAACC",66,0)
Q 3040928
"RTN","PRCAP338")
0^^B62507943
"RTN","PRCAP338",1,0)
PRCAP338 ;SAB/Albany - PRCA*4.5*338 POST INSTALL;12/11/17 2:10pm
"RTN","PRCAP338",2,0)
;;4.5;Accounts Receivable;**338**;Mar 20, 1995;Build 11
"RTN","PRCAP338",3,0)
;Per VA Directive 6402, this routine should not be modified.
"RTN","PRCAP338",4,0)
Q
"RTN","PRCAP338",5,0)
;
"RTN","PRCAP338",6,0)
POSTINIT ;Post Install for PRCA*4.5*338
"RTN","PRCAP338",7,0)
D BMES^XPDUTL(" >> Starting the Post-Initialization routine for PRCA*4.5*338 ")
"RTN","PRCAP338",8,0)
; Adding AR CATEGORIES and REVENUE SOURCE CODES
"RTN","PRCAP338",9,0)
D ARCAT
"RTN","PRCAP338",10,0)
D ARCATUPD
"RTN","PRCAP338",11,0)
;D REVSC
"RTN","PRCAP338",12,0)
D BMES^XPDUTL(" >> End of the Post-Initialization routine for PRCA*4.5*338")
"RTN","PRCAP338",13,0)
Q
"RTN","PRCAP338",14,0)
;
"RTN","PRCAP338",15,0)
ARCAT ;AR CATEGORY ENTRIES (430.2)
"RTN","PRCAP338",16,0)
N LOOP,FDA,FDAIEN,DATA,CHK
"RTN","PRCAP338",17,0)
;
"RTN","PRCAP338",18,0)
D MES^XPDUTL(" -> Adding new AR CATEGORY entries to file 430.2 ...")
"RTN","PRCAP338",19,0)
; Add new AR categories
"RTN","PRCAP338",20,0)
F LOOP=2:1:9 D
"RTN","PRCAP338",21,0)
. ;Clear the array
"RTN","PRCAP338",22,0)
. K FDA
"RTN","PRCAP338",23,0)
. ;Extract the new AR Category to be added.
"RTN","PRCAP338",24,0)
. S DATA=$T(ARDATA+LOOP)
"RTN","PRCAP338",25,0)
. ;Check to insure that the AR Category doesn't exist already
"RTN","PRCAP338",26,0)
. S CHK="" ; Initialized the check variable
"RTN","PRCAP338",27,0)
. S CHK=$O(^PRCA(430.2,"B",$P(DATA,";",3),""))
"RTN","PRCAP338",28,0)
. Q:CHK'=""
"RTN","PRCAP338",29,0)
. ;Store in array for adding to the file (#430.2).
"RTN","PRCAP338",30,0)
. S FDA(430.2,"+1,",.01)=$P(DATA,";",3)
"RTN","PRCAP338",31,0)
. S FDA(430.2,"+1,",1)=$P(DATA,";",4)
"RTN","PRCAP338",32,0)
. S FDA(430.2,"+1,",2)=$P(DATA,";",5)
"RTN","PRCAP338",33,0)
. S FDA(430.2,"+1,",3)=$P(DATA,";",6)
"RTN","PRCAP338",34,0)
. S FDA(430.2,"+1,",5)=$P(DATA,";",7)
"RTN","PRCAP338",35,0)
. S FDA(430.2,"+1,",6)=$P(DATA,";",8)
"RTN","PRCAP338",36,0)
. S FDA(430.2,"+1,",7)=$P(DATA,";",9)
"RTN","PRCAP338",37,0)
. S FDA(430.2,"+1,",9)=$P(DATA,";",10)
"RTN","PRCAP338",38,0)
. S FDA(430.2,"+1,",10)=$P(DATA,";",11)
"RTN","PRCAP338",39,0)
. S FDA(430.2,"+1,",11)=$P(DATA,";",12)
"RTN","PRCAP338",40,0)
. S FDA(430.2,"+1,",12)=$P(DATA,";",13)
"RTN","PRCAP338",41,0)
. S FDA(430.2,"+1,",13)=$P(DATA,";",14)
"RTN","PRCAP338",42,0)
. S FDA(430.2,"+1,",14)=$P(DATA,";",15)
"RTN","PRCAP338",43,0)
. ;Add to the file.
"RTN","PRCAP338",44,0)
. D UPDATE^DIE(,"FDA","FDAIEN")
"RTN","PRCAP338",45,0)
. S FDAIEN=FDAIEN(1) K FDAIEN(1)
"RTN","PRCAP338",46,0)
D MES^XPDUTL(" New AR CATEGORIES added.")
"RTN","PRCAP338",47,0)
Q
"RTN","PRCAP338",48,0)
;
"RTN","PRCAP338",49,0)
ARDATA ; New AR Category data. (Internal data format)
"RTN","PRCAP338",50,0)
;;Category Name;Abbreviation;AMIS Seg #;GL Number;Type;AR Cat #;Receivable Code;Interest;Admin;Penalty;Accrued;Refund;Paragraph Codes
"RTN","PRCAP338",51,0)
;;CC CHOICE THIRD PARTY;C1;249;1212;T;50;2;0;0;0;1;2;
"RTN","PRCAP338",52,0)
;;CC THIRD PARTY;C2;249;1212;T;51;2;0;0;0;1;2;
"RTN","PRCAP338",53,0)
;;CCN THIRD PARTY;C3;249;1212;T;52;2;0;0;0;1;2;
"RTN","PRCAP338",54,0)
;;CC MTF THIRD PARTY;C4;249;1212;T;53;2;0;0;0;1;2;
"RTN","PRCAP338",55,0)
;;CC CHOICE FIRST PARTY;C5;240;1221;P;54;2;1;1;0;1;2;30,40,55,80,85,50,60,65,70
"RTN","PRCAP338",56,0)
;;CC FIRST PARTY;C6;240;1221;P;55;2;1;1;0;1;2;30,40,55,80,85,50,60,65,70
"RTN","PRCAP338",57,0)
;;CCN FIRST PARTY;C7;240;1221;P;56;2;1;1;0;1;2;30,40,55,80,85,50,60,65,70
"RTN","PRCAP338",58,0)
;;CC MTF FIRST PARTY;C8;240;1221;P;57;2;1;1;0;1;2;30,40,55,80,85,50,60,65,70
"RTN","PRCAP338",59,0)
;;END
"RTN","PRCAP338",60,0)
;
"RTN","PRCAP338",61,0)
ARCATUPD ; AR CATEGORY ENTRIES (430.2)
"RTN","PRCAP338",62,0)
N LOOP,LIEN,PRCAARY,PRCADATA,PRCAARCT
"RTN","PRCAP338",63,0)
N PRCADMC,PRCATOP,PRCACS
"RTN","PRCAP338",64,0)
N X,Y,DIE,DA,DR,DTOUT,DATA
"RTN","PRCAP338",65,0)
;
"RTN","PRCAP338",66,0)
D MES^XPDUTL(" -> Adding data to the new AR CATEGORY (430.2) fields ...")
"RTN","PRCAP338",67,0)
;Clear the array
"RTN","PRCAP338",68,0)
K PRCAARY
"RTN","PRCAP338",69,0)
; Grab all of the entries to update
"RTN","PRCAP338",70,0)
F LOOP=2:1 S PRCADATA=$T(ARUPDDAT+LOOP) Q:PRCADATA=" ;;END" D
"RTN","PRCAP338",71,0)
. ;Extract the new AR Category to be added.
"RTN","PRCAP338",72,0)
. S PRCAARCT=$P(PRCADATA,";",4)
"RTN","PRCAP338",73,0)
. ;Store in array for adding to the file (#430.2).
"RTN","PRCAP338",74,0)
. S PRCAARY(PRCAARCT)=$P(PRCADATA,";",5,7)
"RTN","PRCAP338",75,0)
;
"RTN","PRCAP338",76,0)
;Loop through all of the entries in the AC xref of the 430.2 file, and update using the built array
"RTN","PRCAP338",77,0)
F LOOP=1:1:58 D
"RTN","PRCAP338",78,0)
. S DATA=$G(PRCAARY(LOOP))
"RTN","PRCAP338",79,0)
. Q:DATA="" ;go to next entry if Category is not to be updated.
"RTN","PRCAP338",80,0)
. S LIEN=$O(^PRCA(430.2,"AC",LOOP,""))
"RTN","PRCAP338",81,0)
. Q:LIEN=""
"RTN","PRCAP338",82,0)
. S PRCADMC=$P(DATA,";",1)
"RTN","PRCAP338",83,0)
. S PRCATOP=$P(DATA,";",2)
"RTN","PRCAP338",84,0)
. S PRCACS=$P(DATA,";",3)
"RTN","PRCAP338",85,0)
. ;
"RTN","PRCAP338",86,0)
. ; File the update
"RTN","PRCAP338",87,0)
. S DR="1.01////"_PRCADMC_";"
"RTN","PRCAP338",88,0)
. S DR=DR_"1.02////"_PRCATOP_";"
"RTN","PRCAP338",89,0)
. S DR=DR_"1.03////"_PRCACS_";"
"RTN","PRCAP338",90,0)
. Q:DR=""
"RTN","PRCAP338",91,0)
. S DIE="^PRCA(430.2,",DA=LIEN
"RTN","PRCAP338",92,0)
. D ^DIE
"RTN","PRCAP338",93,0)
. K DR ;Clear update array before next use
"RTN","PRCAP338",94,0)
;
"RTN","PRCAP338",95,0)
S DR=""
"RTN","PRCAP338",96,0)
D MES^XPDUTL(" Data added to the new AR CATEGORY (430.2) fields.")
"RTN","PRCAP338",97,0)
Q
"RTN","PRCAP338",98,0)
;
"RTN","PRCAP338",99,0)
ARUPDDAT ; Data for the new AR Category fields. (All categories will be updated)
"RTN","PRCAP338",100,0)
;;Category Name;Category Num;DMC?;TOP?;CS?
"RTN","PRCAP338",101,0)
;;ADULT DAY HEALTH CARE;40;1;2;3
"RTN","PRCAP338",102,0)
;;C (MEANS TEST);24;1;2;3
"RTN","PRCAP338",103,0)
;;CHAMPVA;36;0;0;0
"RTN","PRCAP338",104,0)
;;CHAMPVA SUBSISTENCE;34;0;0;0
"RTN","PRCAP338",105,0)
;;CHAMPVA THIRD PARTY;35;0;0;0
"RTN","PRCAP338",106,0)
;;COMP & PEN PROCEEDS;8;0;0;0
"RTN","PRCAP338",107,0)
;;CRIME OF PER.VIO.;27;0;0;0
"RTN","PRCAP338",108,0)
;;CURRENT EMP.;14;0;1;0
"RTN","PRCAP338",109,0)
;;CWT PROCEEDS;7;0;0;0
"RTN","PRCAP338",110,0)
;;DOMICILIARY;41;1;2;3
"RTN","PRCAP338",111,0)
;;EMERGENCY/HUMANITARIAN;25;0;1;0
"RTN","PRCAP338",112,0)
;;EMERGENCY/HUMANITARIAN REIMB.;48;0;0;0
"RTN","PRCAP338",113,0)
;;ENHANCED USE LEASE PROCEEDS;10;0;1;0
"RTN","PRCAP338",114,0)
;;EX-EMPLOYEE;13;0;1;0
"RTN","PRCAP338",115,0)
;;FEDERAL AGENCIES-REFUND;15;0;0;0
"RTN","PRCAP338",116,0)
;;FEDERAL AGENCIES-REIMB.;16;0;0;0
"RTN","PRCAP338",117,0)
;;FEE REIMB INS;47;0;0;0
"RTN","PRCAP338",118,0)
;;GERIATRIC EVAL-INSTITUTIONAL;44;1;2;3
"RTN","PRCAP338",119,0)
;;GERIATRIC EVAL-NON-INSTITUTION;45;1;2;3
"RTN","PRCAP338",120,0)
;;HOSPITAL CARE (NSC);1;1;2;3
"RTN","PRCAP338",121,0)
;;HOSPITAL CARE PER DIEM;32;1;2;3
"RTN","PRCAP338",122,0)
;;INELIGIBLE HOSP.;20;0;1;0
"RTN","PRCAP338",123,0)
;;INELIGIBLE HOSP. REIMB.;49;0;0;0
"RTN","PRCAP338",124,0)
;;INTERAGENCY;19;0;0;0
"RTN","PRCAP338",125,0)
;;MEDICARE;28;0;0;0
"RTN","PRCAP338",126,0)
;;MILITARY;17;0;0;0
"RTN","PRCAP338",127,0)
;;NO-FAULT AUTO ACC.;26;0;0;0
"RTN","PRCAP338",128,0)
;;NURSING HOME CARE PER DIEM;31;1;2;3
"RTN","PRCAP338",129,0)
;;NURSING HOME CARE(NSC);3;1;2;3
"RTN","PRCAP338",130,0)
;;NURSING HOME CARE-LTC;46;1;2;3
"RTN","PRCAP338",131,0)
;;NURSING HOME PROCEEDS;5;1;2;3
"RTN","PRCAP338",132,0)
;;OUTPATIENT CARE(NSC);2;1;2;3
"RTN","PRCAP338",133,0)
;;PARKING FEES;6;0;1;0
"RTN","PRCAP338",134,0)
;;PREPAYMENT;33;0;0;0
"RTN","PRCAP338",135,0)
;;REIMBURS.HEALTH INS;21;0;0;0
"RTN","PRCAP338",136,0)
;;RESPITE CARE-INSTITUTIONAL;42;1;2;3
"RTN","PRCAP338",137,0)
;;RESPITE CARE-NON-INSTITUTIONAL;43;1;2;3
"RTN","PRCAP338",138,0)
;;RX CO-PAYMENT/NSC VET;30;1;2;3
"RTN","PRCAP338",139,0)
;;RX CO-PAYMENT/SC VET;29;1;2;3
"RTN","PRCAP338",140,0)
;;SHARING AGREEMENTS;18;0;1;0
"RTN","PRCAP338",141,0)
;;TORT FEASOR;22;0;0;0
"RTN","PRCAP338",142,0)
;;TRICARE;37;0;0;0
"RTN","PRCAP338",143,0)
;;TRICARE PATIENT;38;1;2;3
"RTN","PRCAP338",144,0)
;;TRICARE THIRD PARTY;39;0;0;0
"RTN","PRCAP338",145,0)
;;VENDOR;11;0;1;0
"RTN","PRCAP338",146,0)
;;WORKMAN'S COMP.;23;0;0;0
"RTN","PRCAP338",147,0)
;;CC CHOICE THIRD PARTY;50;0;0;0
"RTN","PRCAP338",148,0)
;;CC THIRD PARTY;51;0;0;0
"RTN","PRCAP338",149,0)
;;CCN THIRD PARTY;52;0;0;0
"RTN","PRCAP338",150,0)
;;CC MTF THIRD PARTY;53;0;0;0
"RTN","PRCAP338",151,0)
;;CC CHOICE FIRST PARTY;54;1;0;1
"RTN","PRCAP338",152,0)
;;CC FIRST PARTY;55;1;0;1
"RTN","PRCAP338",153,0)
;;CCN FIRST PARTY;56;1;0;1
"RTN","PRCAP338",154,0)
;;CC MTF FIRST PARTY;57;1;0;1
"RTN","PRCAP338",155,0)
;;END
"RTN","PRCAP338",156,0)
;
"RTN","PRCAP338",157,0)
REVSC ;REVENUE SOURCE CODE entries in file #347.3
"RTN","PRCAP338",158,0)
N LOOP,FDA,FDAIEN,DATA,CHK
"RTN","PRCAP338",159,0)
;
"RTN","PRCAP338",160,0)
D MES^XPDUTL(" -> Adding new Revenue Source Codes to 347.3 ...")
"RTN","PRCAP338",161,0)
; Add new Rate Types
"RTN","PRCAP338",162,0)
F LOOP=2:1 S DATA=$T(NEWRSC+LOOP) Q:DATA=" ;;END" D
"RTN","PRCAP338",163,0)
. ;Clear the array
"RTN","PRCAP338",164,0)
. K FDA
"RTN","PRCAP338",165,0)
. ;Check to insure that the Revenue Source Code doesn't exist already
"RTN","PRCAP338",166,0)
. S CHK="" ; Initialized the check variable
"RTN","PRCAP338",167,0)
. S CHK=$O(^RC(347.3,"B",$P(DATA,";",4),""))
"RTN","PRCAP338",168,0)
. Q:CHK'=""
"RTN","PRCAP338",169,0)
. ;Store in array for adding to the file (#347.3).
"RTN","PRCAP338",170,0)
. S FDA(347.3,"+1,",.01)=$P(DATA,";",4)
"RTN","PRCAP338",171,0)
. S FDA(347.3,"+1,",.02)=$P(DATA,";",3)
"RTN","PRCAP338",172,0)
. S FDA(347.3,"+1,",.03)=$P(DATA,";",5)
"RTN","PRCAP338",173,0)
. ;Add to the file.
"RTN","PRCAP338",174,0)
. D UPDATE^DIE(,"FDA","FDAIEN")
"RTN","PRCAP338",175,0)
. S FDAIEN=FDAIEN(1) K FDAIEN(1)
"RTN","PRCAP338",176,0)
D MES^XPDUTL(" New Revenue Source Codes completed.")
"RTN","PRCAP338",177,0)
Q
"RTN","PRCAP338",178,0)
;
"RTN","PRCAP338",179,0)
NEWRSC ;New Revenue Source Codes (RSC#)
"RTN","PRCAP338",180,0)
;;SOURCE CODE;NAME;inactive flag
"RTN","PRCAP338",181,0)
;;CC 3RD-PTY WORKERS' COMP;8C6C;0
"RTN","PRCAP338",182,0)
;;CC 3RD-PTY NO-FAULT AUTO;8C4C;0
"RTN","PRCAP338",183,0)
;;CC 3RD-PTY TORT FEASOR;8C5C;0
"RTN","PRCAP338",184,0)
;;CC 3RD-PTY INPATIENT;8C1C;0
"RTN","PRCAP338",185,0)
;;CC 3RD-PTY OUTPATIENT;8C2C;0
"RTN","PRCAP338",186,0)
;;CC 3RD-PTY RX;8C3C;0
"RTN","PRCAP338",187,0)
;;CC CHOICE 3RD-PTY WORKER'S COMP;86CC;0
"RTN","PRCAP338",188,0)
;;CC CHOICE 3RD-PTY NO-FAULT AUTO;84CC;0
"RTN","PRCAP338",189,0)
;;CC CHOICE 3RD-PTY TORT FEASOR;85CC;0
"RTN","PRCAP338",190,0)
;;CC CHOICE 3RD-PTY INPATIENT;81CC;0
"RTN","PRCAP338",191,0)
;;CC CHOICE 3RD-PTY OUTPATIENT;82CC;0
"RTN","PRCAP338",192,0)
;;CC CHOICE 3RD-PTY RX;83CC;0
"RTN","PRCAP338",193,0)
;;CC MTF 3RD-PTY INPATIENT;8CD4;0
"RTN","PRCAP338",194,0)
;;CC MTF 3RD-PTY OUTPATIENT;8CD5;0
"RTN","PRCAP338",195,0)
;;CC MTF 3RD-PTY RX;8CD6;0
"RTN","PRCAP338",196,0)
;;CCN 3RD-PTY WORKERS' COMP;8CNW;0
"RTN","PRCAP338",197,0)
;;CCN 3RD-PTY NO-FAULT AUTO;8CN8;0
"RTN","PRCAP338",198,0)
;;CCN 3RD-PTY TORT FEASOR;8CN9;0
"RTN","PRCAP338",199,0)
;;CCN 3RD-PTY INPATIENT;8CN5;0
"RTN","PRCAP338",200,0)
;;CCN 3RD-PTY OUTPATIENT;8CN6;0
"RTN","PRCAP338",201,0)
;;CCN 3RD-PTY RX;8CN7;0
"RTN","PRCAP338",202,0)
;;CC 1ST-PTY INPATIENT;8CC1;0
"RTN","PRCAP338",203,0)
;;CC 1ST-PTY OUTPATIENT;8CC2;0
"RTN","PRCAP338",204,0)
;;CC 1ST-PTY RX;8CC3;0
"RTN","PRCAP338",205,0)
;;CC 1ST-PTY LTC;8CC4;0
"RTN","PRCAP338",206,0)
;;CC CHOICE 1ST-PTY INPATIENT;8CC5;0
"RTN","PRCAP338",207,0)
;;CC CHOICE 1ST-PTY OUTPATIENT;8CC6;0
"RTN","PRCAP338",208,0)
;;CC CHOICE 1ST-PTY RX;8CC7;0
"RTN","PRCAP338",209,0)
;;CC CHOICE 1ST-PTY LTC;8CC8;0
"RTN","PRCAP338",210,0)
;;CCN 1ST-PTY INPATIENT;8CN1;0
"RTN","PRCAP338",211,0)
;;CCN 1ST-PTY OUTPATIENT;8CN2;0
"RTN","PRCAP338",212,0)
;;CCN 1ST-PTY RX;8CN3;0
"RTN","PRCAP338",213,0)
;;CCN 1ST-PTY LTC;8CN4;0
"RTN","PRCAP338",214,0)
;;CC MTF 1ST-PTY INPATIENT;8CD1;0
"RTN","PRCAP338",215,0)
;;CC MTF 1ST-PTY OUTPATIENT;8CD2;0
"RTN","PRCAP338",216,0)
;;CC MTF 1ST-PTY RX;8CD3;0
"RTN","PRCAP338",217,0)
;;DOD DISABILITY EVALUATION SYSTEM (DES);8085;0
"RTN","PRCAP338",218,0)
;;DOD SPINAL CORD INPATIENT;8086;0
"RTN","PRCAP338",219,0)
;;DOD SPINAL CORD OUTPATIENT;8087;0
"RTN","PRCAP338",220,0)
;;DOD SPINAL CORD OTHER;8088;0
"RTN","PRCAP338",221,0)
;;DOD TRAUMATIC BRAIN INJURY INPATIENT;8089;0
"RTN","PRCAP338",222,0)
;;TRAUMATIC BRAIN INJURY OUTPATIENT;8090;0
"RTN","PRCAP338",223,0)
;;TRAUMATIC BRAIN INJURY OTHER;8091;0
"RTN","PRCAP338",224,0)
;;BLIND REHABILITATION INPATIENT;8092;0
"RTN","PRCAP338",225,0)
;;BLIND REHABILITATION OUTPATIENT;8093;0
"RTN","PRCAP338",226,0)
;;BLIND REHABILITATION OTHER;8094;0
"RTN","PRCAP338",227,0)
;;TRICARE PHARMACY;8095;0
"RTN","PRCAP338",228,0)
;;TRICARE ACTIVE DUTY DENTAL;8096;0
"RTN","PRCAP338",229,0)
;;END
"RTN","RCBEADJ")
0^3^B80995918
"RTN","RCBEADJ",1,0)
RCBEADJ ;WISC/RFJ-adjustment ;Jun 06, 2014@19:11:19
"RTN","RCBEADJ",2,0)
;;4.5;Accounts Receivable;**169,172,204,173,208,233,298,301,338**;Mar 20, 1995;Build 11
"RTN","RCBEADJ",3,0)
;Per VA Directive 6402, this routine should not be modified.
"RTN","RCBEADJ",4,0)
Q
"RTN","RCBEADJ",5,0)
;
"RTN","RCBEADJ",6,0)
;
"RTN","RCBEADJ",7,0)
DECREASE ; menu option: create a decrease adjustment
"RTN","RCBEADJ",8,0)
D ADJUST("DECREASE")
"RTN","RCBEADJ",9,0)
Q
"RTN","RCBEADJ",10,0)
;
"RTN","RCBEADJ",11,0)
;
"RTN","RCBEADJ",12,0)
INCREASE ; menu option: create an increase adjustment
"RTN","RCBEADJ",13,0)
D ADJUST("INCREASE")
"RTN","RCBEADJ",14,0)
Q
"RTN","RCBEADJ",15,0)
;
"RTN","RCBEADJ",16,0)
ADJUST(RCBETYPE,RCEDI) ; create an adjustment
"RTN","RCBEADJ",17,0)
; rcbetype = INCREASE for increase or DECREASE for decrease
"RTN","RCBEADJ",18,0)
; rcedi = the ien of the bill selected via the EDI Worklist;ien of
"RTN","RCBEADJ",19,0)
; XX the ERA entry or null/undefined if bill should be selected
"RTN","RCBEADJ",20,0)
N RCBILLDA
"RTN","RCBEADJ",21,0)
F D Q:RCBILLDA<0!$G(RCEDI)
"RTN","RCBEADJ",22,0)
. K RCTRANDA,RCLIST
"RTN","RCBEADJ",23,0)
. ;
"RTN","RCBEADJ",24,0)
. ; select a bill
"RTN","RCBEADJ",25,0)
. S RCBILLDA=$S('$G(RCEDI):$$GETABILL^RCBEUBIL,1:+RCEDI)
"RTN","RCBEADJ",26,0)
. I RCBILLDA<1 Q
"RTN","RCBEADJ",27,0)
. I $D(^PRCA(430,"TCSP",RCBILLDA)),(RCBETYPE="INCREASE") W !,"BILL HAS BEEN REFERRED TO CROSS-SERVICING.",!,"NO MANUAL INCREASE ADJUSTMENTS ARE ALLOWED." Q ;prca*4.5*301
"RTN","RCBEADJ",28,0)
. I $D(^PRCA(430,"TCSP",RCBILLDA)),(RCBETYPE="DECREASE") S %=2 W !!,"IS THIS ACTION BEING PERFORMED DUE TO THE CLAIMS MATCHING PROCESS? " D YN^DICN Q:(%<0)!(%=2) ;prca*4.5*301
"RTN","RCBEADJ",29,0)
. ;
"RTN","RCBEADJ",30,0)
. ; adjust the bill
"RTN","RCBEADJ",31,0)
. D ADJBILL(RCBETYPE,RCBILLDA,$P($G(RCEDI),";",2))
"RTN","RCBEADJ",32,0)
Q
"RTN","RCBEADJ",33,0)
;
"RTN","RCBEADJ",34,0)
ADJBILL(RCBETYPE,RCBILLDA,RCEDIWL) ; adjust a bill
"RTN","RCBEADJ",35,0)
; RCEDIWL = ien of ERA entry if called from worklist
"RTN","RCBEADJ",36,0)
N RCAMOUNT,RCBALANC,RCDATA7,RCLIST,RCONTADJ,RCTRANDA,TOTALCAL,TOTALSTO,I,X,Y
"RTN","RCBEADJ",37,0)
; lock the bill
"RTN","RCBEADJ",38,0)
L +^PRCA(430,RCBILLDA):5 E W !,"ANOTHER USER IS CURRENTLY WORKING WITH THIS BILL." Q
"RTN","RCBEADJ",39,0)
;
"RTN","RCBEADJ",40,0)
; show data for the bill
"RTN","RCBEADJ",41,0)
D SHOWBILL^RCWROFF1(RCBILLDA)
"RTN","RCBEADJ",42,0)
;
"RTN","RCBEADJ",43,0)
; check the balance of the bill
"RTN","RCBEADJ",44,0)
W !!,"Checking the bill's balance ..."
"RTN","RCBEADJ",45,0)
S RCBALANC=$$OUTOFBAL^RCBDBBAL(RCBILLDA)
"RTN","RCBEADJ",46,0)
I RCBALANC="" W " IN Balance!"
"RTN","RCBEADJ",47,0)
;
"RTN","RCBEADJ",48,0)
; out of balance, ask to fix it
"RTN","RCBEADJ",49,0)
I RCBALANC'="" D I RCBILLDA<1 D UNLOCK Q
"RTN","RCBEADJ",50,0)
. S TOTALCAL=$P(RCBALANC,"^")+$P(RCBALANC,"^",2)+$P(RCBALANC,"^",3)+$P(RCBALANC,"^",4)+$P(RCBALANC,"^",5)
"RTN","RCBEADJ",51,0)
. S RCDATA7=$G(^PRCA(430,RCBILLDA,7))
"RTN","RCBEADJ",52,0)
. S TOTALSTO=$P(RCDATA7,"^")+$P(RCDATA7,"^",2)+$P(RCDATA7,"^",3)+$P(RCDATA7,"^",4)+$P(RCDATA7,"^",5)
"RTN","RCBEADJ",53,0)
. W " OUT of Balance!"
"RTN","RCBEADJ",54,0)
. W !!," BALANCE:",$J("Calculated",12),$J("Stored",12)
"RTN","RCBEADJ",55,0)
. W !," ------- ",$J("------------",12),$J("------------",12)
"RTN","RCBEADJ",56,0)
. W !," Principal Balance:",$J($P(RCBALANC,"^",1),12,2),$J($P(RCDATA7,"^",1),12,2)
"RTN","RCBEADJ",57,0)
. I +$P(RCBALANC,"^",1)'=+$P(RCDATA7,"^",1) W " <<-- OUT OF BALANCE"
"RTN","RCBEADJ",58,0)
. W !," Interest Balance:",$J($P(RCBALANC,"^",2),12,2),$J($P(RCDATA7,"^",2),12,2)
"RTN","RCBEADJ",59,0)
. I +$P(RCBALANC,"^",2)'=+$P(RCDATA7,"^",2) W " <<-- OUT OF BALANCE"
"RTN","RCBEADJ",60,0)
. W !," Admin Balance:",$J($P(RCBALANC,"^",3),12,2),$J($P(RCDATA7,"^",3),12,2)
"RTN","RCBEADJ",61,0)
. I +$P(RCBALANC,"^",3)'=+$P(RCDATA7,"^",3) W " <<-- OUT OF BALANCE"
"RTN","RCBEADJ",62,0)
. W !," MF Balance:",$J($P(RCBALANC,"^",4),12,2),$J($P(RCDATA7,"^",4),12,2)
"RTN","RCBEADJ",63,0)
. I +$P(RCBALANC,"^",4)'=+$P(RCDATA7,"^",4) W " <<-- OUT OF BALANCE"
"RTN","RCBEADJ",64,0)
. W !," CC Balance:",$J($P(RCBALANC,"^",5),12,2),$J($P(RCDATA7,"^",5),12,2)
"RTN","RCBEADJ",65,0)
. I +$P(RCBALANC,"^",5)'=+$P(RCDATA7,"^",5) W " <<-- OUT OF BALANCE"
"RTN","RCBEADJ",66,0)
. W !," ------- ",$J("-------------",12),$J("-------------",12)
"RTN","RCBEADJ",67,0)
. W !," TOTAL:",$J(TOTALCAL,12,2),$J(TOTALSTO,12,2)
"RTN","RCBEADJ",68,0)
. I +TOTALCAL'=+TOTALSTO W " <<-- OUT OF BALANCE"
"RTN","RCBEADJ",69,0)
. ;
"RTN","RCBEADJ",70,0)
. ; ask to fix the balances
"RTN","RCBEADJ",71,0)
. S Y=$$ASKFIX I Y'=1 W !," NOTE: You must fix the Balance Discrepancy before processing an adjustment!" S RCBILLDA=0 Q
"RTN","RCBEADJ",72,0)
. ;
"RTN","RCBEADJ",73,0)
. ; fix it
"RTN","RCBEADJ",74,0)
. S $P(RCDATA7,"^",1)=+$P(RCBALANC,"^",1) ; principal
"RTN","RCBEADJ",75,0)
. S $P(RCDATA7,"^",2)=+$P(RCBALANC,"^",2) ; interest
"RTN","RCBEADJ",76,0)
. S $P(RCDATA7,"^",3)=+$P(RCBALANC,"^",3) ; admin
"RTN","RCBEADJ",77,0)
. S $P(RCDATA7,"^",4)=+$P(RCBALANC,"^",4) ; marshal fee
"RTN","RCBEADJ",78,0)
. S $P(RCDATA7,"^",5)=+$P(RCBALANC,"^",5) ; court cost
"RTN","RCBEADJ",79,0)
. S $P(^PRCA(430,RCBILLDA,7),"^",1,5)=$P(RCDATA7,"^",1,5)
"RTN","RCBEADJ",80,0)
. ;
"RTN","RCBEADJ",81,0)
. W !," Balance Discrepancy FIXED!"
"RTN","RCBEADJ",82,0)
;
"RTN","RCBEADJ",83,0)
; if the principal balance is zero, do not allow it to be adjusted
"RTN","RCBEADJ",84,0)
; ask to close/cancel it
"RTN","RCBEADJ",85,0)
I RCBETYPE="DECREASE",'$G(^PRCA(430,RCBILLDA,7)) W !!,"Note: This bill has NO PRINCIPAL BALANCE to decrease !" D INTADMIN(RCBILLDA),UNLOCK Q
"RTN","RCBEADJ",86,0)
;
"RTN","RCBEADJ",87,0)
; If entry is from EDI Lockbox worklist, display total adjustments in ERA
"RTN","RCBEADJ",88,0)
N AP D
"RTN","RCBEADJ",89,0)
.N BILL,EOB,ERA,SEQ S ERA="",AP=0
"RTN","RCBEADJ",90,0)
.F S ERA=$O(^RCY(344.4,"AP",1,ERA)) Q:'ERA D Q:AP
"RTN","RCBEADJ",91,0)
..S SEQ=0
"RTN","RCBEADJ",92,0)
..F S SEQ=$O(^RCY(344.4,"AP",1,ERA,SEQ)) Q:'SEQ D Q:AP
"RTN","RCBEADJ",93,0)
...S EOB=$P($G(^RCY(344.4,ERA,1,SEQ,0)),U,2) Q:'EOB
"RTN","RCBEADJ",94,0)
...S:$P($G(^IBM(361.1,EOB,0)),U)=RCBILLDA AP=1 ;IA #4051
"RTN","RCBEADJ",95,0)
;
"RTN","RCBEADJ",96,0)
; Ask to enter transaction even though it is marked for autopost PRCA*4.5*298
"RTN","RCBEADJ",97,0)
I RCBETYPE="DECREASE",AP S Y=$$ASKAUPO() I Y'=1 W !,"Exiting bill adjustment." D UNLOCK Q
"RTN","RCBEADJ",98,0)
;
"RTN","RCBEADJ",99,0)
; ask to enter adjustment amount
"RTN","RCBEADJ",100,0)
S RCAMOUNT=$$AMOUNT(RCBILLDA,RCBETYPE)
"RTN","RCBEADJ",101,0)
I RCAMOUNT<0 D UNLOCK Q
"RTN","RCBEADJ",102,0)
;
"RTN","RCBEADJ",103,0)
; if decrease, make negative
"RTN","RCBEADJ",104,0)
I RCBETYPE="DECREASE" S RCAMOUNT=-RCAMOUNT
"RTN","RCBEADJ",105,0)
; Third Party adjustment and contract adjustment are one in the same.
"RTN","RCBEADJ",106,0)
; ask if it is a contract / THIRD PARTY adjustment, which is based on the account receivable category
"RTN","RCBEADJ",107,0)
I RCBETYPE="DECREASE",$$THRDPRTY(RCBILLDA) S RCONTADJ=$$ASKCONT I RCONTADJ<0 D UNLOCK Q
"RTN","RCBEADJ",108,0)
;
"RTN","RCBEADJ",109,0)
; show what the new transaction will look like
"RTN","RCBEADJ",110,0)
S RCDATA7=$G(^PRCA(430,RCBILLDA,7))
"RTN","RCBEADJ",111,0)
W !!,"If you process the transaction, the bill will look like:"
"RTN","RCBEADJ",112,0)
W !,"Current Principal Balance: ",$J($P(RCDATA7,"^"),11,2)
"RTN","RCBEADJ",113,0)
W !," NEW ",RCBETYPE," Adjustment: ",$J(RCAMOUNT,11,2)
"RTN","RCBEADJ",114,0)
W !," -----------"
"RTN","RCBEADJ",115,0)
W !," NEW Principal Balance: ",$J($P(RCDATA7,"^")+RCAMOUNT,11,2)
"RTN","RCBEADJ",116,0)
;
"RTN","RCBEADJ",117,0)
; ask to enter transaction
"RTN","RCBEADJ",118,0)
S Y=$$ASKOK(RCBETYPE) I Y'=1 D UNLOCK Q
"RTN","RCBEADJ",119,0)
;
"RTN","RCBEADJ",120,0)
ADDADJ ; add adjustment
"RTN","RCBEADJ",121,0)
S RCTRANDA=$$INCDEC^RCBEUTR1(RCBILLDA,RCAMOUNT,"","","",$G(RCONTADJ))
"RTN","RCBEADJ",122,0)
I 'RCTRANDA W !," *** W A R N I N G: Adjustment NOT Processed! ***" D UNLOCK Q
"RTN","RCBEADJ",123,0)
I RCTRANDA W !," Adjustment Transaction: ",RCTRANDA," has been added."
"RTN","RCBEADJ",124,0)
I RCTRANDA,'$G(RCEDIWL),(RCBETYPE="DECREASE"),$D(^PRCA(430,"TCSP",RCBILLDA)) D DECADJ^RCTCSPU(RCBILLDA,RCTRANDA) ;prca*4.5*301 add cs decrease adjustment
"RTN","RCBEADJ",125,0)
I '$G(REFMS)&(DT>$$LDATE^RCRJR(DT)) S Y=$E($$FPS^RCAMFN01(DT,1),1,5)_"01" D DD^%DT W !!," * * * * Transmission will be held until "_Y_" * * * *"
"RTN","RCBEADJ",126,0)
;
"RTN","RCBEADJ",127,0)
; ask to enter a comment
"RTN","RCBEADJ",128,0)
W !!,"Enter a comment for the ",RCBETYPE," Adjustment:"
"RTN","RCBEADJ",129,0)
S Y=$$EDIT433^RCBEUTRA(RCTRANDA,"41;")
"RTN","RCBEADJ",130,0)
;
"RTN","RCBEADJ",131,0)
; ask to exempt interest and admin charges
"RTN","RCBEADJ",132,0)
I RCBETYPE="DECREASE" D INTADMIN(RCBILLDA)
"RTN","RCBEADJ",133,0)
;
"RTN","RCBEADJ",134,0)
; notification of subsequent payer bulletin
"RTN","RCBEADJ",135,0)
S RCDATA7=$G(^PRCA(430,RCBILLDA,7)),X=0
"RTN","RCBEADJ",136,0)
F I=1:1:5 S X=X+$P(RCDATA7,"^",I)
"RTN","RCBEADJ",137,0)
I RCDATA7'="",'X D
"RTN","RCBEADJ",138,0)
. N PRCABN,PRCAEN,PRCAMT
"RTN","RCBEADJ",139,0)
. S PRCABN=RCBILLDA,PRCAEN=RCTRANDA,PRCAMT=+$P($G(^PRCA(433,RCTRANDA,1)),"^",5)
"RTN","RCBEADJ",140,0)
. D EOB^PRCADJ
"RTN","RCBEADJ",141,0)
;
"RTN","RCBEADJ",142,0)
; unlock and ask the next bill to adjust
"RTN","RCBEADJ",143,0)
D UNLOCK
"RTN","RCBEADJ",144,0)
Q
"RTN","RCBEADJ",145,0)
;
"RTN","RCBEADJ",146,0)
;
"RTN","RCBEADJ",147,0)
UNLOCK ; unlock bill and transaction
"RTN","RCBEADJ",148,0)
L -^PRCA(430,RCBILLDA)
"RTN","RCBEADJ",149,0)
I $G(RCTRANDA) L -^PRCA(433,RCTRANDA)
"RTN","RCBEADJ",150,0)
Q
"RTN","RCBEADJ",151,0)
;
"RTN","RCBEADJ",152,0)
;
"RTN","RCBEADJ",153,0)
INTADMIN(RCBILLDA) ; ask and adjust the interest and admin
"RTN","RCBEADJ",154,0)
N RCAMOUNT,RCTRANDA,Y
"RTN","RCBEADJ",155,0)
;
"RTN","RCBEADJ",156,0)
; check to see if there is interest and admin charges
"RTN","RCBEADJ",157,0)
S RCAMOUNT=$G(^PRCA(430,RCBILLDA,7))
"RTN","RCBEADJ",158,0)
I '$P(RCAMOUNT,"^",2),'$P(RCAMOUNT,"^",3),'$P(RCAMOUNT,"^",4),'$P(RCAMOUNT,"^",5) Q
"RTN","RCBEADJ",159,0)
;
"RTN","RCBEADJ",160,0)
; only ask if there is no principal
"RTN","RCBEADJ",161,0)
I RCAMOUNT Q
"RTN","RCBEADJ",162,0)
;
"RTN","RCBEADJ",163,0)
W !!,"You have the option to automatically EXEMPT the interest"
"RTN","RCBEADJ",164,0)
W !,"and administrative charges. This will close the bill."
"RTN","RCBEADJ",165,0)
S Y=$$ASKEXEMP I Y'=1 Q
"RTN","RCBEADJ",166,0)
;
"RTN","RCBEADJ",167,0)
W !!,"Creating an EXEMPT transaction ..."
"RTN","RCBEADJ",168,0)
S RCTRANDA=$$EXEMPT^RCBEUTR2(RCBILLDA,$P(RCAMOUNT,"^",2)_"^"_$P(RCAMOUNT,"^",3)_"^^"_$P(RCAMOUNT,"^",4)_"^"_$P(RCAMOUNT,"^",5))
"RTN","RCBEADJ",169,0)
I 'RCTRANDA W !," *** W A R N I N G: EXEMPTION NOT Processed! ***" Q
"RTN","RCBEADJ",170,0)
I RCTRANDA W !," Exempt Transaction: ",RCTRANDA," has been added."
"RTN","RCBEADJ",171,0)
INTC35B ;Check if CS5B entry needed for exempt transaction
"RTN","RCBEADJ",172,0)
I RCTRANDA,'$G(RCEDIWL),(RCBETYPE="DECREASE"),$D(^PRCA(430,"TCSP",RCBILLDA)) D DECADJ^RCTCSPU(RCBILLDA,RCTRANDA) ;prca*4.5*301 add cs exempt
"RTN","RCBEADJ",173,0)
I '$G(REFMS)&(DT>$$LDATE^RCRJR(DT)) S Y=$E($$FPS^RCAMFN01(DT,1),1,5)_"01" D DD^%DT W !!," * * * * Transmission will be held until "_Y_" * * * *"
"RTN","RCBEADJ",174,0)
;
"RTN","RCBEADJ",175,0)
W !," Current Bill Status: ",$P($G(^PRCA(430.3,+$P($G(^PRCA(430,RCBILLDA,0)),"^",8),0)),"^")
"RTN","RCBEADJ",176,0)
Q
"RTN","RCBEADJ",177,0)
;
"RTN","RCBEADJ",178,0)
ASKOK(RCBETYPE) ; ask record decrease or increase transaction
"RTN","RCBEADJ",179,0)
N DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
"RTN","RCBEADJ",180,0)
S DIR(0)="YO",DIR("B")="YES"
"RTN","RCBEADJ",181,0)
S DIR("A")="Are you sure you want to enter this "_RCBETYPE_" adjustment "
"RTN","RCBEADJ",182,0)
W ! D ^DIR
"RTN","RCBEADJ",183,0)
I $G(DTOUT)!($G(DUOUT)) S Y=-1
"RTN","RCBEADJ",184,0)
Q Y
"RTN","RCBEADJ",185,0)
;
"RTN","RCBEADJ",186,0)
ASKAUPO() ; ask record even though marked for auto post PRCA*4.5*298
"RTN","RCBEADJ",187,0)
N DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
"RTN","RCBEADJ",188,0)
S DIR(0)="YOA",DIR("B")="NO"
"RTN","RCBEADJ",189,0)
S DIR("A")="Marked for Auto-Post. Are you sure? (Y/N) "
"RTN","RCBEADJ",190,0)
W ! D ^DIR
"RTN","RCBEADJ",191,0)
I $G(DTOUT)!($G(DUOUT)) S Y=-1
"RTN","RCBEADJ",192,0)
Q Y
"RTN","RCBEADJ",193,0)
;
"RTN","RCBEADJ",194,0)
ASKFIX() ; ask to fix bill's balance
"RTN","RCBEADJ",195,0)
N DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
"RTN","RCBEADJ",196,0)
S DIR(0)="YO",DIR("B")="YES"
"RTN","RCBEADJ",197,0)
S DIR("A")=" Do you want to FIX the balance discrepancy "
"RTN","RCBEADJ",198,0)
W ! D ^DIR
"RTN","RCBEADJ",199,0)
I $G(DTOUT)!($G(DUOUT)) S Y=-1
"RTN","RCBEADJ",200,0)
Q Y
"RTN","RCBEADJ",201,0)
;
"RTN","RCBEADJ",202,0)
;
"RTN","RCBEADJ",203,0)
ASKEXEMP() ; ask to record an exempt transaction
"RTN","RCBEADJ",204,0)
N DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
"RTN","RCBEADJ",205,0)
S DIR(0)="YO",DIR("B")="NO"
"RTN","RCBEADJ",206,0)
S DIR("A")=" Would you like to EXEMPT the interest and admin charges "
"RTN","RCBEADJ",207,0)
D ^DIR
"RTN","RCBEADJ",208,0)
I $G(DTOUT)!($G(DUOUT)) S Y=-1
"RTN","RCBEADJ",209,0)
Q Y
"RTN","RCBEADJ",210,0)
;
"RTN","RCBEADJ",211,0)
;
"RTN","RCBEADJ",212,0)
ASKCONT() ; ask if contract adjustment
"RTN","RCBEADJ",213,0)
N DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
"RTN","RCBEADJ",214,0)
S DIR(0)="YO",DIR("B")="YES"
"RTN","RCBEADJ",215,0)
S DIR("A")=" Is this a CONTRACT adjustment "
"RTN","RCBEADJ",216,0)
W ! D ^DIR
"RTN","RCBEADJ",217,0)
I $G(DTOUT)!($G(DUOUT)) S Y=-1
"RTN","RCBEADJ",218,0)
Q Y
"RTN","RCBEADJ",219,0)
;
"RTN","RCBEADJ",220,0)
ADJNUM(RCBILLDA) ; get next adjustment number for a bill
"RTN","RCBEADJ",221,0)
N %,ADJUST,DATA1,RCTRANDA
"RTN","RCBEADJ",222,0)
S RCTRANDA=0
"RTN","RCBEADJ",223,0)
F S RCTRANDA=$O(^PRCA(433,"C",RCBILLDA,RCTRANDA)) Q:'RCTRANDA S DATA1=$G(^PRCA(433,RCTRANDA,1)) I $P(DATA1,"^",4),$P(DATA1,"^",2)=1!($P(DATA1,"^",2)=35) S ADJUST=$P(DATA1,"^",4)+1
"RTN","RCBEADJ",224,0)
Q ADJUST
"RTN","RCBEADJ",225,0)
;
"RTN","RCBEADJ",226,0)
AMOUNT(RCBILLDA,RCBETYPE) ; enter the adjustment amount for a bill
"RTN","RCBEADJ",227,0)
N DIR,DIRUT,DTOUT,DUOUT,PRINBAL,X,Y
"RTN","RCBEADJ",228,0)
S PRINBAL=+$P($G(^PRCA(430,RCBILLDA,7)),"^")
"RTN","RCBEADJ",229,0)
I RCBETYPE="INCREASE" S PRINBAL=9999999.99
"RTN","RCBEADJ",230,0)
W !!,"Enter the ",RCBETYPE," Adjustment AMOUNT, from .01 to ",$J(PRINBAL,0,2),"."
"RTN","RCBEADJ",231,0)
S DIR(0)="NAO^.01:"_PRINBAL_":2"
"RTN","RCBEADJ",232,0)
S DIR("A")=" "_RCBETYPE_" PRINCIPAL BALANCE BY: "
"RTN","RCBEADJ",233,0)
D ^DIR
"RTN","RCBEADJ",234,0)
I $G(DTOUT)!($G(DUOUT)) S Y=-1
"RTN","RCBEADJ",235,0)
Q $S(Y'="":Y,1:-1)
"RTN","RCBEADJ",236,0)
;
"RTN","RCBEADJ",237,0)
THRDPRTY(RCBILLDA) ; check whether or not bill is THIRD PARTY
"RTN","RCBEADJ",238,0)
N RCCAT
"RTN","RCBEADJ",239,0)
S RCCAT=$$GET1^DIQ(430,RCBILLDA,2,"I") ; get account receivable category
"RTN","RCBEADJ",240,0)
I $$GET1^DIQ(430.2,RCCAT,5,"I")="T" Q 1 ; return true if the account receivable category is THIRD PARTY
"RTN","RCBEADJ",241,0)
Q 0
"RTN","RCBEADJ",242,0)
;
"RTN","RCXFMSUF")
0^2^B42318181
"RTN","RCXFMSUF",1,0)
RCXFMSUF ;WISC/RFJ-calculate fms fund code for a bill ; 10/20/10 10:37am
"RTN","RCXFMSUF",2,0)
;;4.5;Accounts Receivable;**90,101,135,157,160,165,170,203,207,173,211,192,220,235,273,315,338**;Mar 20, 1995;Build 11
"RTN","RCXFMSUF",3,0)
;;Per VHA Directive 6402, this routine should not be modified.
"RTN","RCXFMSUF",4,0)
Q
"RTN","RCXFMSUF",5,0)
;
"RTN","RCXFMSUF",6,0)
;
"RTN","RCXFMSUF",7,0)
GETFUNDO(TYPE) ; return the fund for other type associated collections
"RTN","RCXFMSUF",8,0)
; type can equal:
"RTN","RCXFMSUF",9,0)
; I for interest A for admin
"RTN","RCXFMSUF",10,0)
; M for marshall fee C for court cost
"RTN","RCXFMSUF",11,0)
I TYPE="I" Q "1435"
"RTN","RCXFMSUF",12,0)
I TYPE="A" Q "3220"
"RTN","RCXFMSUF",13,0)
I TYPE="M" Q "0869"
"RTN","RCXFMSUF",14,0)
I TYPE="C" Q "0869"
"RTN","RCXFMSUF",15,0)
Q ""
"RTN","RCXFMSUF",16,0)
;
"RTN","RCXFMSUF",17,0)
;
"RTN","RCXFMSUF",18,0)
GETFUNDB(BILLDA,DONTSTOR,RCEFT) ; return a bills fms fund code
"RTN","RCXFMSUF",19,0)
; pass DONTSTOR equal 1 to prevent storing the fund code
"RTN","RCXFMSUF",20,0)
; cannot rely on data in the fund field since it may reference the
"RTN","RCXFMSUF",21,0)
; old funds S FUND=$P($G(^PRCA(430,BILLDA,11)),"^",17). since there
"RTN","RCXFMSUF",22,0)
; are reports which use 11;17, set it for a bill once its computed
"RTN","RCXFMSUF",23,0)
; until all references to the fund are eliminated.
"RTN","RCXFMSUF",24,0)
; rceft = 1 if processing an EFT deposit
"RTN","RCXFMSUF",25,0)
;
"RTN","RCXFMSUF",26,0)
; Undeclared variables passed in - REFMS,REPRODT,DATEEND
"RTN","RCXFMSUF",27,0)
;
"RTN","RCXFMSUF",28,0)
N ACTDATE,CATEGDA,FUND,NEWFUND
"RTN","RCXFMSUF",29,0)
;
"RTN","RCXFMSUF",30,0)
; calculate a bills fund
"RTN","RCXFMSUF",31,0)
I $G(RCEFT)=1 S FUND="5287"_$S(DT<3030926:"",DT'<3030926&(DT<$$ADDPTEDT^PRCAACC()):".4",1:"04") Q FUND
"RTN","RCXFMSUF",32,0)
S CATEGDA=+$P($G(^PRCA(430,BILLDA,0)),"^",2)
"RTN","RCXFMSUF",33,0)
I CATEGDA>55 Q ""
"RTN","RCXFMSUF",34,0)
;
"RTN","RCXFMSUF",35,0)
; piece 5 is new fund, remove spaces
"RTN","RCXFMSUF",36,0)
S FUND=$P($TR($T(@CATEGDA)," "),";",5)
"RTN","RCXFMSUF",37,0)
;
"RTN","RCXFMSUF",38,0)
; set fund 528711 for 3rd party RX bills after 4/27/2011
"RTN","RCXFMSUF",39,0)
I $$TYP^IBRFN(BILLDA)="PH" D
"RTN","RCXFMSUF",40,0)
. I (CATEGDA=6)!(CATEGDA=7)!(CATEGDA=9)!(CATEGDA=10),$$CHECKRXS(BILLDA) S FUND=528711
"RTN","RCXFMSUF",41,0)
;
"RTN","RCXFMSUF",42,0)
; if category is vendor(17), ex-employee(15), current employee(16)
"RTN","RCXFMSUF",43,0)
; federal agency refund(13), federal agency reimb(14), military(12)
"RTN","RCXFMSUF",44,0)
; set the fund to what is stored in the file. This was entered
"RTN","RCXFMSUF",45,0)
; by the user during the audit process. If fund is in the file
"RTN","RCXFMSUF",46,0)
; already, do not need to store it again.
"RTN","RCXFMSUF",47,0)
; if category is nursing home proceeds (40), parking fees (41),
"RTN","RCXFMSUF",48,0)
; cwt proceeds (42), comp & pen proceeds (43), enhanced use lease
"RTN","RCXFMSUF",49,0)
; proceeds (44), set the fund to what is stored in the file.
"RTN","RCXFMSUF",50,0)
; This was generated by the software at the time of bill enter.
"RTN","RCXFMSUF",51,0)
I CATEGDA=17!(CATEGDA=15)!(CATEGDA=16)!(CATEGDA=13)!(CATEGDA=14)!(CATEGDA=12)!(CATEGDA=40)!(CATEGDA=41)!(CATEGDA=42)!(CATEGDA=43)!(CATEGDA=44) D
"RTN","RCXFMSUF",52,0)
. I $P($G(^PRCA(430,BILLDA,11)),"^",17)'="" S FUND=$P(^(11),"^",17),DONTSTOR=1
"RTN","RCXFMSUF",53,0)
;
"RTN","RCXFMSUF",54,0)
; public law states that bills in the category ineligible (1),
"RTN","RCXFMSUF",55,0)
; emerg/human (2), torts (10), or medicare (21) which are older
"RTN","RCXFMSUF",56,0)
; than oct 1, 1992 should be reported under fund 3220.
"RTN","RCXFMSUF",57,0)
I CATEGDA=1!(CATEGDA=2)!(CATEGDA=10)!(CATEGDA=21) D
"RTN","RCXFMSUF",58,0)
. S ACTDATE=$P($G(^PRCA(430,BILLDA,6)),"^",21)
"RTN","RCXFMSUF",59,0)
. I ACTDATE,ACTDATE<2921001 S FUND=3220 Q
"RTN","RCXFMSUF",60,0)
. ;
"RTN","RCXFMSUF",61,0)
. ; patch157 changes ineligibles. an ineligible activated before
"RTN","RCXFMSUF",62,0)
. ; oct 1, 1992 or after sep 30, 2000 will be recorded in fund 0160A1.
"RTN","RCXFMSUF",63,0)
. ; otherwise it will be recorded in fund 5287.3 if before 3040928
"RTN","RCXFMSUF",64,0)
. ; if 3040928 or after, fund should be 528703
"RTN","RCXFMSUF",65,0)
. I CATEGDA=1,ACTDATE,ACTDATE<3001001 S FUND=$S(DT<$$ADDPTEDT^PRCAACC():"5287.3",1:528703)
"RTN","RCXFMSUF",66,0)
;
"RTN","RCXFMSUF",67,0)
; set the fund for the bill
"RTN","RCXFMSUF",68,0)
I $G(DONTSTOR)'=1 D STORE^RCXFMSUR(BILLDA,"",FUND)
"RTN","RCXFMSUF",69,0)
;
"RTN","RCXFMSUF",70,0)
I FUND>528704,FUND<528709!(FUND=528710)!(FUND=528711) Q FUND
"RTN","RCXFMSUF",71,0)
;
"RTN","RCXFMSUF",72,0)
I $G(REPRODT),REPRODT<3030926,$E(FUND,1,4)=5287 Q 5287
"RTN","RCXFMSUF",73,0)
I $G(REPRODT),REPRODT<3031001,$E(FUND,1,4)=5287,$G(REFMS) Q 5287
"RTN","RCXFMSUF",74,0)
I DT<3030926,$E(FUND,1,4)=5287 Q 5287 ; Effective date
"RTN","RCXFMSUF",75,0)
I $G(REPRODT),REPRODT<$$ADDPTEDT^PRCAACC(),FUND=528709 Q 4032 ;Effective date-528709
"RTN","RCXFMSUF",76,0)
I $G(REPRODT),REPRODT<3041001,FUND=528709,$G(REFMS) Q 4032 ;Resubmitted documents not held
"RTN","RCXFMSUF",77,0)
I $G(DATEEND),$E(DATEEND,2,5)<"0410",FUND=528709 Q 4032
"RTN","RCXFMSUF",78,0)
I DT<$$ADDPTEDT^PRCAACC(),FUND=528709 Q 4032
"RTN","RCXFMSUF",79,0)
I $G(REPRODT),REPRODT<$$ADDPTEDT^PRCAACC(),FUND=528701 Q 5287.1 ;Effective date-528701
"RTN","RCXFMSUF",80,0)
I $G(REPRODT),REPRODT<3041001,FUND=528701,$G(REFMS) Q 5287.1 ;Resubmitted documents not held
"RTN","RCXFMSUF",81,0)
I $G(DATEEND),$E(DATEEND,2,5)<"0410",FUND=528701 Q 5287.1
"RTN","RCXFMSUF",82,0)
I DT<$$ADDPTEDT^PRCAACC(),FUND=528701 Q 5287.1
"RTN","RCXFMSUF",83,0)
I $G(REPRODT),REPRODT<$$ADDPTEDT^PRCAACC(),FUND=528703 Q 5287.3 ;Effective date-528703
"RTN","RCXFMSUF",84,0)
I $G(REPRODT),REPRODT<3041001,FUND=528703,$G(REFMS) Q 5287.3 ;Resubmitted documents not held
"RTN","RCXFMSUF",85,0)
I $G(DATEEND),$E(DATEEND,2,5)<"0410",FUND=528703 Q 5287.3
"RTN","RCXFMSUF",86,0)
I DT<$$ADDPTEDT^PRCAACC(),FUND=528703 Q 5287.3
"RTN","RCXFMSUF",87,0)
I $G(REPRODT),REPRODT<$$ADDPTEDT^PRCAACC(),FUND=528704 Q 5287.4 ;Effective date-528704
"RTN","RCXFMSUF",88,0)
I $G(REPRODT),REPRODT<3041001,FUND=528704,$G(REFMS) Q 5287.4 ;Resubmitted documents not held
"RTN","RCXFMSUF",89,0)
I $G(DATEEND),$E(DATEEND,2,5)<"0410",FUND=528704 Q 5287.4
"RTN","RCXFMSUF",90,0)
I DT<$$ADDPTEDT^PRCAACC(),FUND=528704 Q 5287.4
"RTN","RCXFMSUF",91,0)
Q FUND
"RTN","RCXFMSUF",92,0)
;
"RTN","RCXFMSUF",93,0)
CHECKRXS(BILLDA) ; returns true (1) if bill has any scripts on or after 4/27/11
"RTN","RCXFMSUF",94,0)
N RXNUM,NEWFUND,FILLDT,ARRXS
"RTN","RCXFMSUF",95,0)
S NEWFUND=0
"RTN","RCXFMSUF",96,0)
D SET^IBCSC5A(BILLDA,.ARRXS,)
"RTN","RCXFMSUF",97,0)
S RXNUM=0,FILLDT=""
"RTN","RCXFMSUF",98,0)
F S RXNUM=$O(ARRXS(RXNUM)) Q:RXNUM'>0!(NEWFUND) D
"RTN","RCXFMSUF",99,0)
. S FILLDT=$O(ARRXS(RXNUM,0))
"RTN","RCXFMSUF",100,0)
. I FILLDT'<3110427 S NEWFUND=1
"RTN","RCXFMSUF",101,0)
Q NEWFUND
"RTN","RCXFMSUF",102,0)
;
"RTN","RCXFMSUF",103,0)
; this is a listing of all categories and associated funds
"RTN","RCXFMSUF",104,0)
; the label is from the internal entry number in the category
"RTN","RCXFMSUF",105,0)
; file 430.2. piece 3 is a description, piece 4 is the old fund,
"RTN","RCXFMSUF",106,0)
; piece 5 is the new fund
"RTN","RCXFMSUF",107,0)
0 ;;no fund ; ;
"RTN","RCXFMSUF",108,0)
1 ;;INELIGIBLE HOSP. ;3220 ;0160A1
"RTN","RCXFMSUF",109,0)
2 ;;EMERGENCY/HUMANITARIAN ;0160A1 ;528703
"RTN","RCXFMSUF",110,0)
3 ;;NURSING HOME CARE(NSC) ;2431 ;528703
"RTN","RCXFMSUF",111,0)
4 ;;OUTPATIENT CARE(NSC) ;2431 ;528703
"RTN","RCXFMSUF",112,0)
5 ;;HOSPITAL CARE (NSC) ;2431 ;528703
"RTN","RCXFMSUF",113,0)
6 ;;WORKMAN'S COMP. ;5014 ;528704
"RTN","RCXFMSUF",114,0)
7 ;;NO-FAULT AUTO ACC. ;5014 ;528704
"RTN","RCXFMSUF",115,0)
8 ;;CRIME OF PER.VIO. ;5014 ;528704
"RTN","RCXFMSUF",116,0)
9 ;;REIMBURS.HEALTH INS. ;5014 ;528704
"RTN","RCXFMSUF",117,0)
10 ;;TORT FEASOR ;0160A1 ;528704
"RTN","RCXFMSUF",118,0)
11 ;;no entry ; ;
"RTN","RCXFMSUF",119,0)
12 ;;MILITARY ;0160A1 ;0160A1
"RTN","RCXFMSUF",120,0)
13 ;;FEDERAL AGENCIES-REFUND ;0160A1 ;0160A1
"RTN","RCXFMSUF",121,0)
14 ;;FEDERAL AGENCIES-REIMB. ;0160A1 ;0160A1
"RTN","RCXFMSUF",122,0)
15 ;;EX-EMPLOYEE ;0160A1 ;0160A1
"RTN","RCXFMSUF",123,0)
16 ;;CURRENT EMP. ;0160A1 ;0160A1
"RTN","RCXFMSUF",124,0)
17 ;;VENDOR ;0160A1 ;0160A1
"RTN","RCXFMSUF",125,0)
18 ;;C (MEANS TEST) ;2431 ;528703
"RTN","RCXFMSUF",126,0)
19 ;;SHARING AGREEMENTS ;0160A1 ;0160A1
"RTN","RCXFMSUF",127,0)
20 ;;INTERAGENCY ;0160A1 ;0160A1
"RTN","RCXFMSUF",128,0)
21 ;;MEDICARE ;5014 ;528704
"RTN","RCXFMSUF",129,0)
22 ;;RX CO-PAYMENT/SC VET ;5014 ;528701
"RTN","RCXFMSUF",130,0)
23 ;;RX CO-PAYMENT/NSC VET ;5014 ;528701
"RTN","RCXFMSUF",131,0)
24 ;;NURSING HOME CARE PER DIEM ;2431 ;528703
"RTN","RCXFMSUF",132,0)
25 ;;HOSPITAL CARE PER DIEM ;2431 ;528703
"RTN","RCXFMSUF",133,0)
26 ;;PREPAYMENT ;5014 ;528703
"RTN","RCXFMSUF",134,0)
27 ;;CHAMPVA SUBSISTENCE ;3220 ;3220
"RTN","RCXFMSUF",135,0)
28 ;;CHAMPVA THIRD PARTY ;3220 ;0160A1
"RTN","RCXFMSUF",136,0)
29 ;;CHAMPVA ;0160A1 ;0160A1
"RTN","RCXFMSUF",137,0)
30 ;;TRICARE ;0160A1 ;0160A1
"RTN","RCXFMSUF",138,0)
31 ;;TRICARE PATIENT ;0160A1 ;0160A1
"RTN","RCXFMSUF",139,0)
32 ;;TRICARE THIRD PARTY ;0160A1 ;0160A1
"RTN","RCXFMSUF",140,0)
33 ;;ADULT DAY HEALTH CARE ;4032 ;528709
"RTN","RCXFMSUF",141,0)
34 ;;DOMICILIARY ;4032 ;528709
"RTN","RCXFMSUF",142,0)
35 ;;RESPITE CARE-INSTITUTIONAL ;4032 ;528709
"RTN","RCXFMSUF",143,0)
36 ;;RESPITE CARE-NON-INSTITUTIONAL;4032 ;528709
"RTN","RCXFMSUF",144,0)
37 ;;GERIATRIC EVAL-INSTITUTIONAL ;4032 ;528709
"RTN","RCXFMSUF",145,0)
38 ;;GERIATRIC EVAL-NON-INSTITUTION;4032 ;528709
"RTN","RCXFMSUF",146,0)
39 ;;NURSING HOME CARE-LTC ;4032 ;528709
"RTN","RCXFMSUF",147,0)
40 ;;NURSING HOME PROCEEDS ; ;528705
"RTN","RCXFMSUF",148,0)
41 ;;PARKING FEES ; ;528706
"RTN","RCXFMSUF",149,0)
42 ;;CWT PROCEEDS ; ;528707
"RTN","RCXFMSUF",150,0)
43 ;;COMP & PEN PROCEEDS ; ;528708
"RTN","RCXFMSUF",151,0)
44 ;;ENHANCED USE LEASE PROCEEDS ;5358.3 ;528710
"RTN","RCXFMSUF",152,0)
45 ;;FEE REIMB INS ; ;528713
"RTN","RCXFMSUF",153,0)
46 ;;EMERGENCY/HUMANITARIAN REIMB. ; ;528704 ;315
"RTN","RCXFMSUF",154,0)
47 ;;INELIGIBLE REIMB. INS. ; ;0160A1 ;315
"RTN","RCXFMSUF",155,0)
48 ;;CC CHOICE THIRD PARTY ; ;528713
"RTN","RCXFMSUF",156,0)
49 ;;CC THIRD PARTY ; ;528713
"RTN","RCXFMSUF",157,0)
50 ;;CCN THIRD PARTY ; ;528713
"RTN","RCXFMSUF",158,0)
51 ;;CC DOD THIRD PARTY ; ;528713
"RTN","RCXFMSUF",159,0)
52 ;;CC CHOICE FIRST PARTY ; ;528714
"RTN","RCXFMSUF",160,0)
53 ;;CC FIRST PARTY ; ;528714
"RTN","RCXFMSUF",161,0)
54 ;;CCN FIRST PARTY ; ;528714
"RTN","RCXFMSUF",162,0)
55 ;;CC DOD FIRST PARTY ; ;528714
"RTN","RCXFMSUF",163,0)
;
"RTN","RCXFMSUF",164,0)
;
"RTN","RCXFMSUR")
0^1^B108627445
"RTN","RCXFMSUR",1,0)
RCXFMSUR ;WISC/RFJ-revenue source codes ;10/19/10 1:47pm
"RTN","RCXFMSUR",2,0)
;;4.5;Accounts Receivable;**90,101,170,203,173,220,231,273,310,315,338**;Mar 20, 1995;Build 11
"RTN","RCXFMSUR",3,0)
;Per VA Directive 6402,this routine should not be modified.
"RTN","RCXFMSUR",4,0)
Q
"RTN","RCXFMSUR",5,0)
;
"RTN","RCXFMSUR",6,0)
;
"RTN","RCXFMSUR",7,0)
CALCRSC(BILLDA,RCEFT) ; calculate the revenue source code for a bill
"RTN","RCXFMSUR",8,0)
; rceft = 1 if processing an EFT deposit
"RTN","RCXFMSUR",9,0)
; returns the 4 column (character) rsc
"RTN","RCXFMSUR",10,0)
N CATEGDA,COLUMN1,COLUMN2,COLUMN3,COLUMN4,RSC,RCCAT
"RTN","RCXFMSUR",11,0)
; if rsc already calculated, return it
"RTN","RCXFMSUR",12,0)
I $G(RCEFT)=1 S RSC="8NZZ" Q RSC
"RTN","RCXFMSUR",13,0)
S RSC=$P($G(^PRCA(430,BILLDA,11)),"^",23)
"RTN","RCXFMSUR",14,0)
I $L(RSC)=4,RSC'="ARRV" Q RSC
"RTN","RCXFMSUR",15,0)
;
"RTN","RCXFMSUR",16,0)
; calculate it and store it
"RTN","RCXFMSUR",17,0)
S CATEGDA=+$P($G(^PRCA(430,BILLDA,0)),"^",2)
"RTN","RCXFMSUR",18,0)
;
"RTN","RCXFMSUR",19,0)
; if prepayment, send ARRV
"RTN","RCXFMSUR",20,0)
I CATEGDA=26 D STORE(BILLDA,"ARRV") Q "ARRV"
"RTN","RCXFMSUR",21,0)
;
"RTN","RCXFMSUR",22,0)
;***Start PRCA*4.5*3ZZ
"RTN","RCXFMSUR",23,0)
; If the category is a Community Care category, extract and exit
"RTN","RCXFMSUR",24,0)
S RCCAT=$O(^PRCA(430.2,"AC",CATEGDA,""))
"RTN","RCXFMSUR",25,0)
I (RCCAT>49),(RCCAT<56) Q $$CCRSC(CATEGDA,BILLDA)
"RTN","RCXFMSUR",26,0)
; If the category is a TRICARE category, extract and exit
"RTN","RCXFMSUR",27,0)
I RCCAT=37 Q $$CCRSC(CATEGDA,BILLDA)
"RTN","RCXFMSUR",28,0)
;
"RTN","RCXFMSUR",29,0)
;***End PRCA*4.5*3ZZ
"RTN","RCXFMSUR",30,0)
;
"RTN","RCXFMSUR",31,0)
S COLUMN1=$$COLUMN1
"RTN","RCXFMSUR",32,0)
;
"RTN","RCXFMSUR",33,0)
; check for 3rd party RX bills after 4/27/2011 for col 2
"RTN","RCXFMSUR",34,0)
N RX3P S RX3P=0
"RTN","RCXFMSUR",35,0)
I ("PH"=$$TYP^IBRFN(BILLDA)) D
"RTN","RCXFMSUR",36,0)
. S RX3P=$$CHECKRXS^RCXFMSUF(BILLDA)
"RTN","RCXFMSUR",37,0)
;
"RTN","RCXFMSUR",38,0)
S COLUMN2=$$COLUMN2
"RTN","RCXFMSUR",39,0)
;
"RTN","RCXFMSUR",40,0)
; if column2 cannot be determined, return the rsc of ARRV
"RTN","RCXFMSUR",41,0)
I COLUMN2="" D STORE(BILLDA,"ARRV") Q "ARRV"
"RTN","RCXFMSUR",42,0)
;
"RTN","RCXFMSUR",43,0)
I COLUMN2'=5,CATEGDA'=45 D STORE(BILLDA,COLUMN1_COLUMN2_"ZZ") Q COLUMN1_COLUMN2_"ZZ"
"RTN","RCXFMSUR",44,0)
;
"RTN","RCXFMSUR",45,0)
S COLUMN3=$$COLUMN3
"RTN","RCXFMSUR",46,0)
S COLUMN4=$$COLUMN4
"RTN","RCXFMSUR",47,0)
;
"RTN","RCXFMSUR",48,0)
D STORE(BILLDA,COLUMN1_COLUMN2_COLUMN3_COLUMN4)
"RTN","RCXFMSUR",49,0)
Q COLUMN1_COLUMN2_COLUMN3_COLUMN4
"RTN","RCXFMSUR",50,0)
;
"RTN","RCXFMSUR",51,0)
;
"RTN","RCXFMSUR",52,0)
STORE(DA,RSC,FUND) ; store the revenue source code or fund in the file
"RTN","RCXFMSUR",53,0)
I $G(^PRCA(430,DA,0))="" Q
"RTN","RCXFMSUR",54,0)
N D,D0,DI,DIC,DIE,DQ,DR,X,Y
"RTN","RCXFMSUR",55,0)
S DR=""
"RTN","RCXFMSUR",56,0)
I $G(RSC)'="" S DR="255.1////"_RSC_";"
"RTN","RCXFMSUR",57,0)
I $G(FUND)'="" S DR=DR_"203////"_FUND_";"
"RTN","RCXFMSUR",58,0)
S (DIC,DIE)="^PRCA(430,"
"RTN","RCXFMSUR",59,0)
D ^DIE
"RTN","RCXFMSUR",60,0)
Q
"RTN","RCXFMSUR",61,0)
;
"RTN","RCXFMSUR",62,0)
;
"RTN","RCXFMSUR",63,0)
COLUMN1() ; return column 1 number
"RTN","RCXFMSUR",64,0)
Q 8
"RTN","RCXFMSUR",65,0)
;
"RTN","RCXFMSUR",66,0)
;
"RTN","RCXFMSUR",67,0)
COLUMN2() ; return column 2 number
"RTN","RCXFMSUR",68,0)
I CATEGDA=5 Q 1 ; hospital care (nsc)
"RTN","RCXFMSUR",69,0)
I CATEGDA=4 Q 2 ; outpatient care (nsc)
"RTN","RCXFMSUR",70,0)
I CATEGDA=3 Q 3 ; nursing home care (nsc)
"RTN","RCXFMSUR",71,0)
I CATEGDA=1 Q 4 ; ineligible hospital
"RTN","RCXFMSUR",72,0)
I CATEGDA=9&$G(RX3P) Q "R" ; pharmacy reimbursable health insurance
"RTN","RCXFMSUR",73,0)
I CATEGDA=9 Q 5 ; reimbursable health insurance
"RTN","RCXFMSUR",74,0)
I CATEGDA=10&$G(RX3P) Q "S" ; pharmacy tort feasor
"RTN","RCXFMSUR",75,0)
I CATEGDA=10 Q 6 ; tort feasor
"RTN","RCXFMSUR",76,0)
I CATEGDA=6&$G(RX3P) Q "T" ;pharmacy workman's comp
"RTN","RCXFMSUR",77,0)
I CATEGDA=6 Q 7 ; workmans comp
"RTN","RCXFMSUR",78,0)
I CATEGDA=18 Q 8 ; c (means test)
"RTN","RCXFMSUR",79,0)
I CATEGDA=2 Q 9 ; emergency/humanitarian
"RTN","RCXFMSUR",80,0)
I CATEGDA=7&$G(RX3P) Q "Q" ;pharmacy no fault auto acc
"RTN","RCXFMSUR",81,0)
I CATEGDA=7 Q "A" ; no fault auto accident
"RTN","RCXFMSUR",82,0)
I CATEGDA=22 Q "B" ; rx copay/sc vet
"RTN","RCXFMSUR",83,0)
I CATEGDA=23 Q "C" ; rx copay/nsc vet
"RTN","RCXFMSUR",84,0)
I CATEGDA=24 Q "D" ; nursing home care per diem
"RTN","RCXFMSUR",85,0)
I CATEGDA=25 Q "E" ; hospital care per diem
"RTN","RCXFMSUR",86,0)
I CATEGDA=21 Q "F" ; medicare
"RTN","RCXFMSUR",87,0)
I CATEGDA=33 Q "G" ; adult day health care
"RTN","RCXFMSUR",88,0)
I CATEGDA=34 Q "H" ; domiciliary
"RTN","RCXFMSUR",89,0)
I CATEGDA=35 Q "I" ; respite care - institutional
"RTN","RCXFMSUR",90,0)
I CATEGDA=36 Q "J" ; respite care - non-institutional
"RTN","RCXFMSUR",91,0)
I CATEGDA=37 Q "K" ; geriatric evaluation - institutional
"RTN","RCXFMSUR",92,0)
I CATEGDA=38 Q "L" ; geriatric evaluation - non-institutional
"RTN","RCXFMSUR",93,0)
I CATEGDA=39 Q "M" ; nursing home care - ltc
"RTN","RCXFMSUR",94,0)
I CATEGDA=45 Q "F" ; Fee Basis
"RTN","RCXFMSUR",95,0)
I CATEGDA=46 D Q COLUMN2
"RTN","RCXFMSUR",96,0)
. N COL
"RTN","RCXFMSUR",97,0)
. D DIQ399(BILLDA)
"RTN","RCXFMSUR",98,0)
. S COL=$G(IBCNDATA(399,BILLDA,.05,"I"))
"RTN","RCXFMSUR",99,0)
. S COLUMN2=$S(COL=1:"U",COL=2:"U",COL=3:"V",1:"V")
"RTN","RCXFMSUR",100,0)
Q ""
"RTN","RCXFMSUR",101,0)
;
"RTN","RCXFMSUR",102,0)
;
"RTN","RCXFMSUR",103,0)
COLUMN3() ; return the column 3 number
"RTN","RCXFMSUR",104,0)
N AGE,DECIMAL,DFN,IBCNDATA,TYPEAGE,TYPECARE,TYPEMEAN,TYPESERV,VA,VADM,VAERR
"RTN","RCXFMSUR",105,0)
D DIQ399(BILLDA)
"RTN","RCXFMSUR",106,0)
;
"RTN","RCXFMSUR",107,0)
; PRCA*4.5*310/DRF
"RTN","RCXFMSUR",108,0)
; for Fee Basis, column3 = 1 (inpatient) or 2 (outpatient)
"RTN","RCXFMSUR",109,0)
I CATEGDA=45 S COLUMN3=$S($G(IBCNDATA(399,BILLDA,.05,"I"))=1:1,$G(IBCNDATA(399,BILLDA,.05,"I"))=2:2,1:2) Q COLUMN3
"RTN","RCXFMSUR",110,0)
;
"RTN","RCXFMSUR",111,0)
D TYPECARE
"RTN","RCXFMSUR",112,0)
;
"RTN","RCXFMSUR",113,0)
; compute service connected at time of care (1 digit binary)
"RTN","RCXFMSUR",114,0)
; type of service connected is set as follows:
"RTN","RCXFMSUR",115,0)
; 0 = SC Vet 1 = NSC Vet
"RTN","RCXFMSUR",116,0)
S TYPESERV=1
"RTN","RCXFMSUR",117,0)
; service connected at time of care (.18) = yes (1)
"RTN","RCXFMSUR",118,0)
I $G(IBCNDATA(399,BILLDA,.18,"I"))=1 S TYPESERV=0
"RTN","RCXFMSUR",119,0)
;
"RTN","RCXFMSUR",120,0)
S DFN=$P($G(^PRCA(430,BILLDA,0)),"^",7)
"RTN","RCXFMSUR",121,0)
D DEM^VADPT
"RTN","RCXFMSUR",122,0)
;
"RTN","RCXFMSUR",123,0)
; compute means test at time of care (1 digit binary)
"RTN","RCXFMSUR",124,0)
; type of means test is set as follows:
"RTN","RCXFMSUR",125,0)
; 0 = Cat A 1 = Cat C
"RTN","RCXFMSUR",126,0)
S TYPEMEAN=0
"RTN","RCXFMSUR",127,0)
I $$BIL^DGMTUB(DFN,$G(IBCNDATA(399,BILLDA,151,"I")))=1 S TYPEMEAN=1
"RTN","RCXFMSUR",128,0)
;
"RTN","RCXFMSUR",129,0)
; compute patient age at time of care (1 digit binary)
"RTN","RCXFMSUR",130,0)
; type of age is set as follows:
"RTN","RCXFMSUR",131,0)
; 0 = under 65 1 = 65 and older
"RTN","RCXFMSUR",132,0)
S AGE=$$FMDIFF^XLFDT($G(IBCNDATA(399,BILLDA,151,"I")),$P($G(VADM(3)),"^"))\365.25
"RTN","RCXFMSUR",133,0)
S TYPEAGE=1
"RTN","RCXFMSUR",134,0)
I AGE<65 S TYPEAGE=0
"RTN","RCXFMSUR",135,0)
;
"RTN","RCXFMSUR",136,0)
; convert to decimal typecare typeserv typemean typeage
"RTN","RCXFMSUR",137,0)
; binary= 1 1 1 1 1
"RTN","RCXFMSUR",138,0)
; decimal= 16 + 8 + 4 + 2 + 1
"RTN","RCXFMSUR",139,0)
S DECIMAL=$S(TYPECARE="11":24,TYPECARE="10":16,TYPECARE="01":8,1:0)
"RTN","RCXFMSUR",140,0)
I TYPESERV S DECIMAL=DECIMAL+4
"RTN","RCXFMSUR",141,0)
I TYPEMEAN S DECIMAL=DECIMAL+2
"RTN","RCXFMSUR",142,0)
I TYPEAGE S DECIMAL=DECIMAL+1
"RTN","RCXFMSUR",143,0)
I DECIMAL<10 Q DECIMAL
"RTN","RCXFMSUR",144,0)
Q $C(65+DECIMAL-10)
"RTN","RCXFMSUR",145,0)
;
"RTN","RCXFMSUR",146,0)
;
"RTN","RCXFMSUR",147,0)
COLUMN4(RCCAT) ; return the column 4 number (reserved for future expansion)
"RTN","RCXFMSUR",148,0)
Q:RCCAT>49 "C" ;*** PRCA*4.5*3ZZ
"RTN","RCXFMSUR",149,0)
Q "Z"
"RTN","RCXFMSUR",150,0)
;
"RTN","RCXFMSUR",151,0)
;
"RTN","RCXFMSUR",152,0)
DIQ399(DA) ; get data from file 399
"RTN","RCXFMSUR",153,0)
N D0,DIC,DIQ,DIQ2,DR
"RTN","RCXFMSUR",154,0)
K IBCNDATA
"RTN","RCXFMSUR",155,0)
;PRCA*4.5*338 Added the Rate Type field
"RTN","RCXFMSUR",156,0)
S DIQ(0)="IE",DIC="^DGCR(399,",DIQ="IBCNDATA",DR=".04;.05;.07;.18;151;" D EN^DIQ1
"RTN","RCXFMSUR",157,0)
Q
"RTN","RCXFMSUR",158,0)
;
"RTN","RCXFMSUR",159,0)
;
"RTN","RCXFMSUR",160,0)
TYPECARE ; compute type of care (2 digit binary)
"RTN","RCXFMSUR",161,0)
; type of care is set as follows:
"RTN","RCXFMSUR",162,0)
; 00 = inpatient (hospital) 01 = outpatient
"RTN","RCXFMSUR",163,0)
; 10 = nursing home 11 = other
"RTN","RCXFMSUR",164,0)
; default is other if it cannot be computed
"RTN","RCXFMSUR",165,0)
S TYPECARE="11"
"RTN","RCXFMSUR",166,0)
; bill classification (.05) = outpatient (3) or human.emerg(opt) (4)
"RTN","RCXFMSUR",167,0)
I $G(IBCNDATA(399,BILLDA,.05,"I"))=3!($G(IBCNDATA(399,BILLDA,.05,"I"))=4) S TYPECARE="01" Q
"RTN","RCXFMSUR",168,0)
; location of care (.04) = hospital inpt or outpt (1)
"RTN","RCXFMSUR",169,0)
I $G(IBCNDATA(399,BILLDA,.04,"I"))=1 S TYPECARE="00" Q
"RTN","RCXFMSUR",170,0)
; location of care (.04) = skilled nursing (nhcu) (2)
"RTN","RCXFMSUR",171,0)
I $G(IBCNDATA(399,BILLDA,.04,"I"))=2 S TYPECARE="10"
"RTN","RCXFMSUR",172,0)
Q
"RTN","RCXFMSUR",173,0)
;
"RTN","RCXFMSUR",174,0)
;
"RTN","RCXFMSUR",175,0)
ADDEDIT ; enter/edit revenue source codes for fund 0160A1 bills. These
"RTN","RCXFMSUR",176,0)
; bills have the rsc entered by the user. The user can select
"RTN","RCXFMSUR",177,0)
; from rscs in file 347.3
"RTN","RCXFMSUR",178,0)
W !!,"This option should be used with CAUTION. This option will allow the"
"RTN","RCXFMSUR",179,0)
W !,"user owning the PRCASVC supervisor security key, to add or edit the"
"RTN","RCXFMSUR",180,0)
W !,"Revenue Source Codes selectable for non MCCF bills. If an invalid"
"RTN","RCXFMSUR",181,0)
W !,"Revenue Source Code is entered or changed, all code sheets sent to"
"RTN","RCXFMSUR",182,0)
W !,"FMS referencing the invalid Revenue Source Code will reject. Be"
"RTN","RCXFMSUR",183,0)
W !,"cautious when entering new Revenue Source Codes or editing existing"
"RTN","RCXFMSUR",184,0)
W !,"Revenue Source Codes. New Revenue Source Codes should only be added"
"RTN","RCXFMSUR",185,0)
W !,"after they have been added in FMS."
"RTN","RCXFMSUR",186,0)
;
"RTN","RCXFMSUR",187,0)
I '$D(^XUSEC("PRCASVC",DUZ)) W !!,"You are not an owner of the PRCASVC security key." Q
"RTN","RCXFMSUR",188,0)
;
"RTN","RCXFMSUR",189,0)
N %,%Y,C,D,D0,DA,DI,DIC,DIE,DLAYGO,DQ,DR,RCRJFLAG,X,X1,X2,X3,Y
"RTN","RCXFMSUR",190,0)
;
"RTN","RCXFMSUR",191,0)
F D Q:$G(RCRJFLAG)
"RTN","RCXFMSUR",192,0)
. S (DIC,DIE)="^RC(347.3,",DIC(0)="QEL",DLAYGO=347.3
"RTN","RCXFMSUR",193,0)
. R !!,"Select REVENUE SOURCE CODE: ",X:DTIME
"RTN","RCXFMSUR",194,0)
. S X1=X,X=$$UPPER^VALM1(X)
"RTN","RCXFMSUR",195,0)
. I $E(X)="?",X?."?" D ^DIC Q:Y<1
"RTN","RCXFMSUR",196,0)
. I X=""!($E(X)=U) S RCRJFLAG=1 Q
"RTN","RCXFMSUR",197,0)
. I $D(^RC(347.3,"B",X)) S Y=+$O(^(X,0)) W " ",X," ",$P($G(^RC(347.3,Y,0)),U,2) W:$P(^(0),U,3) " INACTIVE" D UPD Q
"RTN","RCXFMSUR",198,0)
. S X2=$L(X1),X3=$C($A($E(X1,X2))-1),X3=$E(X1,1,X2-1)_X3,X3=$O(^RC(347.3,"C",X3)) I $E(X3,1,X2)=X1 S X=X1
"RTN","RCXFMSUR",199,0)
. S D="C" D IX^DIC Q:Y<1 D UPD Q
"RTN","RCXFMSUR",200,0)
Q
"RTN","RCXFMSUR",201,0)
UPD S DIE="^RC(347.3,",DA=+Y,DR=".02;.03" D ^DIE
"RTN","RCXFMSUR",202,0)
Q
"RTN","RCXFMSUR",203,0)
;
"RTN","RCXFMSUR",204,0)
;
"RTN","RCXFMSUR",205,0)
RSC ;revenue code (#430/255)
"RTN","RCXFMSUR",206,0)
I $P($G(^RC(347.3,X,0)),"^",3) D EN^DDIOL("THIS REVENUE SOURCE CODE IS INACTIVE.") K X Q
"RTN","RCXFMSUR",207,0)
S X=$P(^RC(347.3,X,0),"^")
"RTN","RCXFMSUR",208,0)
Q
"RTN","RCXFMSUR",209,0)
;
"RTN","RCXFMSUR",210,0)
SHOW ; show/calculate revenue source code for a selected bill
"RTN","RCXFMSUR",211,0)
W !!,"This option will show the calculated Revenue Source Code for a selected"
"RTN","RCXFMSUR",212,0)
W !,"bill. The Revenue Source Code is only calculated for accrued bills in"
"RTN","RCXFMSUR",213,0)
I DT'<$$ADDPTEDT^PRCAACC() W !,"funds 528701,528703,528704,528709/4032,528711,528713,528714"
"RTN","RCXFMSUR",214,0)
I DT<$$ADDPTEDT^PRCAACC() W !,"funds 5287.1,5287.3,5287.4,4032"
"RTN","RCXFMSUR",215,0)
;
"RTN","RCXFMSUR",216,0)
N %,%Y,BILLDA,C,DIC,FUND,I,RCRJFLAG,RSC,X,Y
"RTN","RCXFMSUR",217,0)
;
"RTN","RCXFMSUR",218,0)
F D Q:$G(RCRJFLAG)
"RTN","RCXFMSUR",219,0)
. S DIC="^PRCA(430,",DIC(0)="QEAM"
"RTN","RCXFMSUR",220,0)
. W ! D ^DIC
"RTN","RCXFMSUR",221,0)
. I Y<1 S RCRJFLAG=1 Q
"RTN","RCXFMSUR",222,0)
. S BILLDA=+Y
"RTN","RCXFMSUR",223,0)
. S FUND=$$GETFUNDB^RCXFMSUF(BILLDA,1)
"RTN","RCXFMSUR",224,0)
. W !!," Bill Number: ",$P($G(^PRCA(430,BILLDA,0)),"^")
"RTN","RCXFMSUR",225,0)
. W !," Fund: ",FUND
"RTN","RCXFMSUR",226,0)
. I '$$PTACCT^PRCAACC(FUND),FUND'=4032 D Q
"RTN","RCXFMSUR",227,0)
. . W !," The Revenue Source Code cannot be calculated for non-accrued bills."
"RTN","RCXFMSUR",228,0)
. . W !," The Revenue Source Code for non-accrued bills are input by the user."
"RTN","RCXFMSUR",229,0)
. . W !," The Revenue Source Code is currently entered as: "
"RTN","RCXFMSUR",230,0)
. . S RSC=$P($G(^PRCA(430,BILLDA,11)),"^",6)
"RTN","RCXFMSUR",231,0)
. . W $S(RSC="":"<not entered>",1:RSC)
"RTN","RCXFMSUR",232,0)
. ;
"RTN","RCXFMSUR",233,0)
. S RSC=$$CALCRSC(BILLDA)
"RTN","RCXFMSUR",234,0)
. W !,"Revenue Source Code: ",RSC
"RTN","RCXFMSUR",235,0)
Q
"RTN","RCXFMSUR",236,0)
;
"RTN","RCXFMSUR",237,0)
;Map the Revenue Source Codes to the new Community Care RSCs
"RTN","RCXFMSUR",238,0)
CCRSC(RCCAT,BILLDA) ;
"RTN","RCXFMSUR",239,0)
;
"RTN","RCXFMSUR",240,0)
N RCTYPE,RCCTNAME,RCRSC,RCRTNAME,IBCNDATA,LOOP,DATA,RSFD,RCSD,RCTD,RCOD,RCCARE,RCACODE
"RTN","RCXFMSUR",241,0)
;
"RTN","RCXFMSUR",242,0)
K RCMPARY
"RTN","RCXFMSUR",243,0)
S RCRSC=""
"RTN","RCXFMSUR",244,0)
;Load mapping array
"RTN","RCXFMSUR",245,0)
F LOOP=2:1:49 S DATA=$T(CCRSCMAP+LOOP) S RCMPARY($P(DATA,";",3),$P(DATA,";",4))=$P(DATA,";",5)
"RTN","RCXFMSUR",246,0)
; if this is a 1st party AR Category, find RSC Code and quit
"RTN","RCXFMSUR",247,0)
I (RCCAT>53),(RCCAT<58) S RCRSC=$$CCRSC1ST(RCCAT,BILLDA) Q RCRSC
"RTN","RCXFMSUR",248,0)
; otherwise, this is a 3rd party RSC category by.
"RTN","RCXFMSUR",249,0)
; Get the rate type from the bill
"RTN","RCXFMSUR",250,0)
D DIQ399(BILLDA)
"RTN","RCXFMSUR",251,0)
; Extracting the Rate Type Name from the Rate Type File using the Billing Number
"RTN","RCXFMSUR",252,0)
S RCRTNAME=$$GET1^DIQ(399.3,$G(IBCNDATA(399,BILLDA,.07,"I"))_",",.01)
"RTN","RCXFMSUR",253,0)
;
"RTN","RCXFMSUR",254,0)
; Use the Rate Type Name to determine a mapping code. Use that code to look up
"RTN","RCXFMSUR",255,0)
; RSC in the Mapping array
"RTN","RCXFMSUR",256,0)
;
"RTN","RCXFMSUR",257,0)
; First digit is based upon the first word in the name
"RTN","RCXFMSUR",258,0)
S RCFD=$S(RCRTNAME["CCN":1,RCRTNAME["CC":2,RCRTNAME["DOD":3,1:4)
"RTN","RCXFMSUR",259,0)
; Generate the Second digit (is "CHOICE in the name")
"RTN","RCXFMSUR",260,0)
S RCSD=$S(RCRTNAME["CHOICE":1,1:0)
"RTN","RCXFMSUR",261,0)
; Third digit contains one of these words
"RTN","RCXFMSUR",262,0)
S RCTD=$S(RCRTNAME["MTF":1,RCRTNAME["COMP":2,RCRTNAME["AUTO":3,RCRTNAME["TORT":4,RCRTNAME["REIMB":5,RCRTNAME["DISABILITY":6,RCRTNAME["SPINAL":7,RCRTNAME["BRAIN":8,RCRTNAME["BLIND":9,RCRTNAME["DENTAL":"A",1:"B")
"RTN","RCXFMSUR",263,0)
; Fourth digit - is it Inpatient, Outpatient, or another type of encounter
"RTN","RCXFMSUR",264,0)
S RCCARE=$$TYP^IBRFN(BILLDA)
"RTN","RCXFMSUR",265,0)
S RCOD=$S(RCCARE="I":1,RCCARE="O":2,1:0)
"RTN","RCXFMSUR",266,0)
;get the code
"RTN","RCXFMSUR",267,0)
S RCACODE=RCFD_RCSD_RCTD_RCOD
"RTN","RCXFMSUR",268,0)
S RCRSC=$G(RCMPARY("3RD",RCACODE))
"RTN","RCXFMSUR",269,0)
Q RCRSC
"RTN","RCXFMSUR",270,0)
;
"RTN","RCXFMSUR",271,0)
CCRSC1ST(RCCAT,BILLDA) ; Calculate the new 1st party RSC codes.
"RTN","RCXFMSUR",272,0)
N RCRSC,RCBILLNM,RCIBACT,RCACTNM,RCACTTYP,RCFD,RCSD,RCACODE
"RTN","RCXFMSUR",273,0)
;
"RTN","RCXFMSUR",274,0)
S RCRSC=""
"RTN","RCXFMSUR",275,0)
; Get the full Bill Number.
"RTN","RCXFMSUR",276,0)
S RCBILLNM=$$GET1^DIQ(430,BILLDA_",",.01)
"RTN","RCXFMSUR",277,0)
; Find the entry in the Integrated Billing Action File (#350) for the Bill Number sent in.
"RTN","RCXFMSUR",278,0)
S RCIBACT=$O(^IB("ABIL",RCBILLNM,"")) ;ERROR HANDLING?
"RTN","RCXFMSUR",279,0)
; Extract the action type from the Action File
"RTN","RCXFMSUR",280,0)
S RCACTTYP=$$GET1^DIQ(350,RCIBACT_",",.03)
"RTN","RCXFMSUR",281,0)
; Retrieve the Action Type Name from the IB Action Type file (#350.1)
"RTN","RCXFMSUR",282,0)
S RCACTNM=$$GET1^DIQ(350.1,RCACTTYP_",",.01)
"RTN","RCXFMSUR",283,0)
;
"RTN","RCXFMSUR",284,0)
; Use the Action Type Name to determine a mapping code. Use that code to look up
"RTN","RCXFMSUR",285,0)
; RSC in the Mapping array
"RTN","RCXFMSUR",286,0)
;
"RTN","RCXFMSUR",287,0)
;Generate the First Digit
"RTN","RCXFMSUR",288,0)
S RCFD=$S(RCACTNM["CC CHOICE":1,RCACTNM["CC MTF":2,RCACTNM["CCN":4,1:3)
"RTN","RCXFMSUR",289,0)
;Generate the Second digit
"RTN","RCXFMSUR",290,0)
S RCSD=$S(RCACTNM["(INPT)":1,RCACTNM["LTC":2,RCACTNM["(OPT)":3,RCACTNM["(RX)":3,RCACTNM["(PER DIEM)":1,1:0)
"RTN","RCXFMSUR",291,0)
;get the code
"RTN","RCXFMSUR",292,0)
S RCACODE=RCFD_RCSD
"RTN","RCXFMSUR",293,0)
Q
"RTN","RCXFMSUR",294,0)
;
"RTN","RCXFMSUR",295,0)
CCRSCMAP ; Calculated code to RSC mapping
"RTN","RCXFMSUR",296,0)
;;AR Category;Revenue Source Code
"RTN","RCXFMSUR",297,0)
;;AR Category;Revenue Source Code
"RTN","RCXFMSUR",298,0)
;;3RD;2130;84CC
"RTN","RCXFMSUR",299,0)
;;3RD;2151;81CC
"RTN","RCXFMSUR",300,0)
;;3RD;2152;82CC
"RTN","RCXFMSUR",301,0)
;;3RD;2150;83CC
"RTN","RCXFMSUR",302,0)
;;3RD;2140;85CC
"RTN","RCXFMSUR",303,0)
;;3RD;2120;86CC
"RTN","RCXFMSUR",304,0)
;;3RD;2030;8C4C
"RTN","RCXFMSUR",305,0)
;;3RD;2051;8C1C
"RTN","RCXFMSUR",306,0)
;;3RD;2052;8C2C
"RTN","RCXFMSUR",307,0)
;;3RD;2050;8C3C
"RTN","RCXFMSUR",308,0)
;;3RD;2040;8C5C
"RTN","RCXFMSUR",309,0)
;;3RD;2020;8C6C
"RTN","RCXFMSUR",310,0)
;;3RD;1130;8CN8
"RTN","RCXFMSUR",311,0)
;;3RD;1051;8CN5
"RTN","RCXFMSUR",312,0)
;;3RD;1052;8CN6
"RTN","RCXFMSUR",313,0)
;;3RD;1050;8CN7
"RTN","RCXFMSUR",314,0)
;;3RD;1140;8CN9
"RTN","RCXFMSUR",315,0)
;;3RD;1120;8CNW
"RTN","RCXFMSUR",316,0)
;;3RD;2011;8CD4
"RTN","RCXFMSUR",317,0)
;;3RD;2012;8CD5
"RTN","RCXFMSUR",318,0)
;;3RD;2010;8CD6
"RTN","RCXFMSUR",319,0)
;;3RD;3060;8085
"RTN","RCXFMSUR",320,0)
;;3RD;3071;8086
"RTN","RCXFMSUR",321,0)
;;3RD;3072;8087
"RTN","RCXFMSUR",322,0)
;;3RD;3070;8088
"RTN","RCXFMSUR",323,0)
;;3RD;3081;8089
"RTN","RCXFMSUR",324,0)
;;3RD;3082;8090
"RTN","RCXFMSUR",325,0)
;;3RD;3080;8091
"RTN","RCXFMSUR",326,0)
;;3RD;3091;8092
"RTN","RCXFMSUR",327,0)
;;3RD;3092;8093
"RTN","RCXFMSUR",328,0)
;;3RD;3090;8094
"RTN","RCXFMSUR",329,0)
;;3RD;40A0;8096
"RTN","RCXFMSUR",330,0)
;;3RD;40B0;8095
"RTN","RCXFMSUR",331,0)
;;1ST;11;8CC5
"RTN","RCXFMSUR",332,0)
;;1ST;12;8CC8
"RTN","RCXFMSUR",333,0)
;;1ST;13;8CC6
"RTN","RCXFMSUR",334,0)
;;1ST;14;8CC7
"RTN","RCXFMSUR",335,0)
;;1ST;21;8CD1
"RTN","RCXFMSUR",336,0)
;;1ST;23;8CD2
"RTN","RCXFMSUR",337,0)
;;1ST;24;8CD3
"RTN","RCXFMSUR",338,0)
;;1ST;31;8CC1
"RTN","RCXFMSUR",339,0)
;;1ST;32;8CC4
"RTN","RCXFMSUR",340,0)
;;1ST;33;8CC2
"RTN","RCXFMSUR",341,0)
;;1ST;34;8CC3
"RTN","RCXFMSUR",342,0)
;;1ST;41;8CN1
"RTN","RCXFMSUR",343,0)
;;1ST;42;8CN4
"RTN","RCXFMSUR",344,0)
;;1ST;43;8CN2
"RTN","RCXFMSUR",345,0)
;;1ST;44;8CN3
"RTN","RCXFMSUR",346,0)
;;END
"VER")
8.0^22.2
"^DD",430.2,430.2,1.01,0)
REFER TO DMC?^S^0:NO;1:YES;2:PRIOR TO 8/1/15;3:8/1/15 AND AFTER;^1;1^Q
"^DD",430.2,430.2,1.01,3)
Enter whether bills in this category should go to the DMC collections program
"^DD",430.2,430.2,1.01,21,0)
^^2^2^3180131^
"^DD",430.2,430.2,1.01,21,1,0)
The REFER TO DMC? prompt allows overdue bills to be sent to the Debt
"^DD",430.2,430.2,1.01,21,2,0)
Management Center for Collection.
"^DD",430.2,430.2,1.01,"DT")
3180131
"^DD",430.2,430.2,1.02,0)
REFER TO TOP?^S^0:NO;1:YES;2:PRIOR TO 8/1/15;3:8/1/15 AND AFTER;^1;2^Q
"^DD",430.2,430.2,1.02,3)
Enter whether bills with this category should go to the TOP program for collection.
"^DD",430.2,430.2,1.02,21,0)
^^2^2^3180131^
"^DD",430.2,430.2,1.02,21,1,0)
The REFER TO TOP? field allows overdue bills to be sent to the Treasury
"^DD",430.2,430.2,1.02,21,2,0)
Offset Program for collection.
"^DD",430.2,430.2,1.02,"DT")
3180131
"^DD",430.2,430.2,1.03,0)
REFER TO CS?^S^0:NO;1:YES;2:PRIOR TO 8/1/15;3:8/1/15 AND AFTER;^1;3^Q
"^DD",430.2,430.2,1.03,3)
Enter whether an overdue bill will be referred to the CS collections program.
"^DD",430.2,430.2,1.03,21,0)
^.001^2^2^3180209^^^
"^DD",430.2,430.2,1.03,21,1,0)
The REFER TO CS? field allows overdue bills to be sent to the Cross
"^DD",430.2,430.2,1.03,21,2,0)
Servicing (CS) program for collection.
"^DD",430.2,430.2,1.03,"DT")
3180207
**END**
**END**