| [613] | 1 | RCBMILL ;WISC/RFJ-millennium bill report (generator) ; 27 Jun 2001 11:10 AM
|
|---|
| 2 | ;;4.5;Accounts Receivable;**170,203**;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | N %DT,DEFAULT,RCDATBEG,RCDATEND,RCREPTYP,X,Y
|
|---|
| 5 | ;
|
|---|
| 6 | ; ask type of report to generate
|
|---|
| 7 | W !!,"--- Enter the Type of Report to Generate ---"
|
|---|
| 8 | S RCREPTYP=$$ASKTYPE
|
|---|
| 9 | I RCREPTYP<1 Q
|
|---|
| 10 | ;
|
|---|
| 11 | ; ask month year
|
|---|
| 12 | I RCREPTYP=1!(RCREPTYP=2)!(RCREPTYP=3) D
|
|---|
| 13 | . N RCOFFDT
|
|---|
| 14 | . W !!,"--- Enter the Month and Year for the Report ---"
|
|---|
| 15 | . S Y=$E($$PREVMONT^RCRJRBD(DT),1,5)_"00" D DD^%DT S DEFAULT=Y
|
|---|
| 16 | . S RCOFFDT=3030930 ; The report cannot run for later date
|
|---|
| 17 | . S %DT(0)=$S(DT>RCOFFDT:-RCOFFDT,1:-DT)
|
|---|
| 18 | . S %DT("A")="Select MONTH YEAR for Report: ",%DT("B")=DEFAULT,%DT="AEMP"
|
|---|
| 19 | . D ^%DT I Y<0 Q
|
|---|
| 20 | . S RCDATBEG=$E(Y,1,5)_"00",RCDATEND=$E(Y,1,5)_"32"
|
|---|
| 21 | ;
|
|---|
| 22 | ; ask date range
|
|---|
| 23 | I RCREPTYP=4 D MONTHSEL I '$G(RCDATEND) Q
|
|---|
| 24 | ;
|
|---|
| 25 | I '$G(RCDATEND) Q
|
|---|
| 26 | ;
|
|---|
| 27 | ; select device
|
|---|
| 28 | W ! S %ZIS="Q" D ^%ZIS Q:POP
|
|---|
| 29 | I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK Q
|
|---|
| 30 | . S ZTDESC="AR Millennium Bill Report Generator",ZTRTN="DQ^RCBMILL"
|
|---|
| 31 | . S ZTSAVE("RCREPTYP")="",ZTSAVE("RCDATBEG")="",ZTSAVE("RCDATEND")="",ZTSAVE("ZTREQ")="@"
|
|---|
| 32 | W !!,"<*> please wait <*>"
|
|---|
| 33 | ;
|
|---|
| 34 | DQ ; queued report starts here
|
|---|
| 35 | ; requires variable rcdatbeg and rcdatend
|
|---|
| 36 | ;
|
|---|
| 37 | N %,RCBILLDA,RCCATEG,RCDATE,RCTRANDA,RCTYPE
|
|---|
| 38 | K ^TMP("RCBMILL",$J),^TMP($J,"RCBMILLDATA")
|
|---|
| 39 | ;
|
|---|
| 40 | ; get all payments between the two dates
|
|---|
| 41 | F RCTYPE=2,34 D
|
|---|
| 42 | . S RCDATE=$E(RCDATBEG,1,5)_"00"
|
|---|
| 43 | . F S RCDATE=$O(^PRCA(433,"AT",RCTYPE,RCDATE)) Q:'RCDATE!(RCDATE>RCDATEND) D
|
|---|
| 44 | . . S RCTRANDA=0
|
|---|
| 45 | . . F S RCTRANDA=$O(^PRCA(433,"AT",RCTYPE,RCDATE,RCTRANDA)) Q:'RCTRANDA D
|
|---|
| 46 | . . . S RCBILLDA=+$P($G(^PRCA(433,RCTRANDA,0)),"^",2) I 'RCBILLDA Q
|
|---|
| 47 | . . . ;
|
|---|
| 48 | . . . ; bill not rx copay
|
|---|
| 49 | . . . S RCCATEG=$P($G(^PRCA(430,RCBILLDA,0)),"^",2)
|
|---|
| 50 | . . . I RCCATEG'=22,RCCATEG'=23 Q
|
|---|
| 51 | . . . ;
|
|---|
| 52 | . . . S ^TMP("RCBMILL",$J,RCBILLDA)=""
|
|---|
| 53 | ;
|
|---|
| 54 | ; loop bills paid during the month and gather transactions
|
|---|
| 55 | S RCBILLDA=0 F S RCBILLDA=$O(^TMP("RCBMILL",$J,RCBILLDA)) Q:'RCBILLDA D
|
|---|
| 56 | . S %=$$BILLFUND^RCBMILLC(RCBILLDA,RCDATEND)
|
|---|
| 57 | ;
|
|---|
| 58 | ; set up variables for reports
|
|---|
| 59 | N %,%H,%I,RCMOYR,RCMOYRTO,RCNOW,RCPAGE,RCRJFLAG,RCRJLINE,RCSCREEN,X,Y
|
|---|
| 60 | S Y=$E(RCDATBEG,1,5)_"00" D DD^%DT S RCMOYR=Y
|
|---|
| 61 | S Y=$E(RCDATEND,1,5)_"00" D DD^%DT S RCMOYRTO=Y
|
|---|
| 62 | D NOW^%DTC S Y=% D DD^%DT S RCNOW=Y
|
|---|
| 63 | S RCPAGE=1
|
|---|
| 64 | S RCSCREEN=0 I '$D(ZTQUEUED),IO=IO(0),$E(IOST)="C" S RCSCREEN=1
|
|---|
| 65 | ;
|
|---|
| 66 | ; print summary report
|
|---|
| 67 | I RCREPTYP=1 D SUMMARY^RCBMILL3
|
|---|
| 68 | ; print payment detail report
|
|---|
| 69 | I RCREPTYP=2 D PRINT^RCBMILL1
|
|---|
| 70 | ; print all transaction report
|
|---|
| 71 | I RCREPTYP=3 D PRINT^RCBMILL2
|
|---|
| 72 | ; print history for date range
|
|---|
| 73 | I RCREPTYP=4 D PRINT^RCBMILL4
|
|---|
| 74 | ;
|
|---|
| 75 | K ^TMP("RCBMILL",$J),^TMP($J,"RCBMILLDATA")
|
|---|
| 76 | D ^%ZISC
|
|---|
| 77 | Q
|
|---|
| 78 | ;
|
|---|
| 79 | ;
|
|---|
| 80 | ASKTYPE() ; ask type of report
|
|---|
| 81 | N DIR,DIRUT,DTOUT,DUOUT,X,Y
|
|---|
| 82 | S DIR(0)="SO^1:Summary for Selected Month;2:Payment Detail for Selected Month;3:All Transactions for Selected Month;4:History for Date Range"
|
|---|
| 83 | S DIR("A")="Select Report to Generate"
|
|---|
| 84 | S DIR("B")="Summary"
|
|---|
| 85 | D ^DIR
|
|---|
| 86 | I $G(DTOUT)!($G(DUOUT)) S Y=-1
|
|---|
| 87 | ;
|
|---|
| 88 | I Y=3 D
|
|---|
| 89 | . W !!,"***** WARNING: THIS WILL USE A LARGE AMOUNT OF PAPER. *****"
|
|---|
| 90 | . W !,"***** I RECOMMENDED THAT YOU DO ***NOT*** PRINT THIS *****"
|
|---|
| 91 | . W !,"***** REPORT ON A PRINTER. YOU SHOULD CAPTURE THIS *****"
|
|---|
| 92 | . W !,"***** TO A FILE ON YOUR PC FOR REVIEW. *****"
|
|---|
| 93 | ;
|
|---|
| 94 | Q Y
|
|---|
| 95 | ;
|
|---|
| 96 | ;
|
|---|
| 97 | MONTHSEL ; ask starting and ending month
|
|---|
| 98 | ; returns rcdatbeg and rcdatend
|
|---|
| 99 | N %DT,DEFAULT,X,Y
|
|---|
| 100 | K RCDATBEG,RCDATEND
|
|---|
| 101 | ;
|
|---|
| 102 | W !!,"--- Enter the Starting and Ending Month and Year ---"
|
|---|
| 103 | S Y=$E(DT,1,3)_"0100" D DD^%DT S DEFAULT=Y
|
|---|
| 104 | S %DT("A")="Select Starting MONTH YEAR: ",%DT("B")=DEFAULT,%DT="AEMP",%DT(0)=-DT D ^%DT I Y<0 Q
|
|---|
| 105 | S RCDATBEG=$E(Y,1,5)_"00"
|
|---|
| 106 | ;
|
|---|
| 107 | S Y=$E(DT,1,5)_"00" D DD^%DT S DEFAULT=Y
|
|---|
| 108 | S %DT("A")="Select Ending MONTH YEAR: ",%DT("B")=DEFAULT,%DT="AEMP",%DT(0)=-DT D ^%DT I Y<0 Q
|
|---|
| 109 | I Y<RCDATBEG W !,"ENDING MONTH MUST BE GREATER THAN STARTING MONTH!" G MONTHSEL
|
|---|
| 110 | S RCDATEND=$E(Y,1,5)_"32"
|
|---|
| 111 | ;
|
|---|
| 112 | S Y=RCDATBEG D DD^%DT W !,"--- Selected date range from ",Y," to "
|
|---|
| 113 | S Y=$E(RCDATEND,1,5)_"00" D DD^%DT W Y," ---"
|
|---|
| 114 | Q
|
|---|
