- 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 Jan 18, 2025@02:49:32 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)