source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCABJV.m

Last change on this file was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 5.2 KB
Line 
1PRCABJV ;WASH-ISC@ALTOONA,PA/TJK-FILE VERIFICATION FOR BACKGROUND JOB ;4/6/95 10:13 AM
2V ;;4.5;Accounts Receivable;**1,48,63,114,141,170,176,173,192,220**;Mar 20, 1995
3 ;;patch 192 changes all occurrences of CHAMPUS to TRICARE
4 ;;Per VHA Directive 10-93-142, this routine should not be modified.
5EN1(FILE,X1,X2,ERROR) ;
6 ;FILE IS THE FILE NUMBER
7 ;X1 AND X2 ARE 3 PART VARIABLES SEPARATED BY SEMI-COLONS WITH
8 ;THE FORMAT (X-REF INDEX;NODE;PIECE)
9 ;AN ERROR ARRAY IS SET IF VALIDATION FAILS
10 NEW LT,CNT,I,I1,I2,I3,REC,IND,ND,PC,DATA,J,LN,FILENT
11 S LT=$S(FILE[430.3:"TRANST",FILE[430.2:"CAT",1:"EVENT"),CNT=0
12 F I=1,2 S J=@("X"_I),IND(I)=$P(J,";"),ND(I)=$P(J,";",2),PC(I)=$P(J,";",3)
13 F I1=1:1 D Q:(DATA(0)="EOF")!(ERROR)
14 .S LN=$T(@LT+I1) F I=3:1:6 S DATA(I-3)=$P(LN,";",I)
15 .Q:DATA(0)="EOF"
16 .G RC:FILE<430
17 .I '$D(^PRCA(FILE,"B",DATA(0))) S ERROR=1 Q
18 .S REC=$O(^PRCA(FILE,"B",DATA(0),0)) I 'REC S ERROR=1 Q
19 .I DATA(3)'=REC S ERROR=1 Q
20 .I $P(^PRCA(FILE,REC,0),U)'=DATA(0) S ERROR=1 Q
21 .G CNT:X1=""
22 .F I2=1,2 D Q:ERROR I I2=1,X2="" Q
23 ..I '$D(^PRCA(FILE,IND(I2),DATA(I2))) S ERROR=1 G Q2
24 ..; do not check if category number is a zero
25 ..I I2=1,DATA(1)'=0,$O(^PRCA(FILE,IND(I2),DATA(I2),0))'=REC S ERROR=1 G Q2
26 ..I $P(^PRCA(FILE,REC,ND(I2)),U,PC(I2))'=DATA(I2) S ERROR=1
27Q2 ..Q
28CNT .Q:ERROR
29 .S CNT=CNT+1
30Q1 .Q
31RC .I '$D(^RC(FILE,"B",DATA(0))) S ERROR=1 Q
32 .S REC=$O(^RC(FILE,"B",DATA(0),0)) I 'REC S ERROR=1 Q
33 .I DATA(3)'=REC S ERROR=1 Q
34 .I $P(^RC(FILE,REC,0),U)'=DATA(0) S ERROR=1 Q
35 .G CNT:X1=""
36 .F I3=1,2 D Q:ERROR I I3=1,X2="" Q
37 ..I '$D(^RC(FILE,IND(I3),DATA(I3))) S ERROR=1 G Q3
38 ..I $O(^RC(FILE,IND(I3),DATA(I3),0))'=REC S ERROR=1 G Q3
39 ..I $P(^RC(FILE,REC,ND(I3)),U,PC(I3))'=DATA(I3) S ERROR=1
40Q3 ..Q
41 .G CNT
42 I FILE>429.99,$P(^PRCA(FILE,0),U,4)'=CNT S ERROR=1 G EXIT
43 G EXIT:FILE>429.99
44 I $P(^RC(FILE,0),U,4)'=CNT S ERROR=1
45EXIT Q:'ERROR
46 S FILENT=$S(FILE>429.99:$P(^PRCA(FILE,0),U,4),1:$P(^RC(FILE,0),U,4))
47 S ERROR(1)="An error has been detected in the "_$P(^DIC(FILE,0),U)_" File."
48 I DATA(0)="EOF" S ERROR(2)="There are too many entries in your file."
49 I DATA(0)'="EOF" S ERROR(2)="The "_DATA(0)_" Entry in your file is missing or corrupted."
50 Q
51TRANST ;
52 ;;ACTIVE;102;A;16
53 ;;ADD (AMEND);302;AD;37
54 ;;ADMIN.COST CHARGE;12;AC;12
55 ;;AMEND;303;AM;38
56 ;;AMENDED BILL;110;AB;33
57 ;;ARCHIVED;115;XX;49
58 ;;BILL INCOMPLETE;201;BI;27
59 ;;CANCELLATION;111;CN;39
60 ;;CANCELLED BILL;210;CB;26
61 ;;CASH COLLECTION BY RC/DOJ;7;CJ;7
62 ;;CHARGE SUSPENDED;19;CS;47
63 ;;COLLECTED/CLOSED;108;CC;22
64 ;;COMMENT;17;CM;45
65 ;;DEBIT VOUCHER (SF 5515);30;DV;30
66 ;;DECREASE ADJUSTMENT;21;DA;35
67 ;;DELETE (AMEND);301;DL;36
68 ;;EXEMPT INT/ADM. COST;14;E;14
69 ;;IN-ACTIVE;103;IA;17
70 ;;INCOMPLETE;101;IN;15
71 ;;INCREASE ADJUSTMENT;1;AJ;1
72 ;;INTEREST/ADM. CHARGE;13;IC;13
73 ;;MARSHAL/COURT COST;15;ML;24
74 ;;NEW BILL;104;N;18
75 ;;OLD BILL;106;OB;28
76 ;;OPEN;112;OP;42
77 ;;PAYMENT (IN FULL);20;PF;34
78 ;;PAYMENT (IN PART);2;PP;2
79 ;;PENDING APPROVAL;205;PA;20
80 ;;PENDING ARCHIVE;114;X;48
81 ;;PENDING CALM CODE;107;PC;21
82 ;;RE-ESTABLISH;250;RW;43
83 ;;REESTABLISH TO RC/DOJ;5;RR;5
84 ;;REFER TO RC;3;RC;3
85 ;;REFER TO DOJ;4;RJ;4
86 ;;REFUND REVIEW;113;PR;44
87 ;;REFUNDED;120;RF;41
88 ;;REPAYMENT PLAN;16;RP;25
89 ;;RETURNED BY RC/DOJ;6;RD;6
90 ;;RETURNED FOR AMENDMENT;230;RA;32
91 ;;RETURNED FROM AR (NEW);220;RT;31
92 ;;SUSPENDED;240;SP;40
93 ;;SUSPENSE;105;S;19
94 ;;TERM.BY COMPROMISE;9;TC;9
95 ;;TERM.BY RC/DOJ;29;TJ;29
96 ;;TERM.BY FIS.OFFICER;8;TO;8
97 ;;UNSUSPENDED;18;US;46
98 ;;WAIVED IN FULL;10;WF;10
99 ;;WAIVED IN PART;11;WP;11
100 ;;WRITE-OFF;109;WO;23
101 ;;EOF
102CAT ;patch 192 - ISC-0502-N2803 change Champus to Tricare
103 ;;ADULT DAY HEALTH CARE;40;AD;33
104 ;;C (MEANS TEST);24;C;18
105 ;;TRICARE;37;T1;30
106 ;;TRICARE PATIENT;38;T2;31
107 ;;TRICARE THIRD PARTY;39;T3;32
108 ;;CHAMPVA;36;CV;29
109 ;;CHAMPVA SUBSISTENCE;34;CS;27
110 ;;CHAMPVA THIRD PARTY;35;CT;28
111 ;;COMP & PEN PROCEEDS;8;CM;43
112 ;;CRIME OF PER.VIO.;27;CP;8
113 ;;CURRENT EMP.;14;CE;16
114 ;;CWT PROCEEDS;7;CW;42
115 ;;DOMICILIARY;41;DO;34
116 ;;EMERGENCY/HUMANITARIAN;25;H;2
117 ;;ENHANCED USE LEASE PROCEEDS;10;EP;44
118 ;;EX-EMPLOYEE;13;E;15
119 ;;FEDERAL AGENCIES-REFUND;15;F2;13
120 ;;FEDERAL AGENCIES-REIMB.;16;F1;14
121 ;;GERIATRIC EVAL-INSTITUTIONAL;44;GE;37
122 ;;GERIATRIC EVAL-NON-INSTITUTION;45;GN;38
123 ;;HOSPITAL CARE (NSC);1;HC;5
124 ;;HOSPITAL CARE PER DIEM;32;HP;25
125 ;;INELIGIBLE HOSP.;20;I;1
126 ;;INTERAGENCY;19;IA;20
127 ;;MEDICARE;28;MC;21
128 ;;MILITARY;17;M;12
129 ;;NO-FAULT AUTO ACC.;26;NA;7
130 ;;NURSING HOME CARE PER DIEM;31;NP;24
131 ;;NURSING HOME CARE(NSC);3;NC;3
132 ;;NURSING HOME CARE-LTC;46;NL;39
133 ;;NURSING HOME PROCEEDS;5;NH;40
134 ;;OUTPATIENT CARE(NSC);2;OC;4
135 ;;PARKING FEES;6;PF;41
136 ;;PREPAYMENT;33;PP;26
137 ;;REIMBURS.HEALTH INS.;21;RI;9
138 ;;RESPITE CARE-INSTITUTIONAL;42;RC;35
139 ;;RESPITE CARE-NON-INSTITUTIONAL;43;RN;36
140 ;;RX CO-PAYMENT/NSC VET;30;PN;23
141 ;;RX CO-PAYMENT/SC VET;29;PS;22
142 ;;SHARING AGREEMENTS;18;SA;19
143 ;;TORT FEASOR;22;TF;10
144 ;;VENDOR;11;V;17
145 ;;WORKMAN'S COMP.;23;WC;6
146 ;;EOF
147EVENT ;
148 ;;CASH PAYMENT;6;;6
149 ;;CHECK/MO PAYMENT;4;;4
150 ;;COMMENT;1;;1
151 ;;CREDIT CARD PAYMENT;7;;7
152 ;;DEPT OF JUSTICE PAYMENT;5;;5
153 ;;REGIONAL COUNSEL PAYMENT;3;;3
154 ;;FOLLOW-UP LETTER;10;;10
155 ;;IRS PAYMENT;11;;11
156 ;;PATIENT STATEMENT;2;;2
157 ;;TDA PAYMENT;8;;8
158 ;;UB PRINTED;9;;9
159 ;;LOCKBOX;12;;12
160 ;;TOP PAYMENT;13;;13
161 ;;EDI LOCKBOX;14;;14
162 ;;EOF
Note: See TracBrowser for help on using the repository browser.