- 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 Feb 18, 2025@23:16:22 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
