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

RCRJRTRA.m

Go to the documentation of this file.
  1. RCRJRTRA ;WISC/RFJ-transaction report ;1 Mar 97
  1. ;;4.5;Accounts Receivable;**68,153,340**;Mar 20, 1995;Build 9
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. N DATEEND,DATESTRT,RCRJSUMM,TRANTYPE
  1. ;
  1. ; select date range
  1. D DATESEL("AR TRANSACTIONS") I '$G(DATEEND) Q
  1. S DATEEND=DATEEND+.99
  1. ;
  1. ; select transaction types
  1. D TRANTYPE(DATESTRT,DATEEND) I '$O(TRANTYPE(0)) W !,"NO transaction types selected." Q
  1. ;
  1. S RCRJSUMM=$$SUMMARY I 'RCRJSUMM Q
  1. ;
  1. ; select device
  1. W ! S %ZIS="Q" D ^%ZIS Q:POP
  1. I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK Q
  1. . S ZTDESC="AR Transaction Listing Report",ZTRTN="DQ^RCRJRTRA"
  1. . S ZTSAVE("DATE*")="",ZTSAVE("RCRJ*")="",ZTSAVE("TRANTYPE*")="",ZTSAVE("ZTREQ")="@"
  1. W !!,"<*> please wait <*>"
  1. ;
  1. DQ ; report (queue) starts here
  1. N ADM,BILLDA,CATDA,DA,DATA0,DATE,INT,PRIN,TYPE,VALUE,X,Y
  1. K ^TMP($J,"RCRJRTRA")
  1. ;
  1. S TRANTYPE=0 F S TRANTYPE=$O(TRANTYPE(TRANTYPE)) Q:'TRANTYPE I $D(^PRCA(433,"AT",TRANTYPE)) D
  1. . S DATE=DATESTRT-.01 F S DATE=$O(^PRCA(433,"AT",TRANTYPE,DATE)) Q:'DATE!(DATE>DATEEND) D
  1. . . S DA=0 F S DA=$O(^PRCA(433,"AT",TRANTYPE,DATE,DA)) Q:'DA D
  1. . . . S DATA0=$G(^PRCA(433,DA,0))
  1. . . . ;
  1. . . . S BILLDA=+$P(DATA0,"^",2)
  1. . . . ; bill not linked to a site
  1. . . . I '$P($G(^PRCA(430,BILLDA,0)),"^",12) Q
  1. . . . ;
  1. . . . S CATDA=+$P($G(^PRCA(430,BILLDA,0)),"^",2)
  1. . . . I 'CATDA Q
  1. . . . ;
  1. . . . S VALUE=$$TRANBAL^RCRJRCOT(DA) I VALUE="" Q
  1. . . . S PRIN=$P(VALUE,"^"),INT=$P(VALUE,"^",2),ADM=$P(VALUE,"^",3)+$P(VALUE,"^",4)+$P(VALUE,"^",5)
  1. . . . ;
  1. . . . S TYPE=TRANTYPE
  1. . . . ; contract adjustment
  1. . . . I TYPE=35,$P($G(^PRCA(433,DA,8)),"^",8) S TYPE="35C"
  1. . . . ; pre-payments
  1. . . . I (TYPE=2!(TYPE=34)),$P($G(^PRCA(433,DA,5)),"^") S TYPE="34P"
  1. . . . ;
  1. . . . I TYPE'=12,TYPE'=74 D SETVALUE(TYPE,PRIN,INT,ADM) Q ; *340 added 74 - cs admin.cost charge
  1. . . . ;
  1. . . . ; if trans is 12 or 74, breakout charges added + and exempt -
  1. . . . ; both +, charges added
  1. . . . I INT'<0,ADM'<0 D SETVALUE(TYPE_"A","",INT,ADM) Q
  1. . . . ; both -, charges exempt
  1. . . . I INT<0,ADM<0 D SETVALUE(TYPE_"E","",-INT,-ADM) Q
  1. . . . ; one is + and the other -
  1. . . . I INT<0 D:ADM SETVALUE(TYPE_"A","","",ADM) D SETVALUE(TYPE_"E","",-INT,"") Q
  1. . . . I ADM<0 D:INT SETVALUE(TYPE_"A","",INT,"") D SETVALUE(TYPE_"E","","",-ADM) Q
  1. ;
  1. D PRINT^RCRJRTR1
  1. ;
  1. D ^%ZISC
  1. K ^TMP($J,"RCRJRTRA")
  1. Q
  1. ;
  1. ;
  1. SETVALUE(TYPE,PRIN,INT,ADM) ; store value in tmp global for printing
  1. ; = trans amt ^ prin amt ^ int amt ^ adm amt
  1. ; add spaces to type for sorting in numerical order
  1. S TYPE=" "_$S($L(+TYPE)=1:" ",1:"")_TYPE
  1. S ^TMP($J,"RCRJRTRA",TYPE,CATDA,BILLDA,DA)=(PRIN+INT+ADM)_"^"_PRIN_"^"_INT_"^"_ADM
  1. Q
  1. ;
  1. ;
  1. DATESEL(DESCR) ; select starting and ending dates in days
  1. ; returns datestrt and dateend
  1. N %,%DT,%H,%I,DEFAULT,X,Y
  1. K DATEEND,DATESTRT
  1. START S Y=$E(DT,1,5)_"01" D DD^%DT S DEFAULT=Y
  1. S %DT("A")="Start with "_$S(DESCR'="":DESCR_" ",1:"")_"Date: ",%DT("B")=DEFAULT,%DT="AEP",%DT(0)=-DT D ^%DT I Y<0 Q
  1. I $E(Y,6,7)="00" S Y=$E(Y,1,5)_"01"
  1. S DATESTRT=Y
  1. S Y=DT D DD^%DT S DEFAULT=Y
  1. S %DT("A")=" End with "_$S(DESCR'="":DESCR_" ",1:"")_"Date: ",%DT("B")=DEFAULT,%DT="AEP",%DT(0)=-DT D ^%DT I Y<0 Q
  1. I $E(Y,6,7)="00" S Y=$E(Y,1,5)_"01"
  1. I Y<DATESTRT W !,"END DATE MUST BE GREATER THAN OR EQUAL TO THE START DATE.",! G START
  1. S DATEEND=Y,Y=DATESTRT D DD^%DT
  1. W !?5,"*** Selected date range from ",Y," to " S Y=DATEEND D DD^%DT W Y," ***"
  1. Q
  1. ;
  1. ;
  1. TRANTYPE(DATESTRT,DATEEND) ; select transaction types
  1. ; requires datestrt and dateend for date range
  1. ; returns TRANTYPE(#) for selected entries
  1. N %,COUNT,DATE,DIR,DIRUT,RCRJFLAG,TRANLIST,X,Y
  1. K TRANTYPE
  1. ;
  1. ; compile a list of available transactions in date range
  1. S TRANLIST="",DATE=DATESTRT-.01
  1. S TRANTYPE=0 F S TRANTYPE=$O(^PRCA(433,"AT",TRANTYPE)) Q:'TRANTYPE S %=+$O(^PRCA(433,"AT",TRANTYPE,DATE)) I %,%<DATEEND D
  1. . I TRANTYPE=45 Q ;do not look at comments
  1. . S %=$P($G(^PRCA(430.3,TRANTYPE,0)),"^")
  1. . S TRANLIST(TRANTYPE)=%
  1. . S TRANLIST=TRANLIST_TRANTYPE_":"_$E(%,1,10)_";"
  1. I TRANLIST="" W !,"There are NO transactions within the date range." Q
  1. S TRANLIST=TRANLIST_"*:ALL transactions;-:NO transactions;"
  1. ;
  1. F D Q:$G(RCRJFLAG)
  1. . D SHOWLIST
  1. . S DIR(0)="SOA^"_TRANLIST,DIR("A")="Select TRANSACTION TYPE: "
  1. . D ^DIR
  1. . I $D(DIRUT) S RCRJFLAG=1 Q
  1. . I Y="*" S %=0 F S %=$O(TRANLIST(%)) Q:'% S TRANTYPE(%)=""
  1. . I Y="-" K TRANTYPE Q
  1. . S Y=+Y
  1. . I $D(TRANLIST(Y)) D
  1. . . I $D(TRANTYPE(Y)) K TRANTYPE(Y) W " un-selected" Q
  1. . . S TRANTYPE(Y)="" W " selected"
  1. Q
  1. ;
  1. ;
  1. SHOWLIST ; show list of available/selected transaction types
  1. W !!,"The following is a list of available transactions within the date range.",!,"Asterisks (**) next to the transaction indicates it has been selected",!,"for the report."
  1. S %=0 F COUNT=1:1 S %=$O(TRANLIST(%)) Q:'% D
  1. . I (COUNT#2)'=0 W !
  1. . E W ?40
  1. . W $S($D(TRANTYPE(%)):"**",1:" ")," "
  1. . W $S($L(%)=1:" ",1:""),%," ",TRANLIST(%)
  1. Q
  1. ;
  1. ;
  1. SUMMARY() ; ask to print detailed or summary report
  1. N DIR,DIRUT,X,Y
  1. S DIR(0)="SOA^D:detailed;S:summary;",DIR("A")="Type of report to print: ",DIR("B")="summary"
  1. W ! D ^DIR
  1. I $D(DIRUT) Q 0
  1. Q $S(Y="S":1,Y="D":2,1:0)