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