RCRJRTRA ;WISC/RFJ-transaction report ;1 Mar 97
;;4.5;Accounts Receivable;**68,153,340**;Mar 20, 1995;Build 9
;;Per VA Directive 6402, this routine should not be modified.
;
N DATEEND,DATESTRT,RCRJSUMM,TRANTYPE
;
; select date range
D DATESEL("AR TRANSACTIONS") I '$G(DATEEND) Q
S DATEEND=DATEEND+.99
;
; select transaction types
D TRANTYPE(DATESTRT,DATEEND) I '$O(TRANTYPE(0)) W !,"NO transaction types selected." Q
;
S RCRJSUMM=$$SUMMARY I 'RCRJSUMM Q
;
; select device
W ! S %ZIS="Q" D ^%ZIS Q:POP
I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK Q
. S ZTDESC="AR Transaction Listing Report",ZTRTN="DQ^RCRJRTRA"
. S ZTSAVE("DATE*")="",ZTSAVE("RCRJ*")="",ZTSAVE("TRANTYPE*")="",ZTSAVE("ZTREQ")="@"
W !!,"<*> please wait <*>"
;
DQ ; report (queue) starts here
N ADM,BILLDA,CATDA,DA,DATA0,DATE,INT,PRIN,TYPE,VALUE,X,Y
K ^TMP($J,"RCRJRTRA")
;
S TRANTYPE=0 F S TRANTYPE=$O(TRANTYPE(TRANTYPE)) Q:'TRANTYPE I $D(^PRCA(433,"AT",TRANTYPE)) D
. S DATE=DATESTRT-.01 F S DATE=$O(^PRCA(433,"AT",TRANTYPE,DATE)) Q:'DATE!(DATE>DATEEND) D
. . S DA=0 F S DA=$O(^PRCA(433,"AT",TRANTYPE,DATE,DA)) Q:'DA D
. . . S DATA0=$G(^PRCA(433,DA,0))
. . . ;
. . . S BILLDA=+$P(DATA0,"^",2)
. . . ; bill not linked to a site
. . . I '$P($G(^PRCA(430,BILLDA,0)),"^",12) Q
. . . ;
. . . S CATDA=+$P($G(^PRCA(430,BILLDA,0)),"^",2)
. . . I 'CATDA Q
. . . ;
. . . S VALUE=$$TRANBAL^RCRJRCOT(DA) I VALUE="" Q
. . . S PRIN=$P(VALUE,"^"),INT=$P(VALUE,"^",2),ADM=$P(VALUE,"^",3)+$P(VALUE,"^",4)+$P(VALUE,"^",5)
. . . ;
. . . S TYPE=TRANTYPE
. . . ; contract adjustment
. . . I TYPE=35,$P($G(^PRCA(433,DA,8)),"^",8) S TYPE="35C"
. . . ; pre-payments
. . . I (TYPE=2!(TYPE=34)),$P($G(^PRCA(433,DA,5)),"^") S TYPE="34P"
. . . ;
. . . I TYPE'=12,TYPE'=74 D SETVALUE(TYPE,PRIN,INT,ADM) Q ; *340 added 74 - cs admin.cost charge
. . . ;
. . . ; if trans is 12 or 74, breakout charges added + and exempt -
. . . ; both +, charges added
. . . I INT'<0,ADM'<0 D SETVALUE(TYPE_"A","",INT,ADM) Q
. . . ; both -, charges exempt
. . . I INT<0,ADM<0 D SETVALUE(TYPE_"E","",-INT,-ADM) Q
. . . ; one is + and the other -
. . . I INT<0 D:ADM SETVALUE(TYPE_"A","","",ADM) D SETVALUE(TYPE_"E","",-INT,"") Q
. . . I ADM<0 D:INT SETVALUE(TYPE_"A","",INT,"") D SETVALUE(TYPE_"E","","",-ADM) Q
;
D PRINT^RCRJRTR1
;
D ^%ZISC
K ^TMP($J,"RCRJRTRA")
Q
;
;
SETVALUE(TYPE,PRIN,INT,ADM) ; store value in tmp global for printing
; = trans amt ^ prin amt ^ int amt ^ adm amt
; add spaces to type for sorting in numerical order
S TYPE=" "_$S($L(+TYPE)=1:" ",1:"")_TYPE
S ^TMP($J,"RCRJRTRA",TYPE,CATDA,BILLDA,DA)=(PRIN+INT+ADM)_"^"_PRIN_"^"_INT_"^"_ADM
Q
;
;
DATESEL(DESCR) ; select starting and ending dates in days
; returns datestrt and dateend
N %,%DT,%H,%I,DEFAULT,X,Y
K DATEEND,DATESTRT
START S Y=$E(DT,1,5)_"01" D DD^%DT S DEFAULT=Y
S %DT("A")="Start with "_$S(DESCR'="":DESCR_" ",1:"")_"Date: ",%DT("B")=DEFAULT,%DT="AEP",%DT(0)=-DT D ^%DT I Y<0 Q
I $E(Y,6,7)="00" S Y=$E(Y,1,5)_"01"
S DATESTRT=Y
S Y=DT D DD^%DT S DEFAULT=Y
S %DT("A")=" End with "_$S(DESCR'="":DESCR_" ",1:"")_"Date: ",%DT("B")=DEFAULT,%DT="AEP",%DT(0)=-DT D ^%DT I Y<0 Q
I $E(Y,6,7)="00" S Y=$E(Y,1,5)_"01"
I Y<DATESTRT W !,"END DATE MUST BE GREATER THAN OR EQUAL TO THE START DATE.",! G START
S DATEEND=Y,Y=DATESTRT D DD^%DT
W !?5,"*** Selected date range from ",Y," to " S Y=DATEEND D DD^%DT W Y," ***"
Q
;
;
TRANTYPE(DATESTRT,DATEEND) ; select transaction types
; requires datestrt and dateend for date range
; returns TRANTYPE(#) for selected entries
N %,COUNT,DATE,DIR,DIRUT,RCRJFLAG,TRANLIST,X,Y
K TRANTYPE
;
; compile a list of available transactions in date range
S TRANLIST="",DATE=DATESTRT-.01
S TRANTYPE=0 F S TRANTYPE=$O(^PRCA(433,"AT",TRANTYPE)) Q:'TRANTYPE S %=+$O(^PRCA(433,"AT",TRANTYPE,DATE)) I %,%<DATEEND D
. I TRANTYPE=45 Q ;do not look at comments
. S %=$P($G(^PRCA(430.3,TRANTYPE,0)),"^")
. S TRANLIST(TRANTYPE)=%
. S TRANLIST=TRANLIST_TRANTYPE_":"_$E(%,1,10)_";"
I TRANLIST="" W !,"There are NO transactions within the date range." Q
S TRANLIST=TRANLIST_"*:ALL transactions;-:NO transactions;"
;
F D Q:$G(RCRJFLAG)
. D SHOWLIST
. S DIR(0)="SOA^"_TRANLIST,DIR("A")="Select TRANSACTION TYPE: "
. D ^DIR
. I $D(DIRUT) S RCRJFLAG=1 Q
. I Y="*" S %=0 F S %=$O(TRANLIST(%)) Q:'% S TRANTYPE(%)=""
. I Y="-" K TRANTYPE Q
. S Y=+Y
. I $D(TRANLIST(Y)) D
. . I $D(TRANTYPE(Y)) K TRANTYPE(Y) W " un-selected" Q
. . S TRANTYPE(Y)="" W " selected"
Q
;
;
SHOWLIST ; show list of available/selected transaction types
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."
S %=0 F COUNT=1:1 S %=$O(TRANLIST(%)) Q:'% D
. I (COUNT#2)'=0 W !
. E W ?40
. W $S($D(TRANTYPE(%)):"**",1:" ")," "
. W $S($L(%)=1:" ",1:""),%," ",TRANLIST(%)
Q
;
;
SUMMARY() ; ask to print detailed or summary report
N DIR,DIRUT,X,Y
S DIR(0)="SOA^D:detailed;S:summary;",DIR("A")="Type of report to print: ",DIR("B")="summary"
W ! D ^DIR
I $D(DIRUT) Q 0
Q $S(Y="S":1,Y="D":2,1:0)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCRJRTRA 5528 printed Dec 13, 2024@01:48:19 Page 2
RCRJRTRA ;WISC/RFJ-transaction report ;1 Mar 97
+1 ;;4.5;Accounts Receivable;**68,153,340**;Mar 20, 1995;Build 9
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 NEW DATEEND,DATESTRT,RCRJSUMM,TRANTYPE
+5 ;
+6 ; select date range
+7 DO DATESEL("AR TRANSACTIONS")
IF '$GET(DATEEND)
QUIT
+8 SET DATEEND=DATEEND+.99
+9 ;
+10 ; select transaction types
+11 DO TRANTYPE(DATESTRT,DATEEND)
IF '$ORDER(TRANTYPE(0))
WRITE !,"NO transaction types selected."
QUIT
+12 ;
+13 SET RCRJSUMM=$$SUMMARY
IF 'RCRJSUMM
QUIT
+14 ;
+15 ; select device
+16 WRITE !
SET %ZIS="Q"
DO ^%ZIS
if POP
QUIT
+17 IF $DATA(IO("Q"))
Begin DoDot:1
+18 SET ZTDESC="AR Transaction Listing Report"
SET ZTRTN="DQ^RCRJRTRA"
+19 SET ZTSAVE("DATE*")=""
SET ZTSAVE("RCRJ*")=""
SET ZTSAVE("TRANTYPE*")=""
SET ZTSAVE("ZTREQ")="@"
End DoDot:1
DO ^%ZTLOAD
KILL IO("Q"),ZTSK
QUIT
+20 WRITE !!,"<*> please wait <*>"
+21 ;
DQ ; report (queue) starts here
+1 NEW ADM,BILLDA,CATDA,DA,DATA0,DATE,INT,PRIN,TYPE,VALUE,X,Y
+2 KILL ^TMP($JOB,"RCRJRTRA")
+3 ;
+4 SET TRANTYPE=0
FOR
SET TRANTYPE=$ORDER(TRANTYPE(TRANTYPE))
if 'TRANTYPE
QUIT
IF $DATA(^PRCA(433,"AT",TRANTYPE))
Begin DoDot:1
+5 SET DATE=DATESTRT-.01
FOR
SET DATE=$ORDER(^PRCA(433,"AT",TRANTYPE,DATE))
if 'DATE!(DATE>DATEEND)
QUIT
Begin DoDot:2
+6 SET DA=0
FOR
SET DA=$ORDER(^PRCA(433,"AT",TRANTYPE,DATE,DA))
if 'DA
QUIT
Begin DoDot:3
+7 SET DATA0=$GET(^PRCA(433,DA,0))
+8 ;
+9 SET BILLDA=+$PIECE(DATA0,"^",2)
+10 ; bill not linked to a site
+11 IF '$PIECE($GET(^PRCA(430,BILLDA,0)),"^",12)
QUIT
+12 ;
+13 SET CATDA=+$PIECE($GET(^PRCA(430,BILLDA,0)),"^",2)
+14 IF 'CATDA
QUIT
+15 ;
+16 SET VALUE=$$TRANBAL^RCRJRCOT(DA)
IF VALUE=""
QUIT
+17 SET PRIN=$PIECE(VALUE,"^")
SET INT=$PIECE(VALUE,"^",2)
SET ADM=$PIECE(VALUE,"^",3)+$PIECE(VALUE,"^",4)+$PIECE(VALUE,"^",5)
+18 ;
+19 SET TYPE=TRANTYPE
+20 ; contract adjustment
+21 IF TYPE=35
IF $PIECE($GET(^PRCA(433,DA,8)),"^",8)
SET TYPE="35C"
+22 ; pre-payments
+23 IF (TYPE=2!(TYPE=34))
IF $PIECE($GET(^PRCA(433,DA,5)),"^")
SET TYPE="34P"
+24 ;
+25 ; *340 added 74 - cs admin.cost charge
IF TYPE'=12
IF TYPE'=74
DO SETVALUE(TYPE,PRIN,INT,ADM)
QUIT
+26 ;
+27 ; if trans is 12 or 74, breakout charges added + and exempt -
+28 ; both +, charges added
+29 IF INT'<0
IF ADM'<0
DO SETVALUE(TYPE_"A","",INT,ADM)
QUIT
+30 ; both -, charges exempt
+31 IF INT<0
IF ADM<0
DO SETVALUE(TYPE_"E","",-INT,-ADM)
QUIT
+32 ; one is + and the other -
+33 IF INT<0
if ADM
DO SETVALUE(TYPE_"A","","",ADM)
DO SETVALUE(TYPE_"E","",-INT,"")
QUIT
+34 IF ADM<0
if INT
DO SETVALUE(TYPE_"A","",INT,"")
DO SETVALUE(TYPE_"E","","",-ADM)
QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+35 ;
+36 DO PRINT^RCRJRTR1
+37 ;
+38 DO ^%ZISC
+39 KILL ^TMP($JOB,"RCRJRTRA")
+40 QUIT
+41 ;
+42 ;
SETVALUE(TYPE,PRIN,INT,ADM) ; store value in tmp global for printing
+1 ; = trans amt ^ prin amt ^ int amt ^ adm amt
+2 ; add spaces to type for sorting in numerical order
+3 SET TYPE=" "_$SELECT($LENGTH(+TYPE)=1:" ",1:"")_TYPE
+4 SET ^TMP($JOB,"RCRJRTRA",TYPE,CATDA,BILLDA,DA)=(PRIN+INT+ADM)_"^"_PRIN_"^"_INT_"^"_ADM
+5 QUIT
+6 ;
+7 ;
DATESEL(DESCR) ; select starting and ending dates in days
+1 ; returns datestrt and dateend
+2 NEW %,%DT,%H,%I,DEFAULT,X,Y
+3 KILL DATEEND,DATESTRT
START SET Y=$EXTRACT(DT,1,5)_"01"
DO DD^%DT
SET DEFAULT=Y
+1 SET %DT("A")="Start with "_$SELECT(DESCR'="":DESCR_" ",1:"")_"Date: "
SET %DT("B")=DEFAULT
SET %DT="AEP"
SET %DT(0)=-DT
DO ^%DT
IF Y<0
QUIT
+2 IF $EXTRACT(Y,6,7)="00"
SET Y=$EXTRACT(Y,1,5)_"01"
+3 SET DATESTRT=Y
+4 SET Y=DT
DO DD^%DT
SET DEFAULT=Y
+5 SET %DT("A")=" End with "_$SELECT(DESCR'="":DESCR_" ",1:"")_"Date: "
SET %DT("B")=DEFAULT
SET %DT="AEP"
SET %DT(0)=-DT
DO ^%DT
IF Y<0
QUIT
+6 IF $EXTRACT(Y,6,7)="00"
SET Y=$EXTRACT(Y,1,5)_"01"
+7 IF Y<DATESTRT
WRITE !,"END DATE MUST BE GREATER THAN OR EQUAL TO THE START DATE.",!
GOTO START
+8 SET DATEEND=Y
SET Y=DATESTRT
DO DD^%DT
+9 WRITE !?5,"*** Selected date range from ",Y," to "
SET Y=DATEEND
DO DD^%DT
WRITE Y," ***"
+10 QUIT
+11 ;
+12 ;
TRANTYPE(DATESTRT,DATEEND) ; select transaction types
+1 ; requires datestrt and dateend for date range
+2 ; returns TRANTYPE(#) for selected entries
+3 NEW %,COUNT,DATE,DIR,DIRUT,RCRJFLAG,TRANLIST,X,Y
+4 KILL TRANTYPE
+5 ;
+6 ; compile a list of available transactions in date range
+7 SET TRANLIST=""
SET DATE=DATESTRT-.01
+8 SET TRANTYPE=0
FOR
SET TRANTYPE=$ORDER(^PRCA(433,"AT",TRANTYPE))
if 'TRANTYPE
QUIT
SET %=+$ORDER(^PRCA(433,"AT",TRANTYPE,DATE))
IF %
IF %<DATEEND
Begin DoDot:1
+9 ;do not look at comments
IF TRANTYPE=45
QUIT
+10 SET %=$PIECE($GET(^PRCA(430.3,TRANTYPE,0)),"^")
+11 SET TRANLIST(TRANTYPE)=%
+12 SET TRANLIST=TRANLIST_TRANTYPE_":"_$EXTRACT(%,1,10)_";"
End DoDot:1
+13 IF TRANLIST=""
WRITE !,"There are NO transactions within the date range."
QUIT
+14 SET TRANLIST=TRANLIST_"*:ALL transactions;-:NO transactions;"
+15 ;
+16 FOR
Begin DoDot:1
+17 DO SHOWLIST
+18 SET DIR(0)="SOA^"_TRANLIST
SET DIR("A")="Select TRANSACTION TYPE: "
+19 DO ^DIR
+20 IF $DATA(DIRUT)
SET RCRJFLAG=1
QUIT
+21 IF Y="*"
SET %=0
FOR
SET %=$ORDER(TRANLIST(%))
if '%
QUIT
SET TRANTYPE(%)=""
+22 IF Y="-"
KILL TRANTYPE
QUIT
+23 SET Y=+Y
+24 IF $DATA(TRANLIST(Y))
Begin DoDot:2
+25 IF $DATA(TRANTYPE(Y))
KILL TRANTYPE(Y)
WRITE " un-selected"
QUIT
+26 SET TRANTYPE(Y)=""
WRITE " selected"
End DoDot:2
End DoDot:1
if $GET(RCRJFLAG)
QUIT
+27 QUIT
+28 ;
+29 ;
SHOWLIST ; show list of available/selected transaction types
+1 WRITE !!,"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."
+2 SET %=0
FOR COUNT=1:1
SET %=$ORDER(TRANLIST(%))
if '%
QUIT
Begin DoDot:1
+3 IF (COUNT#2)'=0
WRITE !
+4 IF '$TEST
WRITE ?40
+5 WRITE $SELECT($DATA(TRANTYPE(%)):"**",1:" ")," "
+6 WRITE $SELECT($LENGTH(%)=1:" ",1:""),%," ",TRANLIST(%)
End DoDot:1
+7 QUIT
+8 ;
+9 ;
SUMMARY() ; ask to print detailed or summary report
+1 NEW DIR,DIRUT,X,Y
+2 SET DIR(0)="SOA^D:detailed;S:summary;"
SET DIR("A")="Type of report to print: "
SET DIR("B")="summary"
+3 WRITE !
DO ^DIR
+4 IF $DATA(DIRUT)
QUIT 0
+5 QUIT $SELECT(Y="S":1,Y="D":2,1:0)
