Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCTRAN1

RCTRAN1.m

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