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 Jul 05, 2019@09:50:11
BUILD 1 VERSION 2
**KIDS**:PRCA*4.5*357^

**INSTALL NAME**
PRCA*4.5*357
"BLD",11340,0)
PRCA*4.5*357^ACCOUNTS RECEIVABLE^0^3190705^y
"BLD",11340,4,0)
^9.64PA^^
"BLD",11340,6.3)
2
"BLD",11340,"KRN",0)
^9.67PA^1.5^24
"BLD",11340,"KRN",.4,0)
.4
"BLD",11340,"KRN",.401,0)
.401
"BLD",11340,"KRN",.402,0)
.402
"BLD",11340,"KRN",.403,0)
.403
"BLD",11340,"KRN",.5,0)
.5
"BLD",11340,"KRN",.84,0)
.84
"BLD",11340,"KRN",1.5,0)
1.5
"BLD",11340,"KRN",1.6,0)
1.6
"BLD",11340,"KRN",1.61,0)
1.61
"BLD",11340,"KRN",1.62,0)
1.62
"BLD",11340,"KRN",3.6,0)
3.6
"BLD",11340,"KRN",3.8,0)
3.8
"BLD",11340,"KRN",9.2,0)
9.2
"BLD",11340,"KRN",9.8,0)
9.8
"BLD",11340,"KRN",9.8,"NM",0)
^9.68A^5^5
"BLD",11340,"KRN",9.8,"NM",1,0)
RCRJRDEP^^0^B68618854
"BLD",11340,"KRN",9.8,"NM",2,0)
RCXFMSPR^^0^B59653951
"BLD",11340,"KRN",9.8,"NM",3,0)
PRCASVC1^^0^B1742212
"BLD",11340,"KRN",9.8,"NM",4,0)
PRCACPV^^0^B17492852
"BLD",11340,"KRN",9.8,"NM",5,0)
RCXFMSSV^^0^B72765558
"BLD",11340,"KRN",9.8,"NM","B","PRCACPV",4)

"BLD",11340,"KRN",9.8,"NM","B","PRCASVC1",3)

"BLD",11340,"KRN",9.8,"NM","B","RCRJRDEP",1)

"BLD",11340,"KRN",9.8,"NM","B","RCXFMSPR",2)

"BLD",11340,"KRN",9.8,"NM","B","RCXFMSSV",5)

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

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

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

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

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

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

"BLD",11340,"KRN","B",1.5,1.5)

"BLD",11340,"KRN","B",1.6,1.6)

"BLD",11340,"KRN","B",1.61,1.61)

"BLD",11340,"KRN","B",1.62,1.62)

"BLD",11340,"KRN","B",3.6,3.6)

"BLD",11340,"KRN","B",3.8,3.8)

"BLD",11340,"KRN","B",9.2,9.2)

"BLD",11340,"KRN","B",9.8,9.8)

"BLD",11340,"KRN","B",19,19)

"BLD",11340,"KRN","B",19.1,19.1)

"BLD",11340,"KRN","B",101,101)

"BLD",11340,"KRN","B",409.61,409.61)

"BLD",11340,"KRN","B",771,771)

"BLD",11340,"KRN","B",779.2,779.2)

"BLD",11340,"KRN","B",870,870)

"BLD",11340,"KRN","B",8989.51,8989.51)

"BLD",11340,"KRN","B",8989.52,8989.52)

"BLD",11340,"KRN","B",8994,8994)

"BLD",11340,"QDEF")
^^^^NO^^^^NO^^NO
"BLD",11340,"QUES",0)
^9.62^^
"BLD",11340,"REQB",0)
^9.611^1^1
"BLD",11340,"REQB",1,0)
PRCA*4.5*338^1
"BLD",11340,"REQB","B","PRCA*4.5*338",1)

