| 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
 | 
|---|