| 1 | RCTRAN1 ;WASH-ISC@ALTOONA,PA/LDB-Transaction History Report ;11/14/94 5:25 PM
|
|---|
| 2 | V ;;4.5;Accounts Receivable;**104**;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ;Subroutines Called by RCTRAN
|
|---|
| 6 | ;
|
|---|
| 7 | TRANS ;Find transactions of selected type for selected date range
|
|---|
| 8 | S CAT("X")=CAT D DT^DICRW
|
|---|
| 9 | S BDATE(1)=BDATE,BDATE=(BDATE-1)+.999999999
|
|---|
| 10 | S EDATE(1)=EDATE,EDATE=$S('EDATE:9999999,1:EDATE+.99999999)
|
|---|
| 11 | S RCX=0 F S RCX=$O(^PRCA(433,RCX)) Q:'RCX I $D(^PRCA(433,RCX,0)),+$G(^(1)) D
|
|---|
| 12 | .S NODE0=^(0),NODE1=^(1),NODE2=$G(^(2)),NODE3=$G(^(3))
|
|---|
| 13 | .S TDAT=$S($P(NODE1,"^",9):$P(NODE1,"^",9),1:+NODE1)
|
|---|
| 14 | .S BILL=$P(NODE0,"^",2) Q:'BILL
|
|---|
| 15 | .S CAT=$P($G(^PRCA(430,+BILL,0)),"^",2) Q:'CAT
|
|---|
| 16 | .I ($D(TYP(+$P(NODE1,"^",2)))!'TYP),($D(CAT(+CAT))!'CAT("X")),TDAT>BDATE,TDAT<EDATE D
|
|---|
| 17 | ..S APP=$P($G(^PRCA(430,+BILL,11)),"^",17)
|
|---|
| 18 | ..I APP="",",5,4,3,18,25,"[(","_CAT_",") S APP="2431"
|
|---|
| 19 | ..I APP="",",9,6,7,8,21,22,23,26,"[(","_CAT_",") S APP="5014"
|
|---|
| 20 | ..I APP="",",14,12,19,20,1,10,2,"[(","_CAT_",") S APP="0160"
|
|---|
| 21 | ..I CAT=26 S APP="5014"
|
|---|
| 22 | ..I APP="" S APP="NO FUND W/BILL"
|
|---|
| 23 | ..S BILL=$P($G(^PRCA(430,+BILL,0)),"^")
|
|---|
| 24 | ..I ",12,13,14,"[(","_TYP_",") D Q
|
|---|
| 25 | ...F I=5:1:8 S AMT=$P(NODE2,"^",I) I AMT S APP=$S(I=8:1435,I=7:3220,1:"0869") D SET
|
|---|
| 26 | ..I ",2,34,"[(","_TYP_",") D Q
|
|---|
| 27 | ...F I=1:1:5 I $P(NODE3,"^",I) S AMT=+$P(NODE3,"^",I),APP=$S(I=1:APP,I=2:1435,I=3:3220,1:"0869") D SET
|
|---|
| 28 | ..S AMT=+$P(NODE1,"^",5)
|
|---|
| 29 | ..D SET
|
|---|
| 30 | Q
|
|---|
| 31 | ;
|
|---|
| 32 | SET S ^TMP($J,+$P(NODE1,"^",2),+CAT,APP,TDAT,RCX)=AMT_"^"_BILL_"^"_$P(NODE0,"^",9)
|
|---|
| 33 | Q
|
|---|
| 34 | ;
|
|---|
| 35 | SUB ;Sub-total categories
|
|---|
| 36 | I RCX'=45 S:AMT(X11)<0 AMT(X11)=-AMT(X11) W !?64,"-----------",!?64,$J(AMT(X11),11,2),!
|
|---|
| 37 | Q
|
|---|
| 38 | ;
|
|---|
| 39 | KEY ;Key to category abbreviations
|
|---|
| 40 | W !!?30,"CATEGORY ABBREVIATIONS",!!
|
|---|
| 41 | W !,"C - C (MEANS TEST), CE - CURRENT EMPLOYEE, CP - CRIME OF PER. VIO."
|
|---|
| 42 | W !,"E - EX-EMPLOYEE"
|
|---|
| 43 | W !,"F1 - FEDERAL AGENGIES-REIMB., F2 - FEDERAL AGENCIES-REFUND"
|
|---|
| 44 | W !,"H - EMERGENCY HUMANITARIAN"
|
|---|
| 45 | W !,"I - INELIGIBLE HOSP., IA - INTERAGENCY, M - MILITARY, MC - MEDICARN"
|
|---|
| 46 | W !,"NA - NO-FAULT AUTO ACC."
|
|---|
| 47 | W !,"PN - RX CO-PAY NSC, PS - RX CO-PAY SC, PP - PREPAY"
|
|---|
| 48 | W !,"RI - REIMBURSIBLE HEALTH INSURANCE"
|
|---|
| 49 | W !,"SA - SHARING AGREEMENTS, TF - TORT FEASOR, V - VENDOR, WC - WORKMAN'S COMP."
|
|---|
| 50 | Q
|
|---|
| 51 | HDR ;;Heading
|
|---|
| 52 | S PG=PG+1
|
|---|
| 53 | W !?30,"HISTORY OF TRANSACTIONS",?70,"PAGE ",?75,PG
|
|---|
| 54 | W !,LINE
|
|---|
| 55 | W !,"Date",?12,"Trans.",?37,"Cat",?44,"Bill#",?57,"Trans#",?66,"Amount",?75,"BY"
|
|---|
| 56 | W !,LINE
|
|---|
| 57 | S LN=0
|
|---|
| 58 | Q
|
|---|
