RCYPAY ;WISC/LDB-Date Sorted Payment report ;18 Aug 97
V ;;4.5;Accounts Receivable;**91**;Mar 20, 1995
N ADM,AMT,BILL,CAT,CNT,DAT,DATE,DATESTRT,DATEEND,DATEX,DATEY,INT,LN,NOW,OUT,PG,POP,PRIN,RECPT,SUM,TN,TN0,TN1,TN3,TOT,TYP,X,Y,Z,ZTDESC,ZTRTN,ZTSAVE,%ZIS
K ^TMP($J,"PAY"),^TMP($J,"CAT")
;
; select date range
D DATESEL("PAYMENT POSTED") I '$G(DATEEND) Q
S DATEEND=DATEEND+.99
;
; select summary or detail
S DIR(0)="S^S:SUMMARY;D:DETAILED",DIR("A")="Summary or Detailed ",DIR("B")="S",DIR("?")="Detailed will include individual bill amounts."
D ^DIR Q:$D(DIRUT)
K DIR
S SUM=Y
;
CAT ;select category
K DIC S Y=0
W !,"CATEGORY OF BILL: "_$S('$O(^TMP($J,"CAT",0)):"ALL// ",1:"")
R X:DTIME I '$T!(X="^") Q
I ((X="")!(X="ALL")),'$O(^TMP($J,"CAT",0)) S (CAT,X)="ALL" S ^TMP($J,"CAT",0)="ALL" G QUE
S DIC="^PRCA(430.2,",DIC(0)="QEMZ"
D ^DIC S CAT=+Y
I X["?" W !!,"Enter 'ALL' for all categories or category name.",! G CAT
I CAT'="ALL",(+CAT>0) S ^TMP($J,"CAT",+CAT)="" G CAT
I X="" G QUE
Q:X="^"
G:+CAT<0 CAT
; select device
QUE W !,"This report requires 132 column display."
W ! S %ZIS="Q" D ^%ZIS Q:POP
I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK Q
. S ZTDESC="Date Sorted Payment Report",ZTRTN="DQ^RCYPAY"
. S (ZTSAVE("DATESTRT"),ZTSAVE("DATEEND"),ZTSAVE("SUM"),ZTSAVE("^TMP($J,"))="",ZTSAVE("ZTREQ")="@"
W !!,"<*> please wait <*>"
DQ D PROC D:SUM="D" DPRNT D:SUM="S" SPRNT
D ^%ZISC K ^TMP($J,"PAY"),^TMP($J,"CAT") Q
;
PROC ; report (queue) starts here
U IO
F TYP=2,34 S DAT=DATESTRT-.01 F S DAT=$O(^PRCA(433,"AT",TYP,DAT)) Q:'DAT!(DAT>DATEEND) D
.S TN=0 F S TN=$O(^PRCA(433,"AT",TYP,DAT,TN)) Q:'TN D
..S TN0=$G(^PRCA(433,+TN,0))
..S TN1=$G(^PRCA(433,+TN,1))
..S TN3=$G(^PRCA(433,+TN,3))
..S BILL=$P(TN0,"^",2) Q:'BILL S CAT=$P($G(^PRCA(430,+BILL,0)),"^",2) Q:'CAT
..I $G(^TMP($J,"CAT",0))'="ALL" Q:'$D(^TMP($J,"CAT",CAT))
..S RECPT=$P(TN1,"^",3)
..S DATE=$P(TN1,"^")
..S AMT=$P(TN1,"^",5),PRIN=+TN3,INT=$P(TN3,"^",2),ADM=$P(TN3,"^",3)
..S ^TMP($J,"PAY",CAT,BILL,TN)=DATE_"/"_DAT_"^"_RECPT_"^"_AMT_"^"_PRIN_"^"_INT_"^"_ADM
TOT S CAT=0 F S CAT=$O(^TMP($J,"PAY",CAT)) Q:'CAT D
.S ^TMP($J,"PAY",CAT,"TOT")=0
.S BILL=0 F S BILL=$O(^TMP($J,"PAY",CAT,BILL)) Q:'BILL D
..S TN=0 F S TN=$O(^TMP($J,"PAY",CAT,BILL,TN)) Q:'TN D
...F Z=2:1:5 S $P(^TMP($J,"PAY",CAT,"TOT"),"^",Z-1)=$P(^TMP($J,"PAY",CAT,BILL,TN),"^",Z+1)+$P(^TMP($J,"PAY",CAT,"TOT"),"^",Z-1)
...F X=1:1:4 S $P(^TMP($J,"PAY","TOT"),"^",X)=$P($G(^TMP($J,"PAY",CAT,"TOT")),"^",X)+$P($G(^TMP($J,"PAY","TOT")),"^",X)
;
;start print
S (OUT,PG)=0
S Y=DATESTRT D DD^%DT S DATEX=Y
S Y=DATEEND D DD^%DT S DATEY=$P(Y,"@")
D NOW^%DTC S Y=% D DD^%DT S NOW=Y
I $E(IOST,1,2)="C" W @IOF
D HDR D:SUM="S" HDR2 D:SUM="D" HDR1
Q
;
HDR ;header
W:$E(IOST,1,2)="C-" @IOF
S PG=PG+1
W !,"DATE SORTED REPORT"_$S(SUM="D":" Detailed",1:" Summary")
W ?45,NOW,?68,"PAGE ",PG
W !,?20,"FOR DATES: ",DATEX," - ",DATEY
S LN="",$P(LN,"-",IOM)=""
;W !,LN
Q
;
HDR1 ;detailed header
W !,"BILL",?13,"POSTED DATE",?25,"PAYMENT DATE",?38,"RECEIPT",?54,"AMOUNT",?69,"PRIN",?83,"INT",?95,"ADM"
W !,LN
Q
;
HDR2 ;summary header
W !,?26,"AMOUNT",?37,"PRIN",?46,"INT",?57,"ADM"
W !,LN
Q
;
DPRNT ;print
S ^TMP($J,"PAY","TOT")=0
S (CAT,CNT,CNT(2),OUT)=0 F S CAT=$O(^TMP($J,"PAY",CAT)) Q:'CAT!OUT D W !
.F X=1:1:4 S $P(^TMP($J,"PAY","TOT"),"^",X)=$P($G(^TMP($J,"PAY","TOT")),"^",X)+$P($G(^TMP($J,"PAY",CAT,"TOT")),"^",X)
.W !,"CATEGORY: ",$P($G(^PRCA(430.2,+CAT,0)),"^")
.S (CNT,CNT(1),BILL)=0 F S BILL=$O(^TMP($J,"PAY",CAT,BILL)) Q:BILL=""!OUT D
..S:BILL'="TOT" CNT=CNT+1
..I BILL="TOT" D
...W !,"TOTAL BILLS: ",CNT,?52,$J($P(^TMP($J,"PAY",CAT,"TOT"),"^"),9,2)
...W ?65,$J($P(^TMP($J,"PAY",CAT,"TOT"),"^",2),9,2),?78,$J($P(^("TOT"),"^",3),8,2),?90,$J($P(^("TOT"),"^",4),8,2)
...S TOT=^TMP($J,"PAY",CAT,"TOT")
...W !,"TOTAL PAYMENTS:",?52,$J(CNT(1),9),?65,$J(CNT(1),9),?77,$J(CNT(1),9),?89,$J(CNT(1),9)
...W !,"SUBMEAN:"
...W ?52,$S($P(TOT,"^"):$J($P(TOT,"^")/CNT(1),9,2),1:"")
...W ?65,$S($P(TOT,"^",2):$J($P(TOT,"^",2)/CNT(1),9,2),1:"")
...W ?77,$S($P(TOT,"^",3):$J($P(TOT,"^",3)/CNT(1),9,2),1:"")
...W ?89,$S($P(TOT,"^",4):$J($P(TOT,"^",4)/CNT(1),9,2),1:"")
..S TN=0 F S TN=$O(^TMP($J,"PAY",CAT,BILL,TN)) Q:'TN!OUT D
...S CNT(1)=CNT(1)+1,CNT(2)=CNT(2)+1
...S TN0=^TMP($J,"PAY",CAT,BILL,TN)
...W !,$P($G(^PRCA(430,+BILL,0)),"^")
...W ?13 S Y=$P($P(TN0,"^"),"/",2) X ^DD("DD") W Y
...Q:OUT S Y=$P($P(TN0,"^"),"/") X ^DD("DD") W ?26,Y
...W ?38,$P(TN0,"^",2),?52,$J($P(TN0,"^",3),9,2),?65,$J($P(TN0,"^",4),9,2),?78,$J($P(TN0,"^",5),8,2),?90,$J($P(TN0,"^",6),8,2)
..Q:OUT I $Y+10>IOSL D
...N DIR,DIRUT
...I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR S:$D(DIRUT) OUT=1
...Q:OUT W @IOF D HDR,HDR1
S TOT=^TMP($J,"PAY","TOT")
Q:OUT W !,"TOTAL:",?52,$J($P(TOT,"^"),9,2)
W ?65,$J($P(TOT,"^",2),9,2),?77,$J($P(TOT,"^",3),9,2),?89,$J($P(TOT,"^",4),9,2)
W !,"COUNT",?52,$J(CNT(2),9),?65,$J(CNT(2),9),?77,$J(CNT(2),9),?89,$J(CNT(2),9)
W !,"MEAN"
W ?52,$S($P(TOT,"^"):$J($P(TOT,"^")/CNT(2),9,2),1:"")
W ?65,$S($P(TOT,"^",2):$J($P(TOT,"^",2)/CNT(2),9,2),1:"")
W ?77,$S($P(TOT,"^",3):$J($P(TOT,"^",3)/CNT(2),9,2),1:"")
W ?89,$S($P(TOT,"^",4):$J($P(TOT,"^",4)/CNT(2),9,2),1:"")
W:$O(^TMP($J,"PAY",0))="" !?30,"NONE IN THIS DATE RANGE"
I $E(IOST,1,2)="C-" R !,"PRESS RETURN TO CONTINUE",X:DTIME
D ^%ZISC
K ^TMP($J,"PAY")
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
;
;
SPRNT ;Print Summary
S ^TMP($J,"PAY","TOT")=0
S (CAT,CNT(2))=0 F S CAT=$O(^TMP($J,"PAY",CAT)) Q:'CAT!(OUT) D
.I $Y+7>IOSL D
..I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR S:$D(DIRUT) OUT=1
..Q:OUT W @IOF D HDR,HDR2
.Q:OUT
.W !!,"CATEGORY: ",$P(^PRCA(430.2,+CAT,0),"^")
.W !,"TOTAL BILLS: "
.S (BILL,CNT)=0 F S BILL=$O(^TMP($J,"PAY",CAT,BILL)) Q:'BILL S CNT=CNT+1
.W CNT
.S (CNT(1),BILL,TN)=0 F S BILL=$O(^TMP($J,"PAY",CAT,BILL)) Q:'BILL D
..S TN=0 F S TN=$O(^TMP($J,"PAY",CAT,BILL,TN)) Q:'TN S CNT(1)=CNT(1)+1,CNT(2)=CNT(2)+1
.S TOT=^TMP($J,"PAY",CAT,"TOT")
.W ?22,$J($P(TOT,"^"),9,2),?33,$J($P(TOT,"^",2),9,2),?43,$J($P(TOT,"^",3),8,2),?54,$J($P(TOT,"^",4),8,2)
.F X=1:1:4 S $P(^TMP($J,"PAY","TOT"),"^",X)=$P(TOT,"^",X)+$P($G(^TMP($J,"PAY","TOT")),"^",X)
.W !,"TOTAL PAYMENTS",?22,$J(CNT(1),9),?33,$J(CNT(1),9),?41,$J(CNT(1),9),?53,$J(CNT(1),9)
.W !,"SUBMEAN",?22,$S($P(TOT,"^"):$J($P(TOT,"^")/CNT(1),9,2),1:"")
.W ?33,$S($P(TOT,"^",2):$J($P(TOT,"^",2)/CNT(1),9,2),1:"")
.W ?42,$S($P(TOT,"^",3):$J($P(TOT,"^",3)/CNT(1),9,2),1:"")
.W ?53,$S($P(TOT,"^",4):$J($P(TOT,"^",4)/CNT(1),9,2),1:"")
S TOT=^TMP($J,"PAY","TOT")
Q:OUT W !!,"TOTAL",?22,$J($P(TOT,"^"),9,2),?33,$J($P(TOT,"^",2),9,2)
W ?42,$J($P(TOT,"^",3),9,2),?53,$J($P(TOT,"^",4),9,2)
W !,"COUNT",?22,$J(CNT(2),9),?33,$J(CNT(2),9),?42,$J(CNT(2),9),?53,$J(CNT(2),9)
W !,"MEAN",?22,$S($P(TOT,"^"):$J($P(TOT,"^")/CNT(2),9,2),1:"")
W ?33,$S($P(TOT,"^",2):$J($P(TOT,"^",2)/CNT(2),9,2),1:"")
W ?42,$S($P(TOT,"^",3):$J($P(TOT,"^",3)/CNT(2),9,2),1:"")
W ?53,$S($P(TOT,"^",4):$J($P(TOT,"^",4)/CNT(2),9,2),1:"")
W:$O(^TMP($J,"PAY",0))="" !?30,"NONE IN THIS DATE RANGE"
I $E(IOST,1,2)="C-" R !,"PRESS RETURN TO CONTINUE",X:DTIME
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCYPAY 7994 printed Oct 16, 2024@17:50:49 Page 2
RCYPAY ;WISC/LDB-Date Sorted Payment report ;18 Aug 97
V ;;4.5;Accounts Receivable;**91**;Mar 20, 1995
+1 NEW ADM,AMT,BILL,CAT,CNT,DAT,DATE,DATESTRT,DATEEND,DATEX,DATEY,INT,LN,NOW,OUT,PG,POP,PRIN,RECPT,SUM,TN,TN0,TN1,TN3,TOT,TYP,X,Y,Z,ZTDESC,ZTRTN,ZTSAVE,%ZIS
+2 KILL ^TMP($JOB,"PAY"),^TMP($JOB,"CAT")
+3 ;
+4 ; select date range
+5 DO DATESEL("PAYMENT POSTED")
IF '$GET(DATEEND)
QUIT
+6 SET DATEEND=DATEEND+.99
+7 ;
+8 ; select summary or detail
+9 SET DIR(0)="S^S:SUMMARY;D:DETAILED"
SET DIR("A")="Summary or Detailed "
SET DIR("B")="S"
SET DIR("?")="Detailed will include individual bill amounts."
+10 DO ^DIR
if $DATA(DIRUT)
QUIT
+11 KILL DIR
+12 SET SUM=Y
+13 ;
CAT ;select category
+1 KILL DIC
SET Y=0
+2 WRITE !,"CATEGORY OF BILL: "_$SELECT('$ORDER(^TMP($JOB,"CAT",0)):"ALL// ",1:"")
+3 READ X:DTIME
IF '$TEST!(X="^")
QUIT
+4 IF ((X="")!(X="ALL"))
IF '$ORDER(^TMP($JOB,"CAT",0))
SET (CAT,X)="ALL"
SET ^TMP($JOB,"CAT",0)="ALL"
GOTO QUE
+5 SET DIC="^PRCA(430.2,"
SET DIC(0)="QEMZ"
+6 DO ^DIC
SET CAT=+Y
+7 IF X["?"
WRITE !!,"Enter 'ALL' for all categories or category name.",!
GOTO CAT
+8 IF CAT'="ALL"
IF (+CAT>0)
SET ^TMP($JOB,"CAT",+CAT)=""
GOTO CAT
+9 IF X=""
GOTO QUE
+10 if X="^"
QUIT
+11 if +CAT<0
GOTO CAT
+12 ; select device
QUE WRITE !,"This report requires 132 column display."
+1 WRITE !
SET %ZIS="Q"
DO ^%ZIS
if POP
QUIT
+2 IF $DATA(IO("Q"))
Begin DoDot:1
+3 SET ZTDESC="Date Sorted Payment Report"
SET ZTRTN="DQ^RCYPAY"
+4 SET (ZTSAVE("DATESTRT"),ZTSAVE("DATEEND"),ZTSAVE("SUM"),ZTSAVE("^TMP($J,"))=""
SET ZTSAVE("ZTREQ")="@"
End DoDot:1
DO ^%ZTLOAD
KILL IO("Q"),ZTSK
QUIT
+5 WRITE !!,"<*> please wait <*>"
DQ DO PROC
if SUM="D"
DO DPRNT
if SUM="S"
DO SPRNT
+1 DO ^%ZISC
KILL ^TMP($JOB,"PAY"),^TMP($JOB,"CAT")
QUIT
+2 ;
PROC ; report (queue) starts here
+1 USE IO
+2 FOR TYP=2,34
SET DAT=DATESTRT-.01
FOR
SET DAT=$ORDER(^PRCA(433,"AT",TYP,DAT))
if 'DAT!(DAT>DATEEND)
QUIT
Begin DoDot:1
+3 SET TN=0
FOR
SET TN=$ORDER(^PRCA(433,"AT",TYP,DAT,TN))
if 'TN
QUIT
Begin DoDot:2
+4 SET TN0=$GET(^PRCA(433,+TN,0))
+5 SET TN1=$GET(^PRCA(433,+TN,1))
+6 SET TN3=$GET(^PRCA(433,+TN,3))
+7 SET BILL=$PIECE(TN0,"^",2)
if 'BILL
QUIT
SET CAT=$PIECE($GET(^PRCA(430,+BILL,0)),"^",2)
if 'CAT
QUIT
+8 IF $GET(^TMP($JOB,"CAT",0))'="ALL"
if '$DATA(^TMP($JOB,"CAT",CAT))
QUIT
+9 SET RECPT=$PIECE(TN1,"^",3)
+10 SET DATE=$PIECE(TN1,"^")
+11 SET AMT=$PIECE(TN1,"^",5)
SET PRIN=+TN3
SET INT=$PIECE(TN3,"^",2)
SET ADM=$PIECE(TN3,"^",3)
+12 SET ^TMP($JOB,"PAY",CAT,BILL,TN)=DATE_"/"_DAT_"^"_RECPT_"^"_AMT_"^"_PRIN_"^"_INT_"^"_ADM
End DoDot:2
End DoDot:1
TOT SET CAT=0
FOR
SET CAT=$ORDER(^TMP($JOB,"PAY",CAT))
if 'CAT
QUIT
Begin DoDot:1
+1 SET ^TMP($JOB,"PAY",CAT,"TOT")=0
+2 SET BILL=0
FOR
SET BILL=$ORDER(^TMP($JOB,"PAY",CAT,BILL))
if 'BILL
QUIT
Begin DoDot:2
+3 SET TN=0
FOR
SET TN=$ORDER(^TMP($JOB,"PAY",CAT,BILL,TN))
if 'TN
QUIT
Begin DoDot:3
+4 FOR Z=2:1:5
SET $PIECE(^TMP($JOB,"PAY",CAT,"TOT"),"^",Z-1)=$PIECE(^TMP($JOB,"PAY",CAT,BILL,TN),"^",Z+1)+$PIECE(^TMP($JOB,"PAY",CAT,"TOT"),"^",Z-1)
+5 FOR X=1:1:4
SET $PIECE(^TMP($JOB,"PAY","TOT"),"^",X)=$PIECE($GET(^TMP($JOB,"PAY",CAT,"TOT")),"^",X)+$PIECE($GET(^TMP($JOB,"PAY","TOT")),"^",X)
End DoDot:3
End DoDot:2
End DoDot:1
+6 ;
+7 ;start print
+8 SET (OUT,PG)=0
+9 SET Y=DATESTRT
DO DD^%DT
SET DATEX=Y
+10 SET Y=DATEEND
DO DD^%DT
SET DATEY=$PIECE(Y,"@")
+11 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET NOW=Y
+12 IF $EXTRACT(IOST,1,2)="C"
WRITE @IOF
+13 DO HDR
if SUM="S"
DO HDR2
if SUM="D"
DO HDR1
+14 QUIT
+15 ;
HDR ;header
+1 if $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
+2 SET PG=PG+1
+3 WRITE !,"DATE SORTED REPORT"_$SELECT(SUM="D":" Detailed",1:" Summary")
+4 WRITE ?45,NOW,?68,"PAGE ",PG
+5 WRITE !,?20,"FOR DATES: ",DATEX," - ",DATEY
+6 SET LN=""
SET $PIECE(LN,"-",IOM)=""
+7 ;W !,LN
+8 QUIT
+9 ;
HDR1 ;detailed header
+1 WRITE !,"BILL",?13,"POSTED DATE",?25,"PAYMENT DATE",?38,"RECEIPT",?54,"AMOUNT",?69,"PRIN",?83,"INT",?95,"ADM"
+2 WRITE !,LN
+3 QUIT
+4 ;
HDR2 ;summary header
+1 WRITE !,?26,"AMOUNT",?37,"PRIN",?46,"INT",?57,"ADM"
+2 WRITE !,LN
+3 QUIT
+4 ;
DPRNT ;print
+1 SET ^TMP($JOB,"PAY","TOT")=0
+2 SET (CAT,CNT,CNT(2),OUT)=0
FOR
SET CAT=$ORDER(^TMP($JOB,"PAY",CAT))
if 'CAT!OUT
QUIT
Begin DoDot:1
+3 FOR X=1:1:4
SET $PIECE(^TMP($JOB,"PAY","TOT"),"^",X)=$PIECE($GET(^TMP($JOB,"PAY","TOT")),"^",X)+$PIECE($GET(^TMP($JOB,"PAY",CAT,"TOT")),"^",X)
+4 WRITE !,"CATEGORY: ",$PIECE($GET(^PRCA(430.2,+CAT,0)),"^")
+5 SET (CNT,CNT(1),BILL)=0
FOR
SET BILL=$ORDER(^TMP($JOB,"PAY",CAT,BILL))
if BILL=""!OUT
QUIT
Begin DoDot:2
+6 if BILL'="TOT"
SET CNT=CNT+1
+7 IF BILL="TOT"
Begin DoDot:3
+8 WRITE !,"TOTAL BILLS: ",CNT,?52,$JUSTIFY($PIECE(^TMP($JOB,"PAY",CAT,"TOT"),"^"),9,2)
+9 WRITE ?65,$JUSTIFY($PIECE(^TMP($JOB,"PAY",CAT,"TOT"),"^",2),9,2),?78,$JUSTIFY($PIECE(^("TOT"),"^",3),8,2),?90,$JUSTIFY($PIECE(^("TOT"),"^",4),8,2)
+10 SET TOT=^TMP($JOB,"PAY",CAT,"TOT")
+11 WRITE !,"TOTAL PAYMENTS:",?52,$JUSTIFY(CNT(1),9),?65,$JUSTIFY(CNT(1),9),?77,$JUSTIFY(CNT(1),9),?89,$JUSTIFY(CNT(1),9)
+12 WRITE !,"SUBMEAN:"
+13 WRITE ?52,$SELECT($PIECE(TOT,"^"):$JUSTIFY($PIECE(TOT,"^")/CNT(1),9,2),1:"")
+14 WRITE ?65,$SELECT($PIECE(TOT,"^",2):$JUSTIFY($PIECE(TOT,"^",2)/CNT(1),9,2),1:"")
+15 WRITE ?77,$SELECT($PIECE(TOT,"^",3):$JUSTIFY($PIECE(TOT,"^",3)/CNT(1),9,2),1:"")
+16 WRITE ?89,$SELECT($PIECE(TOT,"^",4):$JUSTIFY($PIECE(TOT,"^",4)/CNT(1),9,2),1:"")
End DoDot:3
+17 SET TN=0
FOR
SET TN=$ORDER(^TMP($JOB,"PAY",CAT,BILL,TN))
if 'TN!OUT
QUIT
Begin DoDot:3
+18 SET CNT(1)=CNT(1)+1
SET CNT(2)=CNT(2)+1
+19 SET TN0=^TMP($JOB,"PAY",CAT,BILL,TN)
+20 WRITE !,$PIECE($GET(^PRCA(430,+BILL,0)),"^")
+21 WRITE ?13
SET Y=$PIECE($PIECE(TN0,"^"),"/",2)
XECUTE ^DD("DD")
WRITE Y
+22 if OUT
QUIT
SET Y=$PIECE($PIECE(TN0,"^"),"/")
XECUTE ^DD("DD")
WRITE ?26,Y
+23 WRITE ?38,$PIECE(TN0,"^",2),?52,$JUSTIFY($PIECE(TN0,"^",3),9,2),?65,$JUSTIFY($PIECE(TN0,"^",4),9,2),?78,$JUSTIFY($PIECE(TN0,"^",5),8,2),?90,$JUSTIFY($PIECE(TN0,"^",6),8,2)
End DoDot:3
+24 if OUT
QUIT
IF $Y+10>IOSL
Begin DoDot:3
+25 NEW DIR,DIRUT
+26 IF $EXTRACT(IOST,1,2)="C-"
SET DIR(0)="E"
DO ^DIR
if $DATA(DIRUT)
SET OUT=1
+27 if OUT
QUIT
WRITE @IOF
DO HDR
DO HDR1
End DoDot:3
End DoDot:2
End DoDot:1
WRITE !
+28 SET TOT=^TMP($JOB,"PAY","TOT")
+29 if OUT
QUIT
WRITE !,"TOTAL:",?52,$JUSTIFY($PIECE(TOT,"^"),9,2)
+30 WRITE ?65,$JUSTIFY($PIECE(TOT,"^",2),9,2),?77,$JUSTIFY($PIECE(TOT,"^",3),9,2),?89,$JUSTIFY($PIECE(TOT,"^",4),9,2)
+31 WRITE !,"COUNT",?52,$JUSTIFY(CNT(2),9),?65,$JUSTIFY(CNT(2),9),?77,$JUSTIFY(CNT(2),9),?89,$JUSTIFY(CNT(2),9)
+32 WRITE !,"MEAN"
+33 WRITE ?52,$SELECT($PIECE(TOT,"^"):$JUSTIFY($PIECE(TOT,"^")/CNT(2),9,2),1:"")
+34 WRITE ?65,$SELECT($PIECE(TOT,"^",2):$JUSTIFY($PIECE(TOT,"^",2)/CNT(2),9,2),1:"")
+35 WRITE ?77,$SELECT($PIECE(TOT,"^",3):$JUSTIFY($PIECE(TOT,"^",3)/CNT(2),9,2),1:"")
+36 WRITE ?89,$SELECT($PIECE(TOT,"^",4):$JUSTIFY($PIECE(TOT,"^",4)/CNT(2),9,2),1:"")
+37 if $ORDER(^TMP($JOB,"PAY",0))=""
WRITE !?30,"NONE IN THIS DATE RANGE"
+38 IF $EXTRACT(IOST,1,2)="C-"
READ !,"PRESS RETURN TO CONTINUE",X:DTIME
+39 DO ^%ZISC
+40 KILL ^TMP($JOB,"PAY")
+41 QUIT
+42 ;
+43 ;
+44 ;
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 ;
SPRNT ;Print Summary
+1 SET ^TMP($JOB,"PAY","TOT")=0
+2 SET (CAT,CNT(2))=0
FOR
SET CAT=$ORDER(^TMP($JOB,"PAY",CAT))
if 'CAT!(OUT)
QUIT
Begin DoDot:1
+3 IF $Y+7>IOSL
Begin DoDot:2
+4 IF $EXTRACT(IOST,1,2)="C-"
SET DIR(0)="E"
DO ^DIR
if $DATA(DIRUT)
SET OUT=1
+5 if OUT
QUIT
WRITE @IOF
DO HDR
DO HDR2
End DoDot:2
+6 if OUT
QUIT
+7 WRITE !!,"CATEGORY: ",$PIECE(^PRCA(430.2,+CAT,0),"^")
+8 WRITE !,"TOTAL BILLS: "
+9 SET (BILL,CNT)=0
FOR
SET BILL=$ORDER(^TMP($JOB,"PAY",CAT,BILL))
if 'BILL
QUIT
SET CNT=CNT+1
+10 WRITE CNT
+11 SET (CNT(1),BILL,TN)=0
FOR
SET BILL=$ORDER(^TMP($JOB,"PAY",CAT,BILL))
if 'BILL
QUIT
Begin DoDot:2
+12 SET TN=0
FOR
SET TN=$ORDER(^TMP($JOB,"PAY",CAT,BILL,TN))
if 'TN
QUIT
SET CNT(1)=CNT(1)+1
SET CNT(2)=CNT(2)+1
End DoDot:2
+13 SET TOT=^TMP($JOB,"PAY",CAT,"TOT")
+14 WRITE ?22,$JUSTIFY($PIECE(TOT,"^"),9,2),?33,$JUSTIFY($PIECE(TOT,"^",2),9,2),?43,$JUSTIFY($PIECE(TOT,"^",3),8,2),?54,$JUSTIFY($PIECE(TOT,"^",4),8,2)
+15 FOR X=1:1:4
SET $PIECE(^TMP($JOB,"PAY","TOT"),"^",X)=$PIECE(TOT,"^",X)+$PIECE($GET(^TMP($JOB,"PAY","TOT")),"^",X)
+16 WRITE !,"TOTAL PAYMENTS",?22,$JUSTIFY(CNT(1),9),?33,$JUSTIFY(CNT(1),9),?41,$JUSTIFY(CNT(1),9),?53,$JUSTIFY(CNT(1),9)
+17 WRITE !,"SUBMEAN",?22,$SELECT($PIECE(TOT,"^"):$JUSTIFY($PIECE(TOT,"^")/CNT(1),9,2),1:"")
+18 WRITE ?33,$SELECT($PIECE(TOT,"^",2):$JUSTIFY($PIECE(TOT,"^",2)/CNT(1),9,2),1:"")
+19 WRITE ?42,$SELECT($PIECE(TOT,"^",3):$JUSTIFY($PIECE(TOT,"^",3)/CNT(1),9,2),1:"")
+20 WRITE ?53,$SELECT($PIECE(TOT,"^",4):$JUSTIFY($PIECE(TOT,"^",4)/CNT(1),9,2),1:"")
End DoDot:1
+21 SET TOT=^TMP($JOB,"PAY","TOT")
+22 if OUT
QUIT
WRITE !!,"TOTAL",?22,$JUSTIFY($PIECE(TOT,"^"),9,2),?33,$JUSTIFY($PIECE(TOT,"^",2),9,2)
+23 WRITE ?42,$JUSTIFY($PIECE(TOT,"^",3),9,2),?53,$JUSTIFY($PIECE(TOT,"^",4),9,2)
+24 WRITE !,"COUNT",?22,$JUSTIFY(CNT(2),9),?33,$JUSTIFY(CNT(2),9),?42,$JUSTIFY(CNT(2),9),?53,$JUSTIFY(CNT(2),9)
+25 WRITE !,"MEAN",?22,$SELECT($PIECE(TOT,"^"):$JUSTIFY($PIECE(TOT,"^")/CNT(2),9,2),1:"")
+26 WRITE ?33,$SELECT($PIECE(TOT,"^",2):$JUSTIFY($PIECE(TOT,"^",2)/CNT(2),9,2),1:"")
+27 WRITE ?42,$SELECT($PIECE(TOT,"^",3):$JUSTIFY($PIECE(TOT,"^",3)/CNT(2),9,2),1:"")
+28 WRITE ?53,$SELECT($PIECE(TOT,"^",4):$JUSTIFY($PIECE(TOT,"^",4)/CNT(2),9,2),1:"")
+29 if $ORDER(^TMP($JOB,"PAY",0))=""
WRITE !?30,"NONE IN THIS DATE RANGE"
+30 IF $EXTRACT(IOST,1,2)="C-"
READ !,"PRESS RETURN TO CONTINUE",X:DTIME
+31 QUIT