"MBREQ")
0
"PKG",561,-1)
1^1
"PKG",561,0)
ACCOUNTS RECEIVABLE^PRCA^FMS
"PKG",561,22,0)
^9.49I^1^1
"PKG",561,22,1,0)
4.5^2950320^2950331
"PKG",561,22,1,"PAH",1,0)
357^3190705
"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")
NO
"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","PRCACPV")
0^4^B17492852
"RTN","PRCACPV",1,0)
PRCACPV ;WASH-ISC@ALTOONA,PA/LDB- CHAMPVA FMS DOCUMENTS ;5/1/95 3:06 PM
"RTN","PRCACPV",2,0)
V ;;4.5;Accounts Receivable;**1,48,90,119,204,192,235,295,315,338,357**;Mar 20, 1995;Build 2
"RTN","PRCACPV",3,0)
;;Per VA Directive 6402, this routine should not be modified.
"RTN","PRCACPV",4,0)
;
"RTN","PRCACPV",5,0)
;Add CAT=47:"INELIGIBLE REIMB. ins. code for PRCA*4.5*315
"RTN","PRCACPV",6,0)
EN(BILL,ERR) ;Send CHAMPVA SUBSISTENCE bill to FMS
"RTN","PRCACPV",7,0)
N ADD,ADDR,AMT,BILL0,BNUM,CAT,DA,DIE,DOC,DR,ERROR,ENT,FY,GECSFMS,I,P,PAT,SITE,TXT,VA,VAERR,VADM,X,XMDUZ,XMTEXT,XMY,XMSUB,Y
"RTN","PRCACPV",8,0)
S ERR=-1
"RTN","PRCACPV",9,0)
I '$G(BILL) S ERR="NO BILL NUMBER TO PROCESS" D ERR Q
"RTN","PRCACPV",10,0)
S BILL0=$G(^PRCA(430,+BILL,0)) I BILL0']"" S ERR="BILL INFO CORRUPTED FOR BILL '"_BILL D ERR Q
"RTN","PRCACPV",11,0)
;Allow all TRICARE categories to transmit to FMS - PRCA*4.5*295
"RTN","PRCACPV",12,0)
;Add ineligible reimb ins *315
"RTN","PRCACPV",13,0)
I "^27^28^30^31^32^47^80"'[("^"_$P(BILL0,"^",2)_"^") Q
"RTN","PRCACPV",14,0)
S SITE=$P($P(BILL0,"^"),"-") I SITE']"" S ERR="BILL NUMBER CORRUPTED" D ERR Q
"RTN","PRCACPV",15,0)
S BNUM=$P(BILL0,"^")
"RTN","PRCACPV",16,0)
S AMT=$J($P(BILL0,"^",3),0,2)
"RTN","PRCACPV",17,0)
S CAT=$P(BILL0,"^",2)
"RTN","PRCACPV",18,0)
I "^27^31^"[("^"_CAT_"^") S PAT=$P($G(^PRCA(430,+BILL,0)),"^",9),PAT=$P($G(^RCD(340,+PAT,0)),"^"),PAT=$$NAM^RCFN01(PAT),PAT=$P(PAT,",",2)_" "_$P(PAT,",")
"RTN","PRCACPV",19,0)
S FY=$$FY^RCFN01(DT)
"RTN","PRCACPV",20,0)
S ADD=$$SADD^RCFN01(5)
"RTN","PRCACPV",21,0)
;Add ineligible reimb ins *315
"RTN","PRCACPV",22,0)
S DESC=$S(CAT=27:"CHAMPVA Subsistence",CAT=30:"TRICARE",CAT=31:"TRICARE PATIENT",CAT=32:"TRICARE Third Party",CAT=47:"INELIGIBLE HOSP. REIMB.",CAT=80:"TRICARE PHARMACY",1:"CHAMPVA Third Party")
"RTN","PRCACPV",23,0)
F I=1:1:6 S ADDR(I)=$P(ADD,"^",I) I (I'=3),(ADDR(I)']"") S ERR="NO HOSPITAL ADDRESS FOUND FOR SITE GROUP" D ERR Q
"RTN","PRCACPV",24,0)
I ERR>0 Q
"RTN","PRCACPV",25,0)
;CALL TO GET VENDORID BELOW - CHECK NOT NECESSARY SINCE GENERIC
"RTN","PRCACPV",26,0)
;VENDOR CODE ALWAYS RETURNED FOR THESE BILL TYPES
"RTN","PRCACPV",27,0)
S VENDORID=$$VENDORID^RCXFMSUV(BILL)
"RTN","PRCACPV",28,0)
I ADDR(6)["-" S ADDR(7)=$P(ADDR(6),"-",2),ADDR(6)=$P(ADDR(6),"-")
"RTN","PRCACPV",29,0)
N FMSDT S FMSDT=$$FMSDATE^RCBEUTRA(DT)
"RTN","PRCACPV",30,0)
S ^TMP("PRCACPV",$J,1)="BD2^"_$E(FMSDT,4,5)_"^"_$E(FMSDT,6,7)_"^"_$E(FMSDT,2,3)
"RTN","PRCACPV",31,0)
S ^TMP("PRCACPV",$J,1)=^TMP("PRCACPV",$J,1)_"^^^^^^E^"_VENDORID_"^^"_AMT_"^^^^"_$E(ADDR(1),1,30)_"^"_$E(ADDR(2),1,30)_"^"_$E(ADDR(3),1,30)_"^"_$E(ADDR(4),1,19)_"^"_ADDR(5)_"^"_ADDR(6)_"^"_$G(ADDR(7))_"^"_"N^^^^^^W^~"
"RTN","PRCACPV",32,0)
;Add ineligible reimb ins *315
"RTN","PRCACPV",33,0)
S ^TMP("PRCACPV",$J,2)="LIN^~BDA^"_$$LINE^RCXFMSC1(BILL)_"^"_FY_"^^"_$S(CAT=28:"0160R1",CAT<30:"3220",CAT=47:"0160R1",1:"0160R1")_"^"_SITE_"^^^" ; patch PRCA*4.5*338
"RTN","PRCACPV",34,0)
S:CAT<30 CAT("R")=1000
"RTN","PRCACPV",35,0)
I CAT'<30 S CAT("R")=$P($G(^PRCA(430,+BILL,11)),U,6)
"RTN","PRCACPV",36,0)
;Add ineligible reimb ins *315
"RTN","PRCACPV",37,0)
S ^TMP("PRCACPV",$J,2)=^TMP("PRCACPV",$J,2)_CAT("R")_"^^^^^^^"_AMT_"^I^AR_INTERFACE^^^^"_$S(CAT<30:"09",CAT=47:"02",1:"02")_"^~"
"RTN","PRCACPV",38,0)
D CONTROL^GECSUFMS("A",SITE,BNUM,"BD",10,0,"",DESC)
"RTN","PRCACPV",39,0)
I '$D(GECSFMS("DA")) S ERR="COULD NOT ACCESS STACK FILE" D ERR Q
"RTN","PRCACPV",40,0)
S DOC=$S($G(GECSFMS("DOC"))]"":$P(GECSFMS("DOC"),"^",3)_"-"_$P(GECSFMS("DOC"),"^",4),1:BNUM)
"RTN","PRCACPV",41,0)
S DA=0 F S DA=$O(^TMP("PRCACPV",$J,DA)) Q:'DA D
"RTN","PRCACPV",42,0)
. D SETCS^GECSSTAA(GECSFMS("DA"),^TMP("PRCACPV",$J,DA))
"RTN","PRCACPV",43,0)
D OPEN^RCFMDRV1(DOC,6,"B"_+BILL,.ENT,.ERROR,+BILL)
"RTN","PRCACPV",44,0)
I ERROR]"" S ERR="AR DOCUMENT MISSING - "_ERROR Q
"RTN","PRCACPV",45,0)
D SETCODE^GECSSDCT(GECSFMS("DA"),"D RETN^RCFMFN02")
"RTN","PRCACPV",46,0)
D SETSTAT^GECSSTAA(GECSFMS("DA"),"Q")
"RTN","PRCACPV",47,0)
D SSTAT^RCFMFN02("B"_+BILL,1)
"RTN","PRCACPV",48,0)
K ^TMP("PRCACPV",$J)
"RTN","PRCACPV",49,0)
;
"RTN","PRCACPV",50,0)
ERR ;Add ineligible reimb ins *315
"RTN","PRCACPV",51,0)
I ERR'<0 S ERR="1^"_ERR D
"RTN","PRCACPV",52,0)
.S TXT(1)="The following error has occurred while processing a "_$S(CAT=31:"TRICARE PATIENT ",CAT=47:"INELIGIBLE REIMB. INS. PATIENT",1:"CHAMPVA")
"RTN","PRCACPV",53,0)
.S TXT(2)="bill: ("_$S($G(BNUM):BNUM,1:"BILL IFN - "_+BILL)_")"
"RTN","PRCACPV",54,0)
.S TXT(3)=" "
"RTN","PRCACPV",55,0)
.S TXT(4)=$P(ERR,"^",2)
"RTN","PRCACPV",56,0)
.S TXT(5)=""
"RTN","PRCACPV",57,0)
.S TXT(6)="You will need to use the BILLING DOCUMENT REGENERATION option to create the FMS document."
"RTN","PRCACPV",58,0)
.S XMTEXT="TXT(",XMY("G.PRCA ERROR")=""
"RTN","PRCACPV",59,0)
.S XMSUB=$S(CAT=31:"TRICARE PATIENT",CAT=30:"TRICARE",CAT=32:"TRICARE Third Party",CAT=47:"INELIGIBLE REIMB. INS. PATIENT",1:"CHAMPVA")_" FMS DOC error",XMDUZ="ACCOUNTS RECEIVABLE PACKAGE"
"RTN","PRCACPV",60,0)
.D ^XMD
"RTN","PRCACPV",61,0)
Q
"RTN","PRCASVC1")
0^3^B1742212
"RTN","PRCASVC1",1,0)
PRCASVC1 ;SF-ISC/YJK-ACCEPT, AMMEND AND CANCEL AR BILL ;5/1/95 3:05 PM
"RTN","PRCASVC1",2,0)
;;4.5;Accounts Receivable;**1,68,48,84,157,295,315,357**;Mar 20, 1995;Build 2
"RTN","PRCASVC1",3,0)
;;Per VA Directive 6402, this routine should not be modified.
"RTN","PRCASVC1",4,0)
Q
"RTN","PRCASVC1",5,0)
;
"RTN","PRCASVC1",6,0)
;
"RTN","PRCASVC1",7,0)
AMEND ; amend the bill in AR
"RTN","PRCASVC1",8,0)
D CANCEL
"RTN","PRCASVC1",9,0)
Q
"RTN","PRCASVC1",10,0)
;
"RTN","PRCASVC1",11,0)
;
"RTN","PRCASVC1",12,0)
CANCEL ; cancel the bill in AR
"RTN","PRCASVC1",13,0)
N X
"RTN","PRCASVC1",14,0)
S X=$$CANCEL^RCBEIB($G(PRCASV("ARREC")),$G(PRCASV("DATE")),$G(PRCASV("BY")),$G(PRCASV("AMT")),$G(PRCASV("COMMENT")))
"RTN","PRCASVC1",15,0)
Q
"RTN","PRCASVC1",16,0)
;
"RTN","PRCASVC1",17,0)
;
"RTN","PRCASVC1",18,0)
STATUS ;Change the current status of a bill
"RTN","PRCASVC1",19,0)
S DIE="^PRCA(430,",DA=PRCASV("ARREC"),DR="[PRCASV STATUS]" D ^DIE K DR,DIE
"RTN","PRCASVC1",20,0)
;Allow TRICARE categories to transmit to FMS automatically - PRCA*4.5*295
"RTN","PRCASVC1",21,0)
;Add INELIGIBLE HOSP. REIMB. - PRCA*4.5*315
"RTN","PRCASVC1",22,0)
I $D(^PRCA(430,+DA,0)),("^27^30^31^32^47^80^"[("^"_$P(^(0),"^",2)_"^")) D EN^PRCACPV(+DA) ;PRCA*4.5*357 - added TRICARE PHARMACY
"RTN","PRCASVC1",23,0)
K DA
"RTN","PRCASVC1",24,0)
Q
"RTN","RCRJRDEP")
0^1^B68618854
"RTN","RCRJRDEP",1,0)
RCRJRDEP ;WISC/RFJ-Deposit Reconciliation Report ;9/7/10 8:19am
"RTN","RCRJRDEP",2,0)
;;4.5;Accounts Receivable;**101,114,203,220,273,310,338,351**;Mar 20, 1995;Build 2
"RTN","RCRJRDEP",3,0)
;Per VA Directive 6402, this routine should not be modified.
"RTN","RCRJRDEP",4,0)
;
"RTN","RCRJRDEP",5,0)
W !!,"This option will print the Deposit Reconciliation Report. The report will"
"RTN","RCRJRDEP",6,0)
W !,"display the data on the code sheets sent to FMS on the CR document. Only"
"RTN","RCRJRDEP",7,0)
W !,"deposits processed after patch PRCA*4.5*90 was installed can be displayed."
"RTN","RCRJRDEP",8,0)
W !,"Select the starting and ending FMS Document Number without the station"
"RTN","RCRJRDEP",9,0)
W !,"number, example: K8A0346."
"RTN","RCRJRDEP",10,0)
;
"RTN","RCRJRDEP",11,0)
N DEFAULT,RCRJEND,RCRJFXIT,RCRJSTRT,RCRJSUMM,X
"RTN","RCRJRDEP",12,0)
N %,%H,%I,CATEGORY,CHAMPVA,DA,DEPOSDA,DOCTOTAL,FEE,FMSDOCID,FUND,FUNDTOTL,GECSDATA,IO,IOF
"RTN","RCRJRDEP",13,0)
;
"RTN","RCRJRDEP",14,0)
F D Q:$G(RCRJFXIT)
"RTN","RCRJRDEP",15,0)
. R !!,"START WITH CR DOCUMENT: FIRST// ",X:DTIME
"RTN","RCRJRDEP",16,0)
. I X["^" S RCRJFXIT=2 Q
"RTN","RCRJRDEP",17,0)
. I $L(X),$L(X)'=7 W !?5,"The CR DOCUMENT should be 7 characters in length (example: K8A0804)." Q
"RTN","RCRJRDEP",18,0)
. S RCRJSTRT=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
"RTN","RCRJRDEP",19,0)
. ;
"RTN","RCRJRDEP",20,0)
. S DEFAULT=$S(RCRJSTRT="":" LAST",1:RCRJSTRT)
"RTN","RCRJRDEP",21,0)
. W !," END WITH CR DOCUMENT: ",DEFAULT,"// " R X:DTIME
"RTN","RCRJRDEP",22,0)
. I X["^" S RCRJFXIT=2 Q
"RTN","RCRJRDEP",23,0)
. S RCRJEND=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
"RTN","RCRJRDEP",24,0)
. I X="LAST" S (RCRJEND,X)="zzzzzzz"
"RTN","RCRJRDEP",25,0)
. I $L(X),$L(X)'=7 W !?5,"The CR DOCUMENT should be 7 characters in length (example: K8A0804)." Q
"RTN","RCRJRDEP",26,0)
. I X="" S RCRJEND=$S(DEFAULT=" LAST":"zzzzzzz",1:DEFAULT)
"RTN","RCRJRDEP",27,0)
. I RCRJEND'=RCRJSTRT,RCRJEND']RCRJSTRT W !?5,"The END CR DOCUMENT should be after (in sequence) the start document." Q
"RTN","RCRJRDEP",28,0)
. S RCRJFXIT=1
"RTN","RCRJRDEP",29,0)
I RCRJFXIT=2 Q
"RTN","RCRJRDEP",30,0)
;
"RTN","RCRJRDEP",31,0)
S RCRJSUMM=$$SUMMARY^RCRJRTRA I 'RCRJSUMM Q
"RTN","RCRJRDEP",32,0)
;
"RTN","RCRJRDEP",33,0)
; select device
"RTN","RCRJRDEP",34,0)
W ! S %ZIS="Q" D ^%ZIS Q:POP
"RTN","RCRJRDEP",35,0)
I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK Q
"RTN","RCRJRDEP",36,0)
. S ZTDESC="Deposit Reconciliation Report",ZTRTN="DQ^RCRJRDEP"
"RTN","RCRJRDEP",37,0)
. S ZTSAVE("RCRJ*")="",ZTSAVE("ZTREQ")="@"
"RTN","RCRJRDEP",38,0)
W !!,"<*> please wait <*>"
"RTN","RCRJRDEP",39,0)
;
"RTN","RCRJRDEP",40,0)
DQ ; report (queue) starts here
"RTN","RCRJRDEP",41,0)
N %,%H,%I,CHAMPVA,DA,DEPOSDA,DIQ2,DOCTOTAL,FEE,FMSDOCID,FUND,FUNDTOTL,GECSDATA,LINEDA,LINEDATA,NOW,PAGE,RCDATA,RCRJLAST,RCRJLINE,RCRJFLAG,RECEIPDA,RSC,RSCTOTL,SCREEN,SITE,TOTAL,X,Y
"RTN","RCRJRDEP",42,0)
K ^TMP($J,"RCRJRDEP")
"RTN","RCRJRDEP",43,0)
;
"RTN","RCRJRDEP",44,0)
; build list of fms documents
"RTN","RCRJRDEP",45,0)
S SITE=$$SITE^RCMSITE
"RTN","RCRJRDEP",46,0)
S RCRJLAST="CR-"_SITE_RCRJEND_" "
"RTN","RCRJRDEP",47,0)
;
"RTN","RCRJRDEP",48,0)
; the fms document was previously stored in the deposit file 344.1
"RTN","RCRJRDEP",49,0)
; this code can be removed later on
"RTN","RCRJRDEP",50,0)
; this is the starting document, use 31 to start with select doc first
"RTN","RCRJRDEP",51,0)
S FMSDOCID="CR-"_SITE_RCRJSTRT_$C(31)
"RTN","RCRJRDEP",52,0)
F S FMSDOCID=$O(^RCY(344.1,"ADOC",FMSDOCID)) Q:FMSDOCID=""!(FMSDOCID]RCRJLAST) D
"RTN","RCRJRDEP",53,0)
. S DEPOSDA=+$O(^RCY(344.1,"ADOC",FMSDOCID,0))
"RTN","RCRJRDEP",54,0)
. ; compute deposit (all receipts) total for comparison
"RTN","RCRJRDEP",55,0)
. S TOTAL=0,CHAMPVA=0,FEE=0
"RTN","RCRJRDEP",56,0)
. S RECEIPDA=0 F S RECEIPDA=$O(^RCY(344,"AD",DEPOSDA,RECEIPDA)) Q:'RECEIPDA D
"RTN","RCRJRDEP",57,0)
. . S DA=0 F S DA=$O(^RCY(344,RECEIPDA,1,DA)) Q:'DA S TOTAL=TOTAL+$P(^(DA,0),"^",5)
"RTN","RCRJRDEP",58,0)
. . S CHAMPVA=CHAMPVA+$$CHAMPVA(RECEIPDA)
"RTN","RCRJRDEP",59,0)
. . S FEE=FEE+$$FEE(RECEIPDA)
"RTN","RCRJRDEP",60,0)
. ; tmp=deposit ^ depositda ^ depositdate ^ ^ ^ ^ deposittotal ^ champvatotal ^ feetotal
"RTN","RCRJRDEP",61,0)
. S ^TMP($J,"RCRJRDEP",FMSDOCID)=$P($G(^RCY(344.1,DEPOSDA,0)),"^")_"^"_DEPOSDA_"^"_$P($G(^RCY(344.1,DEPOSDA,0)),"^",9)_"^^^^"_TOTAL_"^"_CHAMPVA_"^"_FEE
"RTN","RCRJRDEP",62,0)
;
"RTN","RCRJRDEP",63,0)
; the fms document is now stored in the receipt file 344
"RTN","RCRJRDEP",64,0)
S FMSDOCID="CR-"_SITE_RCRJSTRT_$C(31)
"RTN","RCRJRDEP",65,0)
F S FMSDOCID=$O(^RCY(344,"ADOC",FMSDOCID)) Q:FMSDOCID=""!(FMSDOCID]RCRJLAST) D
"RTN","RCRJRDEP",66,0)
. S RECEIPDA=+$O(^RCY(344,"ADOC",FMSDOCID,0))
"RTN","RCRJRDEP",67,0)
. ; compute deposit (all receipts) total for comparison
"RTN","RCRJRDEP",68,0)
. S TOTAL=0
"RTN","RCRJRDEP",69,0)
. ; use the payment amount to pick up suspense deposits
"RTN","RCRJRDEP",70,0)
. S DA=0 F S DA=$O(^RCY(344,RECEIPDA,1,DA)) Q:'DA S TOTAL=TOTAL+$P(^(DA,0),"^",4)
"RTN","RCRJRDEP",71,0)
. S CHAMPVA=$$CHAMPVA(RECEIPDA)
"RTN","RCRJRDEP",72,0)
. S FEE=$$FEE(RECEIPDA)
"RTN","RCRJRDEP",73,0)
. S DEPOSDA=+$P($G(^RCY(344,RECEIPDA,0)),"^",6)
"RTN","RCRJRDEP",74,0)
. ; tmp=deposit ^ depositda ^ depositdate ^ receipt ^receiptda ^ receipt date ^ receipttotal ^ champvatotal ^ feetotal
"RTN","RCRJRDEP",75,0)
. S ^TMP($J,"RCRJRDEP",FMSDOCID)=$P($G(^RCY(344.1,DEPOSDA,0)),"^")_"^"_DEPOSDA_"^"_$P($G(^RCY(344.1,DEPOSDA,0)),"^",11)_"^"_$P($G(^RCY(344,RECEIPDA,0)),"^")_"^"_RECEIPDA_"^"_$P($G(^RCY(344,RECEIPDA,0)),"^",8)_"^"_TOTAL_"^"_CHAMPVA_"^"_FEE
"RTN","RCRJRDEP",76,0)
;
"RTN","RCRJRDEP",77,0)
; print report
"RTN","RCRJRDEP",78,0)
S SCREEN=0 I '$D(ZTQUEUED),IO=IO(0),$E(IOST)="C" S SCREEN=1
"RTN","RCRJRDEP",79,0)
S RCRJLINE="",$P(RCRJLINE,"-",81)=""
"RTN","RCRJRDEP",80,0)
D NOW^%DTC S Y=% D DD^%DT S NOW=Y,PAGE=1
"RTN","RCRJRDEP",81,0)
U IO I $G(RCRJSUMM)'=1 D H
"RTN","RCRJRDEP",82,0)
;
"RTN","RCRJRDEP",83,0)
S FMSDOCID="" F S FMSDOCID=$O(^TMP($J,"RCRJRDEP",FMSDOCID)) Q:FMSDOCID=""!($G(RCRJFLAG)) D
"RTN","RCRJRDEP",84,0)
. S RCDATA=^TMP($J,"RCRJRDEP",FMSDOCID)
"RTN","RCRJRDEP",85,0)
. K GECSDATA
"RTN","RCRJRDEP",86,0)
. D DATA^GECSSGET(FMSDOCID,1)
"RTN","RCRJRDEP",87,0)
. I $G(RCRJSUMM)'=1 D Q:$G(RCRJFLAG)
"RTN","RCRJRDEP",88,0)
. . I $Y>(IOSL-7) D:SCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H
"RTN","RCRJRDEP",89,0)
. . S Y=$P($P(RCDATA,"^",3),".") I Y D DD^%DT
"RTN","RCRJRDEP",90,0)
. . W !,"FMS DOCUMENT: ",FMSDOCID,?34,"DEPOSIT TICKET: ",$P(RCDATA,"^"),?62,"DATE: ",Y
"RTN","RCRJRDEP",91,0)
. . I $P(RCDATA,"^",4)'="" W !?41,"RECEIPT: ",$P(RCDATA,"^",4) S Y=$P($P(RCDATA,"^",6),".") I Y D DD^%DT W ?62,"DATE: ",Y
"RTN","RCRJRDEP",92,0)
. . D H1
"RTN","RCRJRDEP",93,0)
. S DOCTOTAL=0
"RTN","RCRJRDEP",94,0)
. I $D(GECSDATA) S LINEDA=0 F S LINEDA=$O(GECSDATA(2100.1,GECSDATA,10,LINEDA)) Q:'LINEDA!($G(RCRJFLAG)) D
"RTN","RCRJRDEP",95,0)
. . S LINEDATA=GECSDATA(2100.1,GECSDATA,10,LINEDA)
"RTN","RCRJRDEP",96,0)
. . I $E(LINEDATA,1,4)="CR2^" S DOCTOTAL=$P(LINEDATA,"^",15)
"RTN","RCRJRDEP",97,0)
. . I $E(LINEDATA,1,9)'="LIN^~CRA^" Q
"RTN","RCRJRDEP",98,0)
. . I $G(RCRJSUMM)'=1 D
"RTN","RCRJRDEP",99,0)
. . . I $Y>(IOSL-4) D:SCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H,H1
"RTN","RCRJRDEP",100,0)
. . . W !?1,$P(LINEDATA,"^",3),?6,$P(LINEDATA,"^",4),?11,$P(LINEDATA,"^",6),?19,$P(LINEDATA,"^",10)
"RTN","RCRJRDEP",101,0)
. . . W ?30,$J($P(LINEDATA,"^",18),8),?40,$E($P(LINEDATA,"^",25),4,10),?50,$J($P(LINEDATA,"^",20),10,2),?64,$J($P(LINEDATA,"^",23),9)
"RTN","RCRJRDEP",102,0)
. . ; totals by fund
"RTN","RCRJRDEP",103,0)
. . S FUND=$P(LINEDATA,"^",6)
"RTN","RCRJRDEP",104,0)
. . I FUND="" S FUND="0160"
"RTN","RCRJRDEP",105,0)
. . S FUNDTOTL(FUND)=$G(FUNDTOTL(FUND))+$P(LINEDATA,"^",20)
"RTN","RCRJRDEP",106,0)
. . ; totals by rsc for the accrued 5287 funds (01,03,04,09,11,13,14)
"RTN","RCRJRDEP",107,0)
. . S RSC=$P(LINEDATA,"^",10)
"RTN","RCRJRDEP",108,0)
. . I RSC'="",($$PTACCT^PRCAACC(FUND)!(FUND=4032)) S RSCTOTL(RSC)=$G(RSCTOTL(RSC))+$P(LINEDATA,"^",20)
"RTN","RCRJRDEP",109,0)
. I $G(RCRJSUMM)=1 Q
"RTN","RCRJRDEP",110,0)
. I $G(RCRJFLAG) Q
"RTN","RCRJRDEP",111,0)
. I $Y>(IOSL-6) D:SCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H
"RTN","RCRJRDEP",112,0)
. W !?23,"LINE TOTAL/DOCUMENT TOTAL: ",$J(DOCTOTAL,10,2)
"RTN","RCRJRDEP",113,0)
. ; compute receipt total for comparison
"RTN","RCRJRDEP",114,0)
. S TOTAL=$P(RCDATA,"^",7)
"RTN","RCRJRDEP",115,0)
. S CHAMPVA=$P(RCDATA,"^",8)
"RTN","RCRJRDEP",116,0)
. S FEE=$P(RCDATA,"^",9)
"RTN","RCRJRDEP",117,0)
. I CHAMPVA W !?35,"CHAMPVA TOTAL: ",$J(CHAMPVA,10,2)
"RTN","RCRJRDEP",118,0)
. I FEE W !?25,"NON-VA PORTION OF TOTAL: ",$J(FEE,10,2)
"RTN","RCRJRDEP",119,0)
. W !?35,"DEPOSIT TOTAL: ",$J(TOTAL,10,2)
"RTN","RCRJRDEP",120,0)
. ;I (DOCTOTAL+CHAMPVA+FEE)'=TOTAL W !," WARNING: TOTALS DO NOT MATCH, CHECK THE DEPOSIT: **********"
"RTN","RCRJRDEP",121,0)
. I (DOCTOTAL+CHAMPVA)'=TOTAL W !," WARNING: TOTALS DO NOT MATCH, CHECK THE DEPOSIT: **********"
"RTN","RCRJRDEP",122,0)
. W !
"RTN","RCRJRDEP",123,0)
;
"RTN","RCRJRDEP",124,0)
I $G(RCRJFLAG) D Q Q
"RTN","RCRJRDEP",125,0)
I $G(RCRJSUMM)'=1 D:SCREEN PAUSE^RCRJRTR1 I $G(RCRJFLAG) D Q Q
"RTN","RCRJRDEP",126,0)
D H
"RTN","RCRJRDEP",127,0)
; print totals by fund/rsc
"RTN","RCRJRDEP",128,0)
W !!,"TOTAL DEPOSITS BY FUND:"
"RTN","RCRJRDEP",129,0)
S FUND="" F S FUND=$O(FUNDTOTL(FUND)) Q:FUND=""!($G(RCRJFLAG)) D
"RTN","RCRJRDEP",130,0)
. I $Y>(IOSL-4) D:SCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H W !!,"TOTAL DEPOSITS BY FUND:"
"RTN","RCRJRDEP",131,0)
. W !?5,"FUND: ",FUND,?20,$J(FUNDTOTL(FUND),10,2)
"RTN","RCRJRDEP",132,0)
I $G(RCRJFLAG) D Q Q
"RTN","RCRJRDEP",133,0)
I DT<$$ADDPTEDT^PRCAACC() W !!,"TOTAL DEPOSITS BY REVENUE SOURCE CODE FOR THE SERIES OF FUNDS 5287.1,5287.3,5287.4:"
"RTN","RCRJRDEP",134,0)
I DT'<$$ADDPTEDT^PRCAACC() W !!,"TOTAL DEPOSITS BY REVENUE SOURCE CODE FOR THE SERIES OF FUNDS 528701,528703,528704,528711,528713,528714:"
"RTN","RCRJRDEP",135,0)
S RSC="" F S RSC=$O(RSCTOTL(RSC)) Q:RSC="" D Q:$G(RCRJFLAG)
"RTN","RCRJRDEP",136,0)
. I $Y>(IOSL-4) D:SCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H W !!,"TOTAL DEPOSITS BY REVENUE SOURCE CODE FOR THE SERIES OF ACCRUED 5287 FUNDS "_$S(DT<$$ADDPTEDT^PRCAACC():"(.1,.3,.4,.9):",1:"(01,03,04,09,11):")
"RTN","RCRJRDEP",137,0)
. W !?5,"RSC: ",RSC,?17,$$GETDESC^RCXFMSPR(RSC),?70,$J(RSCTOTL(RSC),10,2)
"RTN","RCRJRDEP",138,0)
I $G(RCRJFLAG) D Q Q
"RTN","RCRJRDEP",139,0)
I SCREEN R !,"Press RETURN to continue:",X:DTIME
"RTN","RCRJRDEP",140,0)
;
"RTN","RCRJRDEP",141,0)
Q D ^%ZISC
"RTN","RCRJRDEP",142,0)
K ^TMP($J,"RCRJRDEP")
"RTN","RCRJRDEP",143,0)
Q
"RTN","RCRJRDEP",144,0)
;
"RTN","RCRJRDEP",145,0)
;
"RTN","RCRJRDEP",146,0)
H ; report heading
"RTN","RCRJRDEP",147,0)
I PAGE'=1!(SCREEN) W @IOF
"RTN","RCRJRDEP",148,0)
S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1
"RTN","RCRJRDEP",149,0)
W $C(13),"DEPOSIT RECONCILIATION REPORT",?(80-$L(%)),%
"RTN","RCRJRDEP",150,0)
W !," START WITH DEPOSIT: ",$S(RCRJSTRT="":"**FIRST**",1:RCRJSTRT)," END WITH DEPOSIT: ",$S(RCRJEND="zzzzzzz":"**LAST**",1:RCRJEND),?65,$J("TYPE: "_$S(RCRJSUMM=1:"SUMMARY",1:"DETAILED"),15)
"RTN","RCRJRDEP",151,0)
W !,RCRJLINE
"RTN","RCRJRDEP",152,0)
Q
"RTN","RCRJRDEP",153,0)
;
"RTN","RCRJRDEP",154,0)
;
"RTN","RCRJRDEP",155,0)
H1 ; print line heading
"RTN","RCRJRDEP",156,0)
W !,"LINE",?5,"BFY",?11,"FUND",?20,"RSC",?30,"PROVIDER",?43,"BILL",?54,"AMOUNT",?64,"TRAN TYPE"
"RTN","RCRJRDEP",157,0)
Q
"RTN","RCRJRDEP",158,0)
;
"RTN","RCRJRDEP",159,0)
;
"RTN","RCRJRDEP",160,0)
CHAMPVA(RECEIPDA) ; return dollars for champva
"RTN","RCRJRDEP",161,0)
N %,CATEGORY,RECEIPT,TOTAL,TRAN3,TRANDA
"RTN","RCRJRDEP",162,0)
S RECEIPT=$P($G(^RCY(344,RECEIPDA,0)),"^")
"RTN","RCRJRDEP",163,0)
I RECEIPT="" Q 0
"RTN","RCRJRDEP",164,0)
;
"RTN","RCRJRDEP",165,0)
S TOTAL=0
"RTN","RCRJRDEP",166,0)
S TRANDA=0 F S TRANDA=$O(^PRCA(433,"AF",RECEIPT,TRANDA)) Q:'TRANDA D
"RTN","RCRJRDEP",167,0)
. S CATEGORY=$P($G(^PRCA(430,+$P($G(^PRCA(433,TRANDA,0)),"^",2),0)),"^",2)
"RTN","RCRJRDEP",168,0)
. I CATEGORY'=29 Q
"RTN","RCRJRDEP",169,0)
. S TRAN3=$G(^PRCA(433,TRANDA,3))
"RTN","RCRJRDEP",170,0)
. F %=1:1:5 S TOTAL=TOTAL+$P(TRAN3,"^",%)
"RTN","RCRJRDEP",171,0)
Q TOTAL
"RTN","RCRJRDEP",172,0)
;
"RTN","RCRJRDEP",173,0)
;
"RTN","RCRJRDEP",174,0)
FEE(RECEIPDA) ; return dollars for Fee Basis PRCA*4.5*310/DRF 12/9/2015
"RTN","RCRJRDEP",175,0)
N %,CATEGORY,RECEIPT,TOTAL,TRAN3,TRANDA
"RTN","RCRJRDEP",176,0)
S RECEIPT=$P($G(^RCY(344,RECEIPDA,0)),"^")
"RTN","RCRJRDEP",177,0)
I RECEIPT="" Q 0
"RTN","RCRJRDEP",178,0)
S TOTAL=0
"RTN","RCRJRDEP",179,0)
S TRANDA=0 F S TRANDA=$O(^PRCA(433,"AF",RECEIPT,TRANDA)) Q:'TRANDA D
"RTN","RCRJRDEP",180,0)
. S CATEGORY=$P($G(^PRCA(430,+$P($G(^PRCA(433,TRANDA,0)),"^",2),0)),"^",2)
"RTN","RCRJRDEP",181,0)
. I '$$CHKIEN(CATEGORY) Q ; verify category is Non-VA care (PRCA*4.5*338)
"RTN","RCRJRDEP",182,0)
. S TRAN3=$G(^PRCA(433,TRANDA,3))
"RTN","RCRJRDEP",183,0)
. F %=1:1:5 S TOTAL=TOTAL+$P(TRAN3,"^",%)
"RTN","RCRJRDEP",184,0)
Q TOTAL
"RTN","RCRJRDEP",185,0)
;
"RTN","RCRJRDEP",186,0)
CHKIEN(RCCAT) ; return true if AR CATEGORIES are Non-VA Care (PRCA*4.5*338)
"RTN","RCRJRDEP",187,0)
I RCCAT=45 Q 1
"RTN","RCRJRDEP",188,0)
;PRCA*4.5*351 - Added Community Care to Non-VA check
"RTN","RCRJRDEP",189,0)
I RCCAT>47&(RCCAT<75) Q 1
"RTN","RCRJRDEP",190,0)
I RCCAT>80&(RCCAT<85) Q 1
"RTN","RCRJRDEP",191,0)
Q 0
"RTN","RCXFMSPR")
0^2^B59653951
"RTN","RCXFMSPR",1,0)
RCXFMSPR ;WISC/RFJ-print revenue source codes ;8/31/10 11:34am
"RTN","RCXFMSPR",2,0)
;;4.5;Accounts Receivable;**90,96,101,156,170,203,273,310,315,338,351,357**;Mar 20, 1995;Build 2
"RTN","RCXFMSPR",3,0)
;Per VA Directive 6402, this routine should not be modified.
"RTN","RCXFMSPR",4,0)
W !,"This option will print out a list of the revenue source codes sent from"
"RTN","RCXFMSPR",5,0)
W !,"the VISTA system to FMS."
"RTN","RCXFMSPR",6,0)
;
"RTN","RCXFMSPR",7,0)
; select device
"RTN","RCXFMSPR",8,0)
W ! S %ZIS="Q" D ^%ZIS Q:POP
"RTN","RCXFMSPR",9,0)
I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK Q
"RTN","RCXFMSPR",10,0)
. S ZTDESC="Revenue Source Code Report",ZTRTN="DQ^RCXFMSPR"
"RTN","RCXFMSPR",11,0)
. S ZTSAVE("ZTREQ")="@"
"RTN","RCXFMSPR",12,0)
W !!,"<*> please wait <*>"
"RTN","RCXFMSPR",13,0)
;
"RTN","RCXFMSPR",14,0)
DQ ; queue starts here
"RTN","RCXFMSPR",15,0)
N %,%I,BINARY,COL2DESC,COL3DESC,COLUMN1,COLUMN2,COLUMN3,COLUMN4
"RTN","RCXFMSPR",16,0)
N DECIMAL,DESCRIP,NOW,PAGE,RCSTFLAG,SCREEN,X,Y
"RTN","RCXFMSPR",17,0)
D NOW^%DTC S Y=% D DD^%DT S NOW=Y
"RTN","RCXFMSPR",18,0)
S PAGE=1,SCREEN=0 I '$D(ZTQUEUED),IO=IO(0),$E(IOST)="C" S SCREEN=1
"RTN","RCXFMSPR",19,0)
U IO D H
"RTN","RCXFMSPR",20,0)
;
"RTN","RCXFMSPR",21,0)
S COLUMN1="A",COLUMN2="R",COLUMN3="R",COLUMN4="V",DESCRIP="Miscellaneous"
"RTN","RCXFMSPR",22,0)
D WRITEIT
"RTN","RCXFMSPR",23,0)
;
"RTN","RCXFMSPR",24,0)
; for now, column 1 is always 8 and column 4 is always Z
"RTN","RCXFMSPR",25,0)
S COLUMN1=8,COLUMN4="Z"
"RTN","RCXFMSPR",26,0)
F COLUMN2=1:1:9,"A","B","C","D","E","F","G","H","I","J","K","L","M","Q","R","S","T" D Q:$G(RCSTFLAG)
"RTN","RCXFMSPR",27,0)
. S COL2DESC=$P($T(@("A"_COLUMN2)),";",3)
"RTN","RCXFMSPR",28,0)
. ;
"RTN","RCXFMSPR",29,0)
. S COLUMN3=$S(COLUMN2=5:"*",1:"Z")
"RTN","RCXFMSPR",30,0)
. S DESCRIP=COL2DESC D WRITEIT
"RTN","RCXFMSPR",31,0)
. ;
"RTN","RCXFMSPR",32,0)
. I $G(RCSTFLAG) Q
"RTN","RCXFMSPR",33,0)
. ;
"RTN","RCXFMSPR",34,0)
. ; show hsif - disabled by patch 203
"RTN","RCXFMSPR",35,0)
. ;I COLUMN2="B"!(COLUMN2="C") S DESCRIP=DESCRIP_" HSIF",COLUMN3=1 D WRITEIT
"RTN","RCXFMSPR",36,0)
;
"RTN","RCXFMSPR",37,0)
I $G(RCSTFLAG) D Q Q
"RTN","RCXFMSPR",38,0)
;
"RTN","RCXFMSPR",39,0)
; print reimbursable health insurance rsc's
"RTN","RCXFMSPR",40,0)
S COLUMN2=5
"RTN","RCXFMSPR",41,0)
W !!?6,"For REIMBURSABLE HEALTH INSURANCE [85*Z]:"
"RTN","RCXFMSPR",42,0)
F DECIMAL=0:1:31 D Q:$G(RCSTFLAG)
"RTN","RCXFMSPR",43,0)
. I DECIMAL<10 S COLUMN3=DECIMAL
"RTN","RCXFMSPR",44,0)
. E S COLUMN3=$C(65+DECIMAL-10)
"RTN","RCXFMSPR",45,0)
. ;
"RTN","RCXFMSPR",46,0)
. ; convert decimal to binary (ex: 10011) so it can be
"RTN","RCXFMSPR",47,0)
. ; parsed in rsc to get the description
"RTN","RCXFMSPR",48,0)
. S BINARY=$$CONVERT(DECIMAL)
"RTN","RCXFMSPR",49,0)
. S COL3DESC=$P($T(@("B"_$E(BINARY,1,2))),";",3)
"RTN","RCXFMSPR",50,0)
. S COL3DESC=COL3DESC_", "_$P($T(@("C"_$E(BINARY,3))),";",3)
"RTN","RCXFMSPR",51,0)
. S COL3DESC=COL3DESC_", "_$P($T(@("D"_$E(BINARY,4))),";",3)
"RTN","RCXFMSPR",52,0)
. S COL3DESC=COL3DESC_", "_$P($T(@("E"_$E(BINARY,5))),";",3)
"RTN","RCXFMSPR",53,0)
. S DESCRIP=COL3DESC
"RTN","RCXFMSPR",54,0)
. D WRITEIT
"RTN","RCXFMSPR",55,0)
;
"RTN","RCXFMSPR",56,0)
; print fee basis reimbursable health insurance rsc's (PRCA*4.5*310/DRF)
"RTN","RCXFMSPR",57,0)
S COLUMN2="F"
"RTN","RCXFMSPR",58,0)
W !!?6,"For FEE REIMBURSABLE HEALTH INSURANCE [8F*Z]:"
"RTN","RCXFMSPR",59,0)
F DECIMAL=1:1:2 D Q:$G(RCSTFLAG)
"RTN","RCXFMSPR",60,0)
. S DESCRIP="FEE BASIS, NSC VET, MT CAT A, "_$S(DECIMAL=1:"INPATIENT",DECIMAL=2:"OUTPATIENT",1:"")
"RTN","RCXFMSPR",61,0)
. S COLUMN3=DECIMAL
"RTN","RCXFMSPR",62,0)
. D WRITEIT
"RTN","RCXFMSPR",63,0)
;
"RTN","RCXFMSPR",64,0)
; print EMERGENCY/HUMANITARIAN REIMB. PRCA*4.5*315
"RTN","RCXFMSPR",65,0)
; 8VZZ;HUMAN 3RD-PRTY OUTPATIENT
"RTN","RCXFMSPR",66,0)
; 8UZZ;HUMAN 3RD-PRTY INPATIENT
"RTN","RCXFMSPR",67,0)
S COLUMN3="Z"
"RTN","RCXFMSPR",68,0)
W !!?6,"For EMERGENCY/HUMANITARIAN REIMBURSABLE HEALTH INSURANCE [8*ZZ]:"
"RTN","RCXFMSPR",69,0)
F DECIMAL="U","V" D Q:$G(RCSTFLAG)
"RTN","RCXFMSPR",70,0)
. S DESCRIP="EMERGENCY/HUMANITARIAN REIMB. INS., "_$S(DECIMAL="U":"INPATIENT",DECIMAL="V":"OUTPATIENT",1:"")
"RTN","RCXFMSPR",71,0)
. S COLUMN2=DECIMAL
"RTN","RCXFMSPR",72,0)
. D WRITEIT
"RTN","RCXFMSPR",73,0)
;
"RTN","RCXFMSPR",74,0)
Q D ^%ZISC
"RTN","RCXFMSPR",75,0)
; print CCAD rsc's (PRCA*4.5*338)
"RTN","RCXFMSPR",76,0)
N DATA,LOOP
"RTN","RCXFMSPR",77,0)
S (COLUMN2,COLUMN3,COLUMN4)="" ;Clear other columns
"RTN","RCXFMSPR",78,0)
W !!?6,"For COMMUNITY CARE:"
"RTN","RCXFMSPR",79,0)
F LOOP=1:1 S DATA=$T(CCADRSC+LOOP) Q:(DATA="")!($P(DATA,";",3)="END") D Q:$G(RCSTFLAG)
"RTN","RCXFMSPR",80,0)
. S COLUMN1=$P(DATA,";",3),DESCRIP=$P(DATA,";",4)
"RTN","RCXFMSPR",81,0)
. D WRITEIT
"RTN","RCXFMSPR",82,0)
Q
"RTN","RCXFMSPR",83,0)
;
"RTN","RCXFMSPR",84,0)
;
"RTN","RCXFMSPR",85,0)
GETDESC(RSC) ; return the description for the revenue source code
"RTN","RCXFMSPR",86,0)
N BINARY,COL3DESC,COLUMN2,COLUMN3,DESC,RCARY
"RTN","RCXFMSPR",87,0)
;new resource codes for emergency/humanitarian reimb. PRCA*4.5*315
"RTN","RCXFMSPR",88,0)
I RSC="8UZZ" Q "Emergency/Humanitarian Reimb. Ins., Inpatient"
"RTN","RCXFMSPR",89,0)
I RSC="8VZZ" Q "Emergency/Humanitarian Reimb. Ins., Outpatient"
"RTN","RCXFMSPR",90,0)
I RSC="ARRV" Q "Miscellaneous"
"RTN","RCXFMSPR",91,0)
I RSC=8046 Q "Administrative"
"RTN","RCXFMSPR",92,0)
I RSC=8047 Q "Interest"
"RTN","RCXFMSPR",93,0)
I RSC=8048 Q "Marshal Fee and Court Cost"
"RTN","RCXFMSPR",94,0)
;PRCA*4.5*338 - check to see if RSC is a Community Care RSC and add RSCs missing a description.
"RTN","RCXFMSPR",95,0)
I RSC=8000 Q "Non Medical Reimbursements"
"RTN","RCXFMSPR",96,0)
I RSC=8023 Q "Compensated Work Therapy"
"RTN","RCXFMSPR",97,0)
I RSC=8024 Q "Tort Feasor"
"RTN","RCXFMSPR",98,0)
I RSC=8041 Q "FED OWCP"
"RTN","RCXFMSPR",99,0)
F LOOP=1:1 S DATA=$T(CCADRSC+LOOP) Q:(DATA="")!($P(DATA,";",3)="END") D
"RTN","RCXFMSPR",100,0)
. S RCARY($P(DATA,";",3))=$P(DATA,";",4)
"RTN","RCXFMSPR",101,0)
I $G(RCARY(RSC))'="" Q $G(RCARY(RSC))
"RTN","RCXFMSPR",102,0)
;end PRCA*4.5*338
"RTN","RCXFMSPR",103,0)
S DESC="UNKNOWN"
"RTN","RCXFMSPR",104,0)
S COLUMN2=$E(RSC,2)
"RTN","RCXFMSPR",105,0)
I "123456789ABCDEFGHIJKLMNQRST"[COLUMN2 S DESC=$P($T(@("A"_COLUMN2)),";",3) ;PRCA*4.5*357
"RTN","RCXFMSPR",106,0)
; HSIF reference disabled by patch 203
"RTN","RCXFMSPR",107,0)
; I RSC="8B1Z"!(RSC="8C1Z") S DESC=DESC_" (HSIF)"
"RTN","RCXFMSPR",108,0)
I COLUMN2'=5 Q DESC
"RTN","RCXFMSPR",109,0)
;
"RTN","RCXFMSPR",110,0)
S COLUMN3=$E(RSC,3)
"RTN","RCXFMSPR",111,0)
; convert alpha letters to decimal
"RTN","RCXFMSPR",112,0)
I "0123456789"'[COLUMN3 S COLUMN3=$A(COLUMN3)-55
"RTN","RCXFMSPR",113,0)
S BINARY=$$CONVERT(COLUMN3)
"RTN","RCXFMSPR",114,0)
S COL3DESC=$P($T(@("B"_$E(BINARY,1,2))),";",3)
"RTN","RCXFMSPR",115,0)
S COL3DESC=COL3DESC_", "_$P($T(@("C"_$E(BINARY,3))),";",3)
"RTN","RCXFMSPR",116,0)
S COL3DESC=COL3DESC_", "_$P($T(@("D"_$E(BINARY,4))),";",3)
"RTN","RCXFMSPR",117,0)
S COL3DESC=COL3DESC_", "_$P($T(@("E"_$E(BINARY,5))),";",3)
"RTN","RCXFMSPR",118,0)
Q "RHI, "_COL3DESC
"RTN","RCXFMSPR",119,0)
;
"RTN","RCXFMSPR",120,0)
;
"RTN","RCXFMSPR",121,0)
CONVERT(DECIMAL) ; convert decimal number to binary (5 digits)
"RTN","RCXFMSPR",122,0)
N Y
"RTN","RCXFMSPR",123,0)
S Y=""
"RTN","RCXFMSPR",124,0)
F S Y=$E("0123456789ABCDEF",DECIMAL#2+1)_Y,DECIMAL=DECIMAL\2 Q:DECIMAL<1
"RTN","RCXFMSPR",125,0)
S Y=$E("00000",0,5-$L(Y))_Y
"RTN","RCXFMSPR",126,0)
Q Y
"RTN","RCXFMSPR",127,0)
;
"RTN","RCXFMSPR",128,0)
;
"RTN","RCXFMSPR",129,0)
WRITEIT ; display the rsc
"RTN","RCXFMSPR",130,0)
W !,COLUMN1,COLUMN2,COLUMN3,COLUMN4,?6,DESCRIP
"RTN","RCXFMSPR",131,0)
I $Y>(IOSL-5) D:SCREEN PAUSE Q:$G(RCSTFLAG) D H
"RTN","RCXFMSPR",132,0)
Q
"RTN","RCXFMSPR",133,0)
;
"RTN","RCXFMSPR",134,0)
;
"RTN","RCXFMSPR",135,0)
PAUSE ; pause at end of page
"RTN","RCXFMSPR",136,0)
N X U IO(0) W !,"Press RETURN to continue, '^' to exit:" R X:DTIME S:'$T X="^" S:X["^" RCSTFLAG=1 U IO
"RTN","RCXFMSPR",137,0)
Q
"RTN","RCXFMSPR",138,0)
;
"RTN","RCXFMSPR",139,0)
;
"RTN","RCXFMSPR",140,0)
H ; header
"RTN","RCXFMSPR",141,0)
S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
"RTN","RCXFMSPR",142,0)
W $C(13),"REVENUE SOURCE CODE REPORT (VISTA TO FMS)",?(80-$L(%)),%
"RTN","RCXFMSPR",143,0)
W !,"RSC",?6,"Description"
"RTN","RCXFMSPR",144,0)
S %="",$P(%,"-",81)=""
"RTN","RCXFMSPR",145,0)
W !,%
"RTN","RCXFMSPR",146,0)
Q
"RTN","RCXFMSPR",147,0)
;
"RTN","RCXFMSPR",148,0)
;
"RTN","RCXFMSPR",149,0)
; this is a listing of all column2 values with a description
"RTN","RCXFMSPR",150,0)
A1 ;;Hospital Care (NSC)
"RTN","RCXFMSPR",151,0)
A2 ;;Outpatient Care (NSC)
"RTN","RCXFMSPR",152,0)
A3 ;;Nursing Home Care (NSC)
"RTN","RCXFMSPR",153,0)
A4 ;;Ineligible Hospitalization
"RTN","RCXFMSPR",154,0)
A5 ;;Reimbursable Health Insurance
"RTN","RCXFMSPR",155,0)
A6 ;;Tort Feasor
"RTN","RCXFMSPR",156,0)
A7 ;;Workmans Compensation (Non-Federal)
"RTN","RCXFMSPR",157,0)
A8 ;;C (Means Test)
"RTN","RCXFMSPR",158,0)
A9 ;;Emergency/Humanitarian
"RTN","RCXFMSPR",159,0)
AA ;;No Fault Auto Accident
"RTN","RCXFMSPR",160,0)
AB ;;Pharmacy Co-Pay (SC Vet)
"RTN","RCXFMSPR",161,0)
AC ;;Pharmacy Co-Pay (NSC Vet)
"RTN","RCXFMSPR",162,0)
AD ;;Nursing Home Care Per Diem
"RTN","RCXFMSPR",163,0)
AE ;;Hospital Care Per Diem
"RTN","RCXFMSPR",164,0)
AF ;;Medicare
"RTN","RCXFMSPR",165,0)
AG ;;Adult Day Health Care (LTC)
"RTN","RCXFMSPR",166,0)
AH ;;Domiciliary (LTC)
"RTN","RCXFMSPR",167,0)
AI ;;Respite Care-Institutional (LTC)
"RTN","RCXFMSPR",168,0)
AJ ;;Respite Care-Non-Institutional (LTC)
"RTN","RCXFMSPR",169,0)
AK ;;Geriatric Eval-Institutional (LTC)
"RTN","RCXFMSPR",170,0)
AL ;;Geriatric Eval-Non-Institutional (LTC)
"RTN","RCXFMSPR",171,0)
AM ;;Nursing Home Care-Long Term Care (LTC)
"RTN","RCXFMSPR",172,0)
AN ;;EDI 3RD PARTY LOCKBOX
"RTN","RCXFMSPR",173,0)
AQ ;;Pharmacy No Fault Auto Acc
"RTN","RCXFMSPR",174,0)
AR ;;Pharmacy Reimburs Health Ins
"RTN","RCXFMSPR",175,0)
AS ;;Pharmacy Tort Feasor
"RTN","RCXFMSPR",176,0)
AT ;;Pharmacy Workman's Comp
"RTN","RCXFMSPR",177,0)
;
"RTN","RCXFMSPR",178,0)
;
"RTN","RCXFMSPR",179,0)
; this is a listing for the type of care, first 2 binary digits
"RTN","RCXFMSPR",180,0)
; if column2 is reimbursable health insurance
"RTN","RCXFMSPR",181,0)
B00 ;;Inpatient (Hosp)
"RTN","RCXFMSPR",182,0)
B01 ;;Outpatient
"RTN","RCXFMSPR",183,0)
B10 ;;Nursing Home
"RTN","RCXFMSPR",184,0)
B11 ;;Other
"RTN","RCXFMSPR",185,0)
;
"RTN","RCXFMSPR",186,0)
;
"RTN","RCXFMSPR",187,0)
; this is a listing for the service connected, binary digit 3
"RTN","RCXFMSPR",188,0)
C0 ;;SC for NSC
"RTN","RCXFMSPR",189,0)
C1 ;;NSC Vet
"RTN","RCXFMSPR",190,0)
;
"RTN","RCXFMSPR",191,0)
;
"RTN","RCXFMSPR",192,0)
; this is a listing for means test, binary digit 4
"RTN","RCXFMSPR",193,0)
D0 ;;MT Cat A
"RTN","RCXFMSPR",194,0)
D1 ;;MT Cat C
"RTN","RCXFMSPR",195,0)
;
"RTN","RCXFMSPR",196,0)
;
"RTN","RCXFMSPR",197,0)
; this is a listing for age group, binary digit 5
"RTN","RCXFMSPR",198,0)
E0 ;;Age <65
"RTN","RCXFMSPR",199,0)
E1 ;;Age 65+
"RTN","RCXFMSPR",200,0)
;
"RTN","RCXFMSPR",201,0)
;
"RTN","RCXFMSPR",202,0)
; Community Care RSC listing PRCA*4.5*338
"RTN","RCXFMSPR",203,0)
CCADRSC ;;
"RTN","RCXFMSPR",204,0)
;;8C6C;CC 3rd-Pty Workers' Comp
"RTN","RCXFMSPR",205,0)
;;8C5C;CC 3rd-Pty Tort Feasor
"RTN","RCXFMSPR",206,0)
;;8C4C;CC 3rd-Pty No-Fault Auto
"RTN","RCXFMSPR",207,0)
;;8C1C;CC 3rd-Pty Inpatient
"RTN","RCXFMSPR",208,0)
;;8C2C;CC 3rd-Pty Outpatient
"RTN","RCXFMSPR",209,0)
;;8C3C;CC 3rd-Pty RX
"RTN","RCXFMSPR",210,0)
;;86CC;CC Choice 3rd-Pty Workers' Comp
"RTN","RCXFMSPR",211,0)
;;85CC;CC Choice 3rd-Pty Tort Feasor
"RTN","RCXFMSPR",212,0)
;;84CC;CC Choice 3rd-Pty No-Fault Auto
"RTN","RCXFMSPR",213,0)
;;81CC;CC Choice 3rd-Pty Inpatient
"RTN","RCXFMSPR",214,0)
;;82CC;CC Choice 3rd-Pty Outpatient
"RTN","RCXFMSPR",215,0)
;;83CC;CC Choice 3rd-Pty RX
"RTN","RCXFMSPR",216,0)
;;8CD4;CC DOD 3rd-Pty Inpatient
"RTN","RCXFMSPR",217,0)
;;8CD5;CC DOD 3rd-Pty Outpatient
"RTN","RCXFMSPR",218,0)
;;8CD6;CC DOD 3rd-Pty RX
"RTN","RCXFMSPR",219,0)
;;8CNW;CCN 3rd-Pty Workers' Comp
"RTN","RCXFMSPR",220,0)
;;8CN9;CCN 3rd-Pty Tort Feasor
"RTN","RCXFMSPR",221,0)
;;8CN8;CCN 3rd-Pty No-Fault Auto
"RTN","RCXFMSPR",222,0)
;;8CN5;CCN 3rd-Pty Inpatient
"RTN","RCXFMSPR",223,0)
;;8CN6;CCN 3rd-Pty Outpatient
"RTN","RCXFMSPR",224,0)
;;8CN7;CCN 3rd-Pty RX
"RTN","RCXFMSPR",225,0)
;;8CC1;CC 1st-Pty Inpatient
"RTN","RCXFMSPR",226,0)
;;8CC2;CC 1st-Pty Outpatient
"RTN","RCXFMSPR",227,0)
;;8CC3;CC 1st-Pty RX
"RTN","RCXFMSPR",228,0)
;;8CC4;CC 1st-Pty LTC
"RTN","RCXFMSPR",229,0)
;;8CC5;CC Choice 1st-Pty Inpatient
"RTN","RCXFMSPR",230,0)
;;8CC6;CC Choice 1st-Pty Outpatient
"RTN","RCXFMSPR",231,0)
;;8CC7;CC Choice 1st-Pty RX
"RTN","RCXFMSPR",232,0)
;;8CC8;CC Choice 1st-Pty LTC
"RTN","RCXFMSPR",233,0)
;;8CN1;CCN 1st-Pty Inpatient
"RTN","RCXFMSPR",234,0)
;;8CN2;CCN 1st-Pty Outpatient
"RTN","RCXFMSPR",235,0)
;;8CN3;CCN 1st-Pty RX
"RTN","RCXFMSPR",236,0)
;;8CN4;CCN 1st-Pty LTC
"RTN","RCXFMSPR",237,0)
;;8CD1;CC DOD 1st-Pty Inpatient
"RTN","RCXFMSPR",238,0)
;;8CD2;CC DOD 1st-Pty Outpatient
"RTN","RCXFMSPR",239,0)
;;8CD3;CC DOD 1st-Pty RX
"RTN","RCXFMSPR",240,0)
;;END
"RTN","RCXFMSSV")
0^5^B72765558
"RTN","RCXFMSSV",1,0)
RCXFMSSV ;WISC/RFJ-fms standard voucher (sv) code sheet generator ; 9/7/10 7:43am
"RTN","RCXFMSSV",2,0)
;;4.5;Accounts Receivable;**96,101,135,139,98,156,170,191,203,220,138,184,239,273,357**;Mar 20, 1995;Build 2
"RTN","RCXFMSSV",3,0)
;;Per VHA Directive 2004-038, this routine should not be modified.
"RTN","RCXFMSSV",4,0)
Q
"RTN","RCXFMSSV",5,0)
;
"RTN","RCXFMSSV",6,0)
;
"RTN","RCXFMSSV",7,0)
STARTSV(RCDATEND) ; top entry point to generate a sv code sheet
"RTN","RCXFMSSV",8,0)
;
"RTN","RCXFMSSV",9,0)
; rcdatend is the ending date of the period.
"RTN","RCXFMSSV",10,0)
; This date is the 3rd work day from the end of the month.
"RTN","RCXFMSSV",11,0)
; The utility $$LDATE^RCRJR is used to figure it out. It will
"RTN","RCXFMSSV",12,0)
; change from month to month and figures in holidays also.
"RTN","RCXFMSSV",13,0)
; For example, if running the ARDC for the month of June 2003
"RTN","RCXFMSSV",14,0)
; the EOAM will calculate out to be June 25, 2003.
"RTN","RCXFMSSV",15,0)
; This is called by the background monthly data collector
"RTN","RCXFMSSV",16,0)
;
"RTN","RCXFMSSV",17,0)
; data stored in tmp($j,rcrjrcolsv,type,fund,revsourcecode)
"RTN","RCXFMSSV",18,0)
; this is called by the background monthly data collector
"RTN","RCXFMSSV",19,0)
;
"RTN","RCXFMSSV",20,0)
N GECSDATA,RCTRANID,RESULT
"RTN","RCXFMSSV",21,0)
; lookup fms document number to see if the monthly sv has been sent
"RTN","RCXFMSSV",22,0)
; example rcdatend=3010531, lookup on 3010500
"RTN","RCXFMSSV",23,0)
D KEYLOOK^GECSSGET("SV-"_$E(RCDATEND,1,5)_"00",1)
"RTN","RCXFMSSV",24,0)
;
"RTN","RCXFMSSV",25,0)
; get the transacion id for the fms document
"RTN","RCXFMSSV",26,0)
; if it is not sent, get the next number available
"RTN","RCXFMSSV",27,0)
I $G(GECSDATA) S RCTRANID=$E($P(GECSDATA("2100.1",GECSDATA,".01","E"),"-",2),1,11)
"RTN","RCXFMSSV",28,0)
I $G(RCTRANID)="" S RCTRANID=$$ENUM^RCMSNUM
"RTN","RCXFMSSV",29,0)
I RCTRANID<0 Q ;unable to retrieve the next number
"RTN","RCXFMSSV",30,0)
; remove dash (example 460-K1A05HY)
"RTN","RCXFMSSV",31,0)
S RCTRANID=$TR(RCTRANID,"-")
"RTN","RCXFMSSV",32,0)
;
"RTN","RCXFMSSV",33,0)
; build and send the sv document to fms
"RTN","RCXFMSSV",34,0)
S RESULT=$$BUILDSV(RCDATEND,+$G(GECSDATA),RCTRANID,"00")
"RTN","RCXFMSSV",35,0)
; error in building code sheet
"RTN","RCXFMSSV",36,0)
I 'RESULT Q
"RTN","RCXFMSSV",37,0)
;
"RTN","RCXFMSSV",38,0)
; add/update entry in file 347 for reports
"RTN","RCXFMSSV",39,0)
N %DT,%X,D,D0,DA347,DI,DQ,DIC,ERROR
"RTN","RCXFMSSV",40,0)
S DA347=$O(^RC(347,"C",$P(RESULT,"^",2),0))
"RTN","RCXFMSSV",41,0)
; if not in the file, addit fmsdocid sv id
"RTN","RCXFMSSV",42,0)
I 'DA347 D OPEN^RCFMDRV1($P(RESULT,"^",2),4,"SV-"_$E(RCDATEND,1,5)_"00",.DA347,.ERROR)
"RTN","RCXFMSSV",43,0)
I DA347 D SSTAT^RCFMFN02($P(RESULT,"^",2),1)
"RTN","RCXFMSSV",44,0)
Q
"RTN","RCXFMSSV",45,0)
;
"RTN","RCXFMSSV",46,0)
;
"RTN","RCXFMSSV",47,0)
BUILDSV(RCDATEND,RCGECSDA,RCTRANID,RCKS) ; generate a wr code sheet for monthly data
"RTN","RCXFMSSV",48,0)
; rcgecsda is the ien for the gcs stack file 2100.1 for rebuilds
"RTN","RCXFMSSV",49,0)
; data stored in tmp($j,rcrjrcolsv)
"RTN","RCXFMSSV",50,0)
; rcks is the "key suffix" to distinguish the gecs lookup key
"RTN","RCXFMSSV",51,0)
; for the SRB SV from the lookup key for the BDR SV
"RTN","RCXFMSSV",52,0)
;
"RTN","RCXFMSSV",53,0)
N AMOUNT,COUNT,DESCRIP,DOCTOTAL,FISCALYR,FMSLINE,FUND,FY,GECSFMS,MONTH,REVDATE,REVFY,REVMONTH,RSC,SV2,TYPE,FMAMOUNT
"RTN","RCXFMSSV",54,0)
;
"RTN","RCXFMSSV",55,0)
S FISCALYR=$$FY^RCFN01(RCDATEND)
"RTN","RCXFMSSV",56,0)
;
"RTN","RCXFMSSV",57,0)
S COUNT=0,DOCTOTAL=0
"RTN","RCXFMSSV",58,0)
S TYPE="" F S TYPE=$O(^TMP($J,"RCRJRCOLSV",TYPE)) Q:TYPE="" D
"RTN","RCXFMSSV",59,0)
. S FUND="" F S FUND=$O(^TMP($J,"RCRJRCOLSV",TYPE,FUND)) Q:FUND="" D
"RTN","RCXFMSSV",60,0)
. . S RSC="" F S RSC=$O(^TMP($J,"RCRJRCOLSV",TYPE,FUND,RSC)) Q:RSC="" D
"RTN","RCXFMSSV",61,0)
. . . S AMOUNT=^TMP($J,"RCRJRCOLSV",TYPE,FUND,RSC),DOCTOTAL=DOCTOTAL+AMOUNT
"RTN","RCXFMSSV",62,0)
. . . I +AMOUNT=0 Q
"RTN","RCXFMSSV",63,0)
. . . S COUNT=COUNT+1
"RTN","RCXFMSSV",64,0)
. . . S FMSLINE(COUNT)="LIN^~SVA^"_$S($L(COUNT)=1:"00",$L(COUNT)=2:"0",1:"")_COUNT
"RTN","RCXFMSSV",65,0)
. . . S $P(FMSLINE(COUNT),"^",4)=TYPE
"RTN","RCXFMSSV",66,0)
. . . S $P(FMSLINE(COUNT),"^",5)=FISCALYR ;begin fy
"RTN","RCXFMSSV",67,0)
. . . I $E(FUND,1,4)=5287 S $P(FMSLINE(COUNT),"^",5)="05"
"RTN","RCXFMSSV",68,0)
. . . S $P(FMSLINE(COUNT),"^",7)=FUND
"RTN","RCXFMSSV",69,0)
. . . S $P(FMSLINE(COUNT),"^",9)=$E(RCTRANID,1,3) ;site number
"RTN","RCXFMSSV",70,0)
. . . ; for transaction types 23,27,2B the RSC is 0, send null
"RTN","RCXFMSSV",71,0)
. . . S $P(FMSLINE(COUNT),"^",14)=$S(RSC=0:"",1:RSC)
"RTN","RCXFMSSV",72,0)
. . . ;
"RTN","RCXFMSSV",73,0)
. . . ; vendor id
"RTN","RCXFMSSV",74,0)
. . . S $P(FMSLINE(COUNT),"^",18)="MCCFVALUE"
"RTN","RCXFMSSV",75,0)
. . . ; for transaction type P2, send vendorid of PERSONOTH
"RTN","RCXFMSSV",76,0)
. . . I TYPE="P2" S $P(FMSLINE(COUNT),"^",18)="PERSONOTH"
"RTN","RCXFMSSV",77,0)
. . . ; if it is hsif fund 5358.1, send vendorid of HSIFVALUE
"RTN","RCXFMSSV",78,0)
. . . I FUND=5358.1 S $P(FMSLINE(COUNT),"^",18)="HSIFVALUE"
"RTN","RCXFMSSV",79,0)
. . . ; if it is ltc fund 4032 or 528709, send vendorid of EXCFVALUE
"RTN","RCXFMSSV",80,0)
. . . I FUND=4032!(FUND=528709) D
"RTN","RCXFMSSV",81,0)
. . . . S $P(FMSLINE(COUNT),"^",18)="EXCFVALUE"
"RTN","RCXFMSSV",82,0)
. . . . S:FUND=4032 $P(FMSLINE(COUNT),"^",5)="03" ; FY
"RTN","RCXFMSSV",83,0)
. . . . S:$E(FUND,1,4)=5287 $P(FMSLINE(COUNT),"^",5)="05" ; FY
"RTN","RCXFMSSV",84,0)
. . . ;
"RTN","RCXFMSSV",85,0)
. . . ; send pos figure to FMS; neg amt requires a "D"
"RTN","RCXFMSSV",86,0)
. . . S FMAMOUNT=$S(AMOUNT<0:-AMOUNT,1:AMOUNT)
"RTN","RCXFMSSV",87,0)
. . . S $P(FMSLINE(COUNT),"^",19)="~SVB"
"RTN","RCXFMSSV",88,0)
. . . S $P(FMSLINE(COUNT),"^",20)=$J(FMAMOUNT,0,2)
"RTN","RCXFMSSV",89,0)
. . . S $P(FMSLINE(COUNT),"^",21)=$S(AMOUNT<0:"D",1:"I")
"RTN","RCXFMSSV",90,0)
. . . ; for transaction types 23,27,2B the RSC is 0, send G
"RTN","RCXFMSSV",91,0)
. . . S $P(FMSLINE(COUNT),"^",23)=$S(RSC=0:"G",1:"R")
"RTN","RCXFMSSV",92,0)
. . . S $P(FMSLINE(COUNT),"^",25)=$E(RCDATEND,2,3)
"RTN","RCXFMSSV",93,0)
. . . S $P(FMSLINE(COUNT),"^",26)=$E(RCDATEND,4,5)
"RTN","RCXFMSSV",94,0)
. . . S $P(FMSLINE(COUNT),"^",27)=$E(RCDATEND,6,7)
"RTN","RCXFMSSV",95,0)
. . . S $P(FMSLINE(COUNT),"^",28)="~"
"RTN","RCXFMSSV",96,0)
;
"RTN","RCXFMSSV",97,0)
; no code sheets to send
"RTN","RCXFMSSV",98,0)
I COUNT=0 Q "0^No sv code sheets to send for this month"
"RTN","RCXFMSSV",99,0)
;
"RTN","RCXFMSSV",100,0)
; calculate the accounting month and fy
"RTN","RCXFMSSV",101,0)
S FY=$E(RCDATEND,2,3) I $E(RCDATEND,4,5)>9 S FY=FY+1 I FY=100 S FY="00"
"RTN","RCXFMSSV",102,0)
I $L(FY)=1 S FY="0"_FY
"RTN","RCXFMSSV",103,0)
S MONTH=$P("04^05^06^07^08^09^10^11^12^01^02^03","^",$E(RCDATEND,4,5))
"RTN","RCXFMSSV",104,0)
; calculate the reversal month and fy (next month, add 1 day)
"RTN","RCXFMSSV",105,0)
S REVDATE=$$FMADD^XLFDT(RCDATEND,9)
"RTN","RCXFMSSV",106,0)
S REVFY=$E(REVDATE,2,3) I $E(REVDATE,4,5)>9 S REVFY=REVFY+1 I REVFY=100 S REVFY="00"
"RTN","RCXFMSSV",107,0)
I $L(REVFY)=1 S REVFY="0"_REVFY
"RTN","RCXFMSSV",108,0)
S REVMONTH=$P("04^05^06^07^08^09^10^11^12^01^02^03","^",$E(REVDATE,4,5))
"RTN","RCXFMSSV",109,0)
;
"RTN","RCXFMSSV",110,0)
S SV2="SV2^"_$E(RCDATEND,2,3)_"^"_$E(RCDATEND,4,5)_"^"_$E(RCDATEND,6,7)
"RTN","RCXFMSSV",111,0)
S $P(SV2,"^",5)=MONTH ;accounting period month
"RTN","RCXFMSSV",112,0)
S $P(SV2,"^",6)=FY ;accounting period year
"RTN","RCXFMSSV",113,0)
S $P(SV2,"^",7)="E"
"RTN","RCXFMSSV",114,0)
S $P(SV2,"^",12)=REVFY ;reversal period year
"RTN","RCXFMSSV",115,0)
S $P(SV2,"^",13)=REVMONTH ;reversal period month
"RTN","RCXFMSSV",116,0)
S:DOCTOTAL<0 DOCTOTAL=-DOCTOTAL ; document total must be positive
"RTN","RCXFMSSV",117,0)
S $P(SV2,"^",16)=$J(DOCTOTAL,0,2)_"^~"
"RTN","RCXFMSSV",118,0)
;
"RTN","RCXFMSSV",119,0)
; put together document in gcs
"RTN","RCXFMSSV",120,0)
N %DT,D0,DA,DI,DIC,DIE,DQ,DR,X,Y
"RTN","RCXFMSSV",121,0)
S Y=$E(RCDATEND,1,5)_"00" D DD^%DT
"RTN","RCXFMSSV",122,0)
S DESCRIP="Monthly Standard Voucher for "_Y
"RTN","RCXFMSSV",123,0)
I 'RCGECSDA D CONTROL^GECSUFMS("A",$E(RCTRANID,1,3),RCTRANID,"SV",10,0,"",DESCRIP)
"RTN","RCXFMSSV",124,0)
I RCGECSDA D REBUILD^GECSUFM1(RCGECSDA,"A",10,"","Rebuild "_DESCRIP) S GECSFMS("DA")=RCGECSDA
"RTN","RCXFMSSV",125,0)
;
"RTN","RCXFMSSV",126,0)
; store document in gcs
"RTN","RCXFMSSV",127,0)
D SETCS^GECSSTAA(GECSFMS("DA"),SV2)
"RTN","RCXFMSSV",128,0)
F COUNT=1:1 Q:'$D(FMSLINE(COUNT)) D SETCS^GECSSTAA(GECSFMS("DA"),FMSLINE(COUNT))
"RTN","RCXFMSSV",129,0)
D SETCODE^GECSSDCT(GECSFMS("DA"),"D RETN^RCFMFN02")
"RTN","RCXFMSSV",130,0)
D SETSTAT^GECSSTAA(GECSFMS("DA"),"Q")
"RTN","RCXFMSSV",131,0)
; set the key for lookup
"RTN","RCXFMSSV",132,0)
D SETKEY^GECSSTAA(GECSFMS("DA"),"SV-"_$E(RCDATEND,1,5)_RCKS)
"RTN","RCXFMSSV",133,0)
;
"RTN","RCXFMSSV",134,0)
; return 1 for success ^ fms document transaction number
"RTN","RCXFMSSV",135,0)
Q "1^SV-"_$P(GECSFMS("CTL"),"^",9)
"RTN","RCXFMSSV",136,0)
;
"RTN","RCXFMSSV",137,0)
;
"RTN","RCXFMSSV",138,0)
BADDEBT(RCRJDATE) ; top entry point to generate a sv code sheet
"RTN","RCXFMSSV",139,0)
; for the bad debt report, transaction types 23, 27, 2B and 2J.
"RTN","RCXFMSSV",140,0)
; The fms document number in file 347 is SV-$e(dateend,1,5)_"01"
"RTN","RCXFMSSV",141,0)
;
"RTN","RCXFMSSV",142,0)
; Input: RCRJDATE -- last day of accounting month
"RTN","RCXFMSSV",143,0)
;
"RTN","RCXFMSSV",144,0)
N DATA1319,DATA1338,DATA1339,DATA4032,DATAHSIF,GECSDATA,RESULT,RCRJFMM,RCRJFXSV,RCTRANID,X,RCNOHSIF,LTCFUND,DATA133M,DATA133T
"RTN","RCXFMSSV",145,0)
N DATA133N,DATA133Q,DATA133R,DATA133S
"RTN","RCXFMSSV",146,0)
;
"RTN","RCXFMSSV",147,0)
S RCNOHSIF=$$NOHSIF^RCRJRCO() ; disabled HSIF
"RTN","RCXFMSSV",148,0)
;
"RTN","RCXFMSSV",149,0)
; lock cannot fail
"RTN","RCXFMSSV",150,0)
L +^RC(348.1)
"RTN","RCXFMSSV",151,0)
;
"RTN","RCXFMSSV",152,0)
; get the data from the bad debt allowance file 348.1
"RTN","RCXFMSSV",153,0)
K ^TMP($J,"RCRJRCOLSV")
"RTN","RCXFMSSV",154,0)
S DATA1319=$G(^RC(348.1,+$O(^RC(348.1,"B",1319,0)),0))
"RTN","RCXFMSSV",155,0)
S DATA1338=$G(^RC(348.1,+$O(^RC(348.1,"B",1338,0)),0))
"RTN","RCXFMSSV",156,0)
S DATA1339=$G(^RC(348.1,+$O(^RC(348.1,"B",1339,0)),0))
"RTN","RCXFMSSV",157,0)
S DATA133N=$G(^RC(348.1,+$O(^RC(348.1,"B","133N",0)),0))
"RTN","RCXFMSSV",158,0)
I 'RCNOHSIF S DATAHSIF=$G(^RC(348.1,+$O(^RC(348.1,"B",1319.1,0)),0))
"RTN","RCXFMSSV",159,0)
S DATA4032=$G(^RC(348.1,+$O(^RC(348.1,"B",1319.2,0)),0))
"RTN","RCXFMSSV",160,0)
S DATA133M=$G(^RC(348.1,+$O(^RC(348.1,"B",1319.3,0)),0))
"RTN","RCXFMSSV",161,0)
S DATA133T=$G(^RC(348.1,+$O(^RC(348.1,"B",1319.4,0)),0))
"RTN","RCXFMSSV",162,0)
S DATA133Q=$G(^RC(348.1,+$O(^RC(348.1,"B",1319.5,0)),0))
"RTN","RCXFMSSV",163,0)
S DATA133R=$G(^RC(348.1,+$O(^RC(348.1,"B","133N.2",0)),0))
"RTN","RCXFMSSV",164,0)
S DATA133S=$G(^RC(348.1,+$O(^RC(348.1,"B",1338.2,0)),0))
"RTN","RCXFMSSV",165,0)
;
"RTN","RCXFMSSV",166,0)
;PRCA*4.5*357 - add missing SGLS to report
"RTN","RCXFMSSV",167,0)
S DATA13N3=$G(^RC(348.1,+$O(^RC(348.1,"B","133N.3",0)),0)) ;1339.N3
"RTN","RCXFMSSV",168,0)
S DATA1396=$G(^RC(348.1,+$O(^RC(348.1,"B",1319.6,0)),0)) ;1319.6
"RTN","RCXFMSSV",169,0)
S DATA1397=$G(^RC(348.1,+$O(^RC(348.1,"B",1319.7,0)),0)) ;1319.7
"RTN","RCXFMSSV",170,0)
S DATA1398=$G(^RC(348.1,+$O(^RC(348.1,"B",1319.8,0)),0)) ;1319.8
"RTN","RCXFMSSV",171,0)
S DATA1399=$G(^RC(348.1,+$O(^RC(348.1,"B",1319.9,0)),0)) ;1319.9
"RTN","RCXFMSSV",172,0)
S DATA1383=$G(^RC(348.1,+$O(^RC(348.1,"B",1338.3,0)),0)) ;1338.3
"RTN","RCXFMSSV",173,0)
S DATA1391=$G(^RC(348.1,+$O(^RC(348.1,"B",1339.1,0)),0)) ;1339.1
"RTN","RCXFMSSV",174,0)
;end PRCA*4.5*357
"RTN","RCXFMSSV",175,0)
;
"RTN","RCXFMSSV",176,0)
;
"RTN","RCXFMSSV",177,0)
; the revenue source code here is a 0
"RTN","RCXFMSSV",178,0)
;23
"RTN","RCXFMSSV",179,0)
S ^TMP($J,"RCRJRCOLSV","23",$$ADJFUND^RCRJRCO($S(DT<$$ADDPTEDT^PRCAACC():5287.3,1:528703)),0)=$P(DATA1319,"^",8)
"RTN","RCXFMSSV",180,0)
I 'RCNOHSIF S ^TMP($J,"RCRJRCOLSV","23",5358.1,0)=$P(DATAHSIF,"^",8)
"RTN","RCXFMSSV",181,0)
;patch 220 replaces 4032 fund with 528709
"RTN","RCXFMSSV",182,0)
S LTCFUND=$S(DT'<$$ADDPTEDT^PRCAACC():528709,1:4032)
"RTN","RCXFMSSV",183,0)
S ^TMP($J,"RCRJRCOLSV","23",LTCFUND,0)=$P(DATA4032,"^",8)
"RTN","RCXFMSSV",184,0)
S ^TMP($J,"RCRJRCOLSV","23",528701,0)=$P(DATA133M,"^",8)
"RTN","RCXFMSSV",185,0)
S ^TMP($J,"RCRJRCOLSV","23",528704,0)=$P(DATA133T,"^",8)
"RTN","RCXFMSSV",186,0)
S ^TMP($J,"RCRJRCOLSV","23",528711,0)=$P(DATA133Q,"^",8)
"RTN","RCXFMSSV",187,0)
S ^TMP($J,"RCRJRCOLSV","23",528713,0)=$P(DATA1396,"^",8)
"RTN","RCXFMSSV",188,0)
S ^TMP($J,"RCRJRCOLSV","23",528714,0)=$P(DATA1397,"^",8)+$P(DATA1398,"^",8)+$P(DATA1399,"^",8)
"RTN","RCXFMSSV",189,0)
;27
"RTN","RCXFMSSV",190,0)
S ^TMP($J,"RCRJRCOLSV","27",528713,0)=$P(DATA1391,"^",8)
"RTN","RCXFMSSV",191,0)
;2J
"RTN","RCXFMSSV",192,0)
S ^TMP($J,"RCRJRCOLSV","2J",528711,0)=$P(DATA133R,"^",8)
"RTN","RCXFMSSV",193,0)
S ^TMP($J,"RCRJRCOLSV","2J",528713,0)=$P(DATA13N3,"^",8)
"RTN","RCXFMSSV",194,0)
;2B
"RTN","RCXFMSSV",195,0)
S ^TMP($J,"RCRJRCOLSV","2B",528711,0)=$P(DATA133S,"^",8)
"RTN","RCXFMSSV",196,0)
S ^TMP($J,"RCRJRCOLSV","2B",528713,0)=$P(DATA1383,"^",8)
"RTN","RCXFMSSV",197,0)
;
"RTN","RCXFMSSV",198,0)
;Pre MRA funds
"RTN","RCXFMSSV",199,0)
S ^TMP($J,"RCRJRCOLSV","2B",$$ADJFUND^RCRJRCO($S(DT<$$ADDPTEDT^PRCAACC():5287.4,1:528704)),0)=$P(DATA1338,"^",8)
"RTN","RCXFMSSV",200,0)
S ^TMP($J,"RCRJRCOLSV","27",$$ADJFUND^RCRJRCO($S(DT<$$ADDPTEDT^PRCAACC():5287.4,1:528704)),0)=$P(DATA1339,"^",8)
"RTN","RCXFMSSV",201,0)
; post-MRA non-Medicare bills
"RTN","RCXFMSSV",202,0)
S ^TMP($J,"RCRJRCOLSV","2J",$$ADJFUND^RCRJRCO($S(DT<$$ADDPTEDT^PRCAACC():5287.4,1:528704)),0)=$P(DATA133N,"^",8)
"RTN","RCXFMSSV",203,0)
;
"RTN","RCXFMSSV",204,0)
; the date is for previous month
"RTN","RCXFMSSV",205,0)
;S RCRJDATE=$$PREVMONT^RCRJRBD(DT)
"RTN","RCXFMSSV",206,0)
;I $E(DT,6,7)<$E($$LDATE^RCRJR(DT),6,7) S RCRJDATE=$$PREVMONT^RCRJRBD(DT)
"RTN","RCXFMSSV",207,0)
;I $E(DT,6,7)>$E($$LDATE^RCRJR(DT),6,7) S RCRJDATE=$E($$LDATE^RCRJR(DT),1,5)_"00"
"RTN","RCXFMSSV",208,0)
;I $E(DT,6,7)>$E($$LDATE^RCRJR(DT),6,7) S RCRJDATE=$$LDATE^RCRJR(DT)
"RTN","RCXFMSSV",209,0)
; find the last day of the month for the end date
"RTN","RCXFMSSV",210,0)
;S RCRJDATE=$E(RCRJDATE,1,5)_$P("31^28^31^30^31^30^31^31^30^31^30^31","^",+$E(RCRJDATE,4,5))
"RTN","RCXFMSSV",211,0)
;I $E(RCRJDATE,6,7)=28,$E(RCRJDATE,2,3)#4=0 S RCRJDATE=$E(RCRJDATE,1,5)_"29"
"RTN","RCXFMSSV",212,0)
;
"RTN","RCXFMSSV",213,0)
; lookup fms document number to see if the monthly sv has been sent
"RTN","RCXFMSSV",214,0)
; example rcdatend=3010531, lookup on 3010501
"RTN","RCXFMSSV",215,0)
D KEYLOOK^GECSSGET("SV-"_$E(RCRJDATE,1,5)_"01",1)
"RTN","RCXFMSSV",216,0)
;
"RTN","RCXFMSSV",217,0)
; get the transacion id for the fms document
"RTN","RCXFMSSV",218,0)
; if it is not sent, get the next number available
"RTN","RCXFMSSV",219,0)
I $G(GECSDATA) S RCTRANID=$E($P(GECSDATA("2100.1",GECSDATA,".01","E"),"-",2),1,11)
"RTN","RCXFMSSV",220,0)
I $G(RCTRANID)="" S RCTRANID=$$ENUM^RCMSNUM
"RTN","RCXFMSSV",221,0)
I RCTRANID<0 Q ;unable to retrieve the next number
"RTN","RCXFMSSV",222,0)
; remove dash (example 460-K1A05HY)
"RTN","RCXFMSSV",223,0)
S RCTRANID=$TR(RCTRANID,"-")
"RTN","RCXFMSSV",224,0)
;
"RTN","RCXFMSSV",225,0)
; build and send the sv document to fms
"RTN","RCXFMSSV",226,0)
S RESULT=$$BUILDSV(RCRJDATE,+$G(GECSDATA),RCTRANID,"01")
"RTN","RCXFMSSV",227,0)
K ^TMP($J,"RCRJRCOLSV")
"RTN","RCXFMSSV",228,0)
; error in building code sheet
"RTN","RCXFMSSV",229,0)
I 'RESULT D Q Q
"RTN","RCXFMSSV",230,0)
;
"RTN","RCXFMSSV",231,0)
; add/update entry in file 347 for reports
"RTN","RCXFMSSV",232,0)
N %DT,%X,D,D0,DA347,DI,DQ,DIC,ERROR
"RTN","RCXFMSSV",233,0)
S DA347=$O(^RC(347,"D","SV-"_$E(RCRJDATE,1,5)_"01",0))
"RTN","RCXFMSSV",234,0)
; if not in the file, addit fmsdocid sv id
"RTN","RCXFMSSV",235,0)
I 'DA347 D OPEN^RCFMDRV1($P(RESULT,"^",2),4,"SV-"_$E(RCRJDATE,1,5)_"01",.DA347,.ERROR)
"RTN","RCXFMSSV",236,0)
I DA347 D SSTAT^RCFMFN02($P(RESULT,"^",2),1)
"RTN","RCXFMSSV",237,0)
;
"RTN","RCXFMSSV",238,0)
Q ; jump here to finish
"RTN","RCXFMSSV",239,0)
; generate bad debt report
"RTN","RCXFMSSV",240,0)
S RCRJFXSV=$P(RESULT,"^",2),RCRJFMM=1 D DQ^RCRJRBDR
"RTN","RCXFMSSV",241,0)
L -^RC(348.1)
"RTN","RCXFMSSV",242,0)
Q
"VER")
8.0^22.2
**END**
**END**