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 Dec 13, 2024@01:42:58 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
