- RCBMILL ;WISC/RFJ-millennium bill report (generator) ; 27 Jun 2001 11:10 AM
- ;;4.5;Accounts Receivable;**170,203**;Mar 20, 1995
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- N %DT,DEFAULT,RCDATBEG,RCDATEND,RCREPTYP,X,Y
- ;
- ; ask type of report to generate
- W !!,"--- Enter the Type of Report to Generate ---"
- S RCREPTYP=$$ASKTYPE
- I RCREPTYP<1 Q
- ;
- ; ask month year
- I RCREPTYP=1!(RCREPTYP=2)!(RCREPTYP=3) D
- . N RCOFFDT
- . W !!,"--- Enter the Month and Year for the Report ---"
- . S Y=$E($$PREVMONT^RCRJRBD(DT),1,5)_"00" D DD^%DT S DEFAULT=Y
- . S RCOFFDT=3030930 ; The report cannot run for later date
- . S %DT(0)=$S(DT>RCOFFDT:-RCOFFDT,1:-DT)
- . S %DT("A")="Select MONTH YEAR for Report: ",%DT("B")=DEFAULT,%DT="AEMP"
- . D ^%DT I Y<0 Q
- . S RCDATBEG=$E(Y,1,5)_"00",RCDATEND=$E(Y,1,5)_"32"
- ;
- ; ask date range
- I RCREPTYP=4 D MONTHSEL I '$G(RCDATEND) Q
- ;
- I '$G(RCDATEND) 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 Millennium Bill Report Generator",ZTRTN="DQ^RCBMILL"
- . S ZTSAVE("RCREPTYP")="",ZTSAVE("RCDATBEG")="",ZTSAVE("RCDATEND")="",ZTSAVE("ZTREQ")="@"
- W !!,"<*> please wait <*>"
- ;
- DQ ; queued report starts here
- ; requires variable rcdatbeg and rcdatend
- ;
- N %,RCBILLDA,RCCATEG,RCDATE,RCTRANDA,RCTYPE
- K ^TMP("RCBMILL",$J),^TMP($J,"RCBMILLDATA")
- ;
- ; get all payments between the two dates
- F RCTYPE=2,34 D
- . S RCDATE=$E(RCDATBEG,1,5)_"00"
- . F S RCDATE=$O(^PRCA(433,"AT",RCTYPE,RCDATE)) Q:'RCDATE!(RCDATE>RCDATEND) D
- . . S RCTRANDA=0
- . . F S RCTRANDA=$O(^PRCA(433,"AT",RCTYPE,RCDATE,RCTRANDA)) Q:'RCTRANDA D
- . . . S RCBILLDA=+$P($G(^PRCA(433,RCTRANDA,0)),"^",2) I 'RCBILLDA Q
- . . . ;
- . . . ; bill not rx copay
- . . . S RCCATEG=$P($G(^PRCA(430,RCBILLDA,0)),"^",2)
- . . . I RCCATEG'=22,RCCATEG'=23 Q
- . . . ;
- . . . S ^TMP("RCBMILL",$J,RCBILLDA)=""
- ;
- ; loop bills paid during the month and gather transactions
- S RCBILLDA=0 F S RCBILLDA=$O(^TMP("RCBMILL",$J,RCBILLDA)) Q:'RCBILLDA D
- . S %=$$BILLFUND^RCBMILLC(RCBILLDA,RCDATEND)
- ;
- ; set up variables for reports
- N %,%H,%I,RCMOYR,RCMOYRTO,RCNOW,RCPAGE,RCRJFLAG,RCRJLINE,RCSCREEN,X,Y
- S Y=$E(RCDATBEG,1,5)_"00" D DD^%DT S RCMOYR=Y
- S Y=$E(RCDATEND,1,5)_"00" D DD^%DT S RCMOYRTO=Y
- D NOW^%DTC S Y=% D DD^%DT S RCNOW=Y
- S RCPAGE=1
- S RCSCREEN=0 I '$D(ZTQUEUED),IO=IO(0),$E(IOST)="C" S RCSCREEN=1
- ;
- ; print summary report
- I RCREPTYP=1 D SUMMARY^RCBMILL3
- ; print payment detail report
- I RCREPTYP=2 D PRINT^RCBMILL1
- ; print all transaction report
- I RCREPTYP=3 D PRINT^RCBMILL2
- ; print history for date range
- I RCREPTYP=4 D PRINT^RCBMILL4
- ;
- K ^TMP("RCBMILL",$J),^TMP($J,"RCBMILLDATA")
- D ^%ZISC
- Q
- ;
- ;
- ASKTYPE() ; ask type of report
- N DIR,DIRUT,DTOUT,DUOUT,X,Y
- 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"
- S DIR("A")="Select Report to Generate"
- S DIR("B")="Summary"
- D ^DIR
- I $G(DTOUT)!($G(DUOUT)) S Y=-1
- ;
- I Y=3 D
- . W !!,"***** WARNING: THIS WILL USE A LARGE AMOUNT OF PAPER. *****"
- . W !,"***** I RECOMMENDED THAT YOU DO ***NOT*** PRINT THIS *****"
- . W !,"***** REPORT ON A PRINTER. YOU SHOULD CAPTURE THIS *****"
- . W !,"***** TO A FILE ON YOUR PC FOR REVIEW. *****"
- ;
- Q Y
- ;
- ;
- MONTHSEL ; ask starting and ending month
- ; returns rcdatbeg and rcdatend
- N %DT,DEFAULT,X,Y
- K RCDATBEG,RCDATEND
- ;
- W !!,"--- Enter the Starting and Ending Month and Year ---"
- S Y=$E(DT,1,3)_"0100" D DD^%DT S DEFAULT=Y
- S %DT("A")="Select Starting MONTH YEAR: ",%DT("B")=DEFAULT,%DT="AEMP",%DT(0)=-DT D ^%DT I Y<0 Q
- S RCDATBEG=$E(Y,1,5)_"00"
- ;
- S Y=$E(DT,1,5)_"00" D DD^%DT S DEFAULT=Y
- S %DT("A")="Select Ending MONTH YEAR: ",%DT("B")=DEFAULT,%DT="AEMP",%DT(0)=-DT D ^%DT I Y<0 Q
- I Y<RCDATBEG W !,"ENDING MONTH MUST BE GREATER THAN STARTING MONTH!" G MONTHSEL
- S RCDATEND=$E(Y,1,5)_"32"
- ;
- S Y=RCDATBEG D DD^%DT W !,"--- Selected date range from ",Y," to "
- S Y=$E(RCDATEND,1,5)_"00" D DD^%DT W Y," ---"
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCBMILL 4223 printed Mar 13, 2025@20:47:38 Page 2
- RCBMILL ;WISC/RFJ-millennium bill report (generator) ; 27 Jun 2001 11:10 AM
- +1 ;;4.5;Accounts Receivable;**170,203**;Mar 20, 1995
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 NEW %DT,DEFAULT,RCDATBEG,RCDATEND,RCREPTYP,X,Y
- +4 ;
- +5 ; ask type of report to generate
- +6 WRITE !!,"--- Enter the Type of Report to Generate ---"
- +7 SET RCREPTYP=$$ASKTYPE
- +8 IF RCREPTYP<1
- QUIT
- +9 ;
- +10 ; ask month year
- +11 IF RCREPTYP=1!(RCREPTYP=2)!(RCREPTYP=3)
- Begin DoDot:1
- +12 NEW RCOFFDT
- +13 WRITE !!,"--- Enter the Month and Year for the Report ---"
- +14 SET Y=$EXTRACT($$PREVMONT^RCRJRBD(DT),1,5)_"00"
- DO DD^%DT
- SET DEFAULT=Y
- +15 ; The report cannot run for later date
- SET RCOFFDT=3030930
- +16 SET %DT(0)=$SELECT(DT>RCOFFDT:-RCOFFDT,1:-DT)
- +17 SET %DT("A")="Select MONTH YEAR for Report: "
- SET %DT("B")=DEFAULT
- SET %DT="AEMP"
- +18 DO ^%DT
- IF Y<0
- QUIT
- +19 SET RCDATBEG=$EXTRACT(Y,1,5)_"00"
- SET RCDATEND=$EXTRACT(Y,1,5)_"32"
- End DoDot:1
- +20 ;
- +21 ; ask date range
- +22 IF RCREPTYP=4
- DO MONTHSEL
- IF '$GET(RCDATEND)
- QUIT
- +23 ;
- +24 IF '$GET(RCDATEND)
- QUIT
- +25 ;
- +26 ; select device
- +27 WRITE !
- SET %ZIS="Q"
- DO ^%ZIS
- if POP
- QUIT
- +28 IF $DATA(IO("Q"))
- Begin DoDot:1
- +29 SET ZTDESC="AR Millennium Bill Report Generator"
- SET ZTRTN="DQ^RCBMILL"
- +30 SET ZTSAVE("RCREPTYP")=""
- SET ZTSAVE("RCDATBEG")=""
- SET ZTSAVE("RCDATEND")=""
- SET ZTSAVE("ZTREQ")="@"
- End DoDot:1
- DO ^%ZTLOAD
- KILL IO("Q"),ZTSK
- QUIT
- +31 WRITE !!,"<*> please wait <*>"
- +32 ;
- DQ ; queued report starts here
- +1 ; requires variable rcdatbeg and rcdatend
- +2 ;
- +3 NEW %,RCBILLDA,RCCATEG,RCDATE,RCTRANDA,RCTYPE
- +4 KILL ^TMP("RCBMILL",$JOB),^TMP($JOB,"RCBMILLDATA")
- +5 ;
- +6 ; get all payments between the two dates
- +7 FOR RCTYPE=2,34
- Begin DoDot:1
- +8 SET RCDATE=$EXTRACT(RCDATBEG,1,5)_"00"
- +9 FOR
- SET RCDATE=$ORDER(^PRCA(433,"AT",RCTYPE,RCDATE))
- if 'RCDATE!(RCDATE>RCDATEND)
- QUIT
- Begin DoDot:2
- +10 SET RCTRANDA=0
- +11 FOR
- SET RCTRANDA=$ORDER(^PRCA(433,"AT",RCTYPE,RCDATE,RCTRANDA))
- if 'RCTRANDA
- QUIT
- Begin DoDot:3
- +12 SET RCBILLDA=+$PIECE($GET(^PRCA(433,RCTRANDA,0)),"^",2)
- IF 'RCBILLDA
- QUIT
- +13 ;
- +14 ; bill not rx copay
- +15 SET RCCATEG=$PIECE($GET(^PRCA(430,RCBILLDA,0)),"^",2)
- +16 IF RCCATEG'=22
- IF RCCATEG'=23
- QUIT
- +17 ;
- +18 SET ^TMP("RCBMILL",$JOB,RCBILLDA)=""
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +19 ;
- +20 ; loop bills paid during the month and gather transactions
- +21 SET RCBILLDA=0
- FOR
- SET RCBILLDA=$ORDER(^TMP("RCBMILL",$JOB,RCBILLDA))
- if 'RCBILLDA
- QUIT
- Begin DoDot:1
- +22 SET %=$$BILLFUND^RCBMILLC(RCBILLDA,RCDATEND)
- End DoDot:1
- +23 ;
- +24 ; set up variables for reports
- +25 NEW %,%H,%I,RCMOYR,RCMOYRTO,RCNOW,RCPAGE,RCRJFLAG,RCRJLINE,RCSCREEN,X,Y
- +26 SET Y=$EXTRACT(RCDATBEG,1,5)_"00"
- DO DD^%DT
- SET RCMOYR=Y
- +27 SET Y=$EXTRACT(RCDATEND,1,5)_"00"
- DO DD^%DT
- SET RCMOYRTO=Y
- +28 DO NOW^%DTC
- SET Y=%
- DO DD^%DT
- SET RCNOW=Y
- +29 SET RCPAGE=1
- +30 SET RCSCREEN=0
- IF '$DATA(ZTQUEUED)
- IF IO=IO(0)
- IF $EXTRACT(IOST)="C"
- SET RCSCREEN=1
- +31 ;
- +32 ; print summary report
- +33 IF RCREPTYP=1
- DO SUMMARY^RCBMILL3
- +34 ; print payment detail report
- +35 IF RCREPTYP=2
- DO PRINT^RCBMILL1
- +36 ; print all transaction report
- +37 IF RCREPTYP=3
- DO PRINT^RCBMILL2
- +38 ; print history for date range
- +39 IF RCREPTYP=4
- DO PRINT^RCBMILL4
- +40 ;
- +41 KILL ^TMP("RCBMILL",$JOB),^TMP($JOB,"RCBMILLDATA")
- +42 DO ^%ZISC
- +43 QUIT
- +44 ;
- +45 ;
- ASKTYPE() ; ask type of report
- +1 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
- +2 SET 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"
- +3 SET DIR("A")="Select Report to Generate"
- +4 SET DIR("B")="Summary"
- +5 DO ^DIR
- +6 IF $GET(DTOUT)!($GET(DUOUT))
- SET Y=-1
- +7 ;
- +8 IF Y=3
- Begin DoDot:1
- +9 WRITE !!,"***** WARNING: THIS WILL USE A LARGE AMOUNT OF PAPER. *****"
- +10 WRITE !,"***** I RECOMMENDED THAT YOU DO ***NOT*** PRINT THIS *****"
- +11 WRITE !,"***** REPORT ON A PRINTER. YOU SHOULD CAPTURE THIS *****"
- +12 WRITE !,"***** TO A FILE ON YOUR PC FOR REVIEW. *****"
- End DoDot:1
- +13 ;
- +14 QUIT Y
- +15 ;
- +16 ;
- MONTHSEL ; ask starting and ending month
- +1 ; returns rcdatbeg and rcdatend
- +2 NEW %DT,DEFAULT,X,Y
- +3 KILL RCDATBEG,RCDATEND
- +4 ;
- +5 WRITE !!,"--- Enter the Starting and Ending Month and Year ---"
- +6 SET Y=$EXTRACT(DT,1,3)_"0100"
- DO DD^%DT
- SET DEFAULT=Y
- +7 SET %DT("A")="Select Starting MONTH YEAR: "
- SET %DT("B")=DEFAULT
- SET %DT="AEMP"
- SET %DT(0)=-DT
- DO ^%DT
- IF Y<0
- QUIT
- +8 SET RCDATBEG=$EXTRACT(Y,1,5)_"00"
- +9 ;
- +10 SET Y=$EXTRACT(DT,1,5)_"00"
- DO DD^%DT
- SET DEFAULT=Y
- +11 SET %DT("A")="Select Ending MONTH YEAR: "
- SET %DT("B")=DEFAULT
- SET %DT="AEMP"
- SET %DT(0)=-DT
- DO ^%DT
- IF Y<0
- QUIT
- +12 IF Y<RCDATBEG
- WRITE !,"ENDING MONTH MUST BE GREATER THAN STARTING MONTH!"
- GOTO MONTHSEL
- +13 SET RCDATEND=$EXTRACT(Y,1,5)_"32"
- +14 ;
- +15 SET Y=RCDATBEG
- DO DD^%DT
- WRITE !,"--- Selected date range from ",Y," to "
- +16 SET Y=$EXTRACT(RCDATEND,1,5)_"00"
- DO DD^%DT
- WRITE Y," ---"
- +17 QUIT
