Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BARRPAY2

BARRPAY2.m

Go to the documentation of this file. 
  1. BARRPAY2   ; IHS/SD/PKD - TOP PAYERS REPORT ; 07/2/2010
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**19**;OCT 26, 2005
  1.  ; Print:  called from BARRPAY
  1.  ; New Reports - Top Payers - PKD 
  1.  Q
  1.  ; *******************************
  1. PRINT ; EP   - 
  1.  ; Need to resort ^TMP($J,"BAR-PAY" by Amount Paid
  1.  S BAR("COL")="W !,"_"""A/R ACCOUNT                      TX CNT        AMOUNT PD           ALLOWABLE"""
  1.  K ^TMP($J,"BAR-PAYS")  ; Sort into this
  1.  K SUBTOT
  1.  N ALLOW,AMT,ARACCT,CNT,DATA,LOC,LOCNM,PAYER,TMP,SUBTOT
  1. SORT  ; sort by high paid amts
  1.  ;"ARACT" ,LOC , PAYER)= COUNT ^ AMOUNT ^ ALLOWED AMT 
  1.  S LOC="" F  S LOC=$O(^TMP($J,"BAR-PAY","ARACT",LOC)) Q:'LOC  D  ;
  1.  . S ARACCT="" F  S ARACCT=$O(^TMP($J,"BAR-PAY","ARACT",LOC,ARACCT),1,TMP) Q:'ARACCT  D  ; TMP contains DATA
  1.  . . S BARACX=$P(^BARAC(DUZ(2),ARACCT,0),U)  ; ADDED LINE
  1.  . . S PAYER=$P(^AUTNINS(+BARACX,0),U,1)_U_ARACCT  ; allow for dupl names
  1.  . . S LOCNM=$P(^BAR(90052.05,DUZ(2),LOC,0),U,4)
  1.  . . S CNT=$P(TMP,U),AMT=$P(TMP,U,2),ALLOW=$P(TMP,U,3)
  1.  . . S ^TMP($J,"BAR-PAYS",-AMT,LOCNM,PAYER)=CNT_U_ALLOW  ;
  1. SUBSORT  ; Sort by Visit Location & Additional Requested sort
  1.  ;  . S ^TMP($J,"BAR-PAY",BARTAG,VISITLOC,SORT(1),BARPAYER)=TMP
  1.   S BARTAG="" F  S BARTAG=$O(^TMP($J,"BAR-PAY",BARTAG)) Q:BARTAG=""  D  Q:$G(BAR("F1"))
  1.  . S LOC="" F  S LOC=$O(^TMP($J,"BAR-PAY",BARTAG,LOC)) Q:'LOC  D  Q:$G(BAR("F1"))
  1.  . . S SORT(1)=""  F  S SORT(1)=$O(^TMP($J,"BAR-PAY",BARTAG,LOC,SORT(1))) Q:SORT(1)=""  D  Q:$G(BAR("F1"))
  1.  . . . S ARACCT="" F  S ARACCT=$O(^TMP($J,"BAR-PAY",BARTAG,LOC,SORT(1),ARACCT),1,DATA) Q:ARACCT=""  D  Q:$G(BAR("F1"))  ;
  1.  . . . . S BARACX=$P(^BARAC(DUZ(2),ARACCT,0),U)
  1.  . . . . S CNT=$P(DATA,U),AMT=$P(DATA,U,2),ALLOW=$P(DATA,U,3)
  1.  . . . . S PAYER=$P(^AUTNINS(+BARACX,0),U,1)_U_ARACCT  ; allow for dupl names
  1.  . . . . S LOCNM=$P(^BAR(90052.05,DUZ(2),LOC,0),U,4)
  1.  . . . . S ^TMP($J,"BAR-PAYS1",SORT(1),-AMT,LOCNM,PAYER)=CNT_U_ALLOW
  1.  S BAR("PG")=0
  1.  D HDB^BARRPSRB
  1.  ;
  1.  N LIMIT,AMT
  1.  I $D(SUBNM) D PRTSBTL
  1.  K SUBTOT  Q:$G(BAR("F1"))
  1. GRTOT S AMT="" F LIMIT=1:1:BAR("NBR TO PRINT") S AMT=$O(^TMP($J,"BAR-PAYS",AMT)) Q:AMT=""  D  Q:$G(BAR("F1"))
  1.  . S LOCNM="" F  S LOCNM=$O(^TMP($J,"BAR-PAYS",AMT,LOCNM)) Q:LOCNM=""  D  Q:$G(BAR("F1"))
  1.  . . S PAYER="" F  S PAYER=$O(^TMP($J,"BAR-PAYS",AMT,LOCNM,PAYER),1,DATA) Q:PAYER=""  D  Q:$G(BAR("F1"))
  1.  . . . I $Y>(IOSL-5) D HD^BARRPSRB Q:$G(BAR("F1"))
  1.  . . . W !,$P(PAYER,U),?32,$J($P(DATA,U),7),?40,$J($FN(-AMT,",",2),16),?59,$J($FN($P(DATA,U,2),",",2),16)  ; strips off the AUTIN IEN
  1.  . . . I $I(SUBTOT("CNT"),$P(DATA,U))  ; Increment totals
  1.  . . . I $I(SUBTOT("AMT"),-AMT)
  1.  . . . I $I(SUBTOT("ALLOW"),$P(DATA,U,2))
  1.  . . . I $Y>(IOSL-5) D HD^BARRPSRB Q:$G(BAR("F1"))
  1.  Q:$G(BAR("F1"))
  1.  I $D(SUBTOT) D
  1.  . W !!,"GRAND TOTALS",?33,$J($FN($G(SUBTOT("CNT")),","),6)
  1.  . W ?40,$J($FN($G(SUBTOT("AMT")),",",2),16),?59,$J($FN($G(SUBTOT("ALLOW")),",",2),16),!!
  1.  E  W !!!,"Nothing to report",!!!
  1.  D PAZ^BARRUTL
  1.  Q
  1. PRTSBTL  ;
  1.  N SUBTOTG  ; Grand Totals
  1.  S SORT(1)="" F  S SORT(1)=$O(^TMP($J,"BAR-PAYS1",SORT(1))) Q:SORT(1)=""  D  D SORTSUB Q:$G(BAR("F1"))
  1.  . I $Y>(IOSL-5) D HD^BARRPSRB Q:$G(BAR("F1"))
  1.  . W !,?10,SUBNM,SORT(1)
  1.  . S AMT=""  F LIMIT=1:1:BAR("NBR TO PRINT") S AMT=$O(^TMP($J,"BAR-PAYS1",SORT(1),AMT)) Q:AMT=""  D  Q:$G(BAR("F1"))
  1.  . . S VLOC=""  S VLOC=$O(^TMP($J,"BAR-PAYS1",SORT(1),AMT,VLOC)) Q:VLOC=""  D  Q:$G(BAR("F1"))
  1.  . . . S PAYER="" F  S PAYER=$O(^TMP($J,"BAR-PAYS1",SORT(1),AMT,VLOC,PAYER),1,DATA) Q:PAYER=""  D  Q:$G(BAR("F1"))
  1.  . . . . W !,$P(PAYER,U),?32,$J($FN($P(DATA,U),","),7),?40,$J($FN(-AMT,",",2),16),?59,$J($FN($P(DATA,U,2),",",2),16)  ; strips off the IEN of Payer
  1.  . . . . I $I(SUBTOT("CNT"),$P(DATA,U)),$I(SUBTOTG("GRCNT"),$P(DATA,U))  ; $Increment totals- Rpt Sort & Grand
  1.  . . . . I $I(SUBTOT("AMT"),-AMT),$I(SUBTOTG("GRAMT"),-AMT)
  1.  . . . . I $I(SUBTOT("ALLOW"),$P(DATA,U,2)),$I(SUBTOTG("GRALLOW"),$P(DATA,U,2))
  1.  . . . . I $Y>(IOSL-5) D HD^BARRPSRB Q:$G(BAR("F1"))
  1.  Q:$G(BAR("F1"))
  1.  I $D(SUBTOTG) D
  1.  . W !!,"TOTALS",?33,$J($FN($G(SUBTOTG("GRCNT")),","),6)
  1.  . W ?40,$J($FN($G(SUBTOTG("GRAMT")),",",2),16),?59,$J($FN($G(SUBTOTG("GRALLOW")),",",2),16),!!
  1.  D PAZ^BARRUTL I $Y>(IOSL-5) D HDB^BARRPSRB
  1.   Q
  1.  ; 
  1. SORTSUB  ;
  1.  Q:'$D(SUBTOT)
  1.  W !,?5,"SUB-TOTALS",?33,$J($FN($G(SUBTOT("CNT")),","),6),?40,$J($FN($G(SUBTOT("AMT")),",",2),16),?59,$J($FN($G(SUBTOT("ALLOW")),",",2),16),!
  1.  K SUBTOT
  1.  I $Y>(IOSL-5) D HD^BARRPSRB Q:$G(BAR("F1"))
  1.  Q