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

BARRTAR2.m

Go to the documentation of this file. 
  1. BARRTAR2 ; IHS/SD/LSL - Transaction report ;08/20/2008
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**1,7**;MAR 27,2007
  1.  ; MODIFIED XTMP FILE NAME TO TMP TO MEET SAC REQUIREMENTS;MRS:BAR*1.8*7 IM29892
  1.  ; IHS/ASDS/LSL - 10/05/00 - Routine created
  1.  ;     Detail print of Transaction report
  1.  ;
  1.  ; IHS/SD/LSL - 07/10/02 - V1.6 Patch 2
  1.  ;     Modified to print missing clinics and visit types
  1.  ;
  1.  ; IHS/SD/LSL - 10/24/02 - V1.7 - PAB-1002-90130
  1.  ;      Modified to accomodate DUZ(2) subscript
  1.  ;      
  1.  ;    IHS/SD/RTL - 5/23/05 - V1.8 Patch 1 - IM17362
  1.  ;      TAR report bombing - missing collection batch
  1.  ;        
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. DETAIL ; EP
  1.  ; Print Detail
  1.  S BAR("COL")="W !,""Bill Number"",?15,""PAY-AMT"",?26,""PRV-CRD"",?37,""REFUND"",?48,""PAYMENT"",?59,""BILL AMT"",?70,""ADJUSTMENT"""
  1.  S BAR("HD",0)="DETAIL Transaction"_$P(BAR("HD",0),"Transaction",2,99)
  1.  D HDB                    ; Page and column header
  1.  F I=0:1:5 D              ; Initialize totals
  1.  . S Y=1
  1.  . F X="PATOT","PCTOT","RTOT","PTOT","BTOT","ATOT" D
  1.  . . S Y=Y+1
  1.  . . S BARV=X_I
  1.  . . S BARV2="BAR("""_BARV_""")"
  1.  . . S @BARV2=0
  1.  K I,Y,X
  1.  S BARDASH="               ---------- ---------- ---------- ---------- ---------- ----------"
  1.  S BAREQUAL="               ========== ========== ========== ========== ========== =========="
  1.  S BAR("AR")=""             ; Initialize A/R Clerk   (1)
  1.  S BAR("L")=""              ; Initialize location    (2)
  1.  S BAR("B")=""              ; Initialize Batch       (3)
  1.  S BAR("IT")=""             ; Initialize Item        (4)
  1.  S BAR("SORT")=""           ; Initialize sort        (5)
  1.  S BAR("ACCT")=""           ; Initialize A/R account (6)
  1.  S BAR("Z")="TMP("_$J_",""BAR-TAR"""
  1.  S BAR="^"_BAR("Z")_")"
  1.  I '$D(@BAR) D  Q         ; No data, message, quit
  1.  . W !!!!!?25,"*** NO DATA TO PRINT ***"
  1.  . D EOP^BARUTL(0)
  1.  ; traverse the temp global...
  1.  F  S BAR=$Q(@BAR) Q:BAR'[BAR("Z")  D  Q:$G(BAR("F1"))
  1.  . I $Y>(IOSL-5) D HD Q:$G(BAR("F1"))  D SUBHD
  1.  . S BAR("TXT")=$P($P(BAR,",",4,99),"""",2)
  1.  . S BAR("TXT")=$P(BAR,",",3)_U_BAR("TXT")  ; Subscipts
  1.  . S BAR("TXTO")=BAR("TXT")
  1.  . S BAR("TXT")=$P(BAR("TXTO"),U)_U_$P(BAR("TXTO"),U,3,99)_U_$P(BAR("TXTO"),U,2)
  1.  . S BAR("NODE")=@BAR                       ; Data
  1.  . S BAR(1)=$P(BAR("NODE"),U)               ; Bill number
  1.  . S BAR(2)=$P(BAR("NODE"),U,2)             ; PAY-AMT
  1.  . S BAR(3)=$P(BAR("NODE"),U,3)             ; PRV-CRD
  1.  . S BAR(4)=$P(BAR("NODE"),U,4)             ; Refund
  1.  . S BAR(5)=$P(BAR("NODE"),U,5)             ; Payment
  1.  . S BAR(6)=$P(BAR("NODE"),U,6)             ; Bill Amount
  1.  . S BAR(7)=$P(BAR("NODE"),U,7)             ; Adjustment
  1.  . I $D(BARY("AR")),BAR("AR")'=$P(BAR("TXT"),U) D
  1.  . . S BAR("L")=""
  1.  . . D SUBHD
  1.  . S BAR("AR")=$P(BAR("TXT"),U)
  1.  . ;;
  1.  . I BAR("L")'=$P(BAR("TXT"),U,2) D
  1.  . . I BAR("L")]"" D
  1.  . . . Q:$G(BAR("F1"))
  1.  . . . W !,BARDASH
  1.  . . . D SUB5,SUB4,SUB3,SUB2,SUB
  1.  . . . W !
  1.  . . W !?10,"Visit Location.......: ",$P(BAR("TXT"),U,2)
  1.  . . S (BAR("B"),BAR("IT"),BAR("SORT"),BAR("ACCT"))=""
  1.  . S BAR("L")=$P(BAR("TXT"),U,2)
  1.  . ;;
  1.  . I BAR("B")'=$P(BAR("TXT"),U,3) D
  1.  . . I BAR("B")]"" D
  1.  . . . Q:$G(BAR("F1"))
  1.  . . . W !,BARDASH
  1.  . . . D SUB5,SUB4,SUB3,SUB2
  1.  . . . W !
  1.  . . W !?10,"Collection Batch.....: "
  1.  . . ;I +$P(BAR("TXT"),U,3) W $P(^BARCOL($P(BAR("TXT"),U,8),$P(BAR("TXT"),U,3),0),U)
  1.  . . I +$P(BAR("TXT"),U,3),$P($G(^BARCOL($P(BAR("TXT"),U,8),$P(BAR("TXT"),U,3),0)),U)'="" D
  1.  . . . W $P($G(^BARCOL($P(BAR("TXT"),U,8),$P(BAR("TXT"),U,3),0)),U)   ;IM17362
  1.  . . E  W $P(BAR("TXT"),U,3)
  1.  . . S (BAR("IT"),BAR("SORT"),BAR("ACCT"))=""
  1.  . S BAR("B")=$P(BAR("TXT"),U,3)
  1.  . ;;
  1.  . I BAR("IT")'=$P(BAR("TXT"),U,4) D
  1.  . . I BAR("IT")]"" D
  1.  . . . Q:$G(BAR("F1"))
  1.  . . . W !,BARDASH
  1.  . . . D SUB5,SUB4,SUB3
  1.  . . . W !
  1.  . . W !?10,"Collection Batch Item: "
  1.  . . ;I +$P(BAR("TXT"),U,4) W $P(^BARCOL($P(BAR("TXT"),U,8),BAR("B"),1,$P(BAR("TXT"),U,4),0),U)
  1.  . . I +$P(BAR("TXT"),U,4),$P($G(^BARCOL($P(BAR("TXT"),U,8),BAR("B"),1,$P(BAR("TXT"),U,4),0)),U)'="" D
  1.  . . . W $P(^BARCOL($P(BAR("TXT"),U,8),BAR("B"),1,$P(BAR("TXT"),U,4),0),U)  ;IM17362
  1.  . . E  W $P(BAR("TXT"),U,4)
  1.  . . S (BAR("SORT"),BAR("ACCT"))=""
  1.  . S BAR("IT")=$P(BAR("TXT"),U,4)
  1.  . ;;
  1.  . I BAR("SORT")'=$P(BAR("TXT"),U,5) D
  1.  . . I BAR("SORT")]"" D
  1.  . . . Q:$G(BAR("F1"))
  1.  . . . W !,BARDASH
  1.  . . . D SUB5,SUB4
  1.  . . . W !
  1.  . . I BARY("SORT")="C" D
  1.  . . . W !?10,"Clinic Type..........: "
  1.  . . . I $P(BAR("TXT"),U,5)=99999 W "NO CLINIC" Q
  1.  . . . W $P(^DIC(40.7,$P(BAR("TXT"),U,5),0),U)
  1.  . . E  D
  1.  . . . W !?10,"Visit Type...........: "
  1.  . . . I $P(BAR("TXT"),U,5)=99999 W "NO VISIT TYPE" Q
  1.  . . . W $P($G(^ABMDVTYP($P(BAR("TXT"),U,5),0)),U)
  1.  . . S BAR("ACCT")=""
  1.  . S BAR("SORT")=$P(BAR("TXT"),U,5)
  1.  . ;;
  1.  . I BAR("ACCT")'=$P(BAR("TXT"),U,6) D
  1.  . . I BAR("ACCT")]"" D
  1.  . . . Q:$G(BAR("F1"))
  1.  . . . W !,BARDASH
  1.  . . . D SUB5
  1.  . . . W !
  1.  . . W !?10,"A/R Account..........: ",$P(BAR("TXT"),U,6),!
  1.  . S BAR("ACCT")=$P(BAR("TXT"),U,6)
  1.  . W !,$E(BAR(1),1,14)                  ; A/R Bill
  1.  . W ?15,$J($FN(BAR(2),",",2),10)       ; PAY-AMT
  1.  . W ?26,$J($FN(BAR(3),",",2),10)       ; PRV-CRD
  1.  . W ?37,$J($FN(BAR(4),",",2),10)       ; Refund
  1.  . W ?48,$J($FN(BAR(5),",",2),10)       ; Payment
  1.  . W ?59,$J($FN(BAR(6),",",2),10)       ; Bill Amt
  1.  . W ?70,$J($FN(BAR(7),",",2),10)       ; Adjustment
  1.  . F I=0:1:5 D                          ; Accumulate totals
  1.  . . S Y=1
  1.  . . F X="PATOT","PCTOT","RTOT","PTOT","BTOT","ATOT" D
  1.  . . . S Y=Y+1
  1.  . . . S BARV=X_I
  1.  . . . S BARV2="BAR("""_BARV_""")"
  1.  . . . S @BARV2=@BARV2+BAR(Y)
  1.  Q:$G(BAR("F1"))
  1.  W !,BARDASH
  1.  D SUB5,SUB4,SUB3,SUB2,SUB,TOT
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. HD ; EP
  1.  D PAZ^BARRUTL
  1.  I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) S BAR("F1")=1 Q
  1. HDB ; EP
  1.  ; Page and column header
  1.  S BAR("PG")=BAR("PG")+1
  1.  S BAR("I")=""
  1.  D WHD^BARRHD                   ; Report header
  1.  X BAR("COL")
  1.  S $P(BAR("DASH"),"=",$S($D(BAR(132)):132,1:80))=""
  1.  W !,BAR("DASH")
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. SUBHD ;
  1.  ; If A/R clerk specified
  1.  Q:'$D(BARY("AR"))
  1.  Q:'+$P(BAR("TXT"),U)
  1.  W !!,"A/R Entry Clerk: ",$P(^VA(200,$P(BAR("TXT"),U),0),U)
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. SUB ;
  1.  ; Totals by Visit location.
  1.  Q:'BAR("BTOT1")
  1.  W !,"Location Tot:"
  1.  W ?15,$J($FN(BAR("PATOT1"),",",2),10)
  1.  W ?26,$J($FN(BAR("PCTOT1"),",",2),10)
  1.  W ?37,$J($FN(BAR("RTOT1"),",",2),10)
  1.  W ?48,$J($FN(BAR("PTOT1"),",",2),10)
  1.  W ?59,$J($FN(BAR("BTOT1"),",",2),10)
  1.  W ?70,$J($FN(BAR("ATOT1"),",",2),10)
  1.  S (BAR("PATOT1"),BAR("PCTOT1"),BAR("RTOT1"),BAR("PTOT1"),BAR("BTOT1"),BAR("ATOT1"))=0
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. SUB2 ;
  1.  ; Totals by Collection Batch
  1.  Q:'BAR("BTOT2")
  1.  W !,"   Batch Tot:"
  1.  W ?15,$J($FN(BAR("PATOT2"),",",2),10)
  1.  W ?26,$J($FN(BAR("PCTOT2"),",",2),10)
  1.  W ?37,$J($FN(BAR("RTOT2"),",",2),10)
  1.  W ?48,$J($FN(BAR("PTOT2"),",",2),10)
  1.  W ?59,$J($FN(BAR("BTOT2"),",",2),10)
  1.  W ?70,$J($FN(BAR("ATOT2"),",",2),10)
  1.  S (BAR("PATOT2"),BAR("PCTOT2"),BAR("RTOT2"),BAR("PTOT2"),BAR("BTOT2"),BAR("ATOT2"))=0
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. SUB3 ;
  1.  ; Totals by Collection Batch Item
  1.  Q:'BAR("BTOT3")
  1.  W !,"    Item Tot:"
  1.  W ?15,$J($FN(BAR("PATOT3"),",",2),10)
  1.  W ?26,$J($FN(BAR("PCTOT3"),",",2),10)
  1.  W ?37,$J($FN(BAR("RTOT3"),",",2),10)
  1.  W ?48,$J($FN(BAR("PTOT3"),",",2),10)
  1.  W ?59,$J($FN(BAR("BTOT3"),",",2),10)
  1.  W ?70,$J($FN(BAR("ATOT3"),",",2),10)
  1.  S (BAR("PATOT3"),BAR("PCTOT3"),BAR("RTOT3"),BAR("PTOT3"),BAR("BTOT3"),BAR("ATOT3"))=0
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. SUB4 ;
  1.  ; Totals by Sort type
  1.  Q:'BAR("BTOT4")
  1.  I BARY("SORT")="C" W !,"  Clinic Tot:"
  1.  E  W !,"   Visit Tot"
  1.  W ?15,$J($FN(BAR("PATOT4"),",",2),10)
  1.  W ?26,$J($FN(BAR("PCTOT4"),",",2),10)
  1.  W ?37,$J($FN(BAR("RTOT4"),",",2),10)
  1.  W ?48,$J($FN(BAR("PTOT4"),",",2),10)
  1.  W ?59,$J($FN(BAR("BTOT4"),",",2),10)
  1.  W ?70,$J($FN(BAR("ATOT4"),",",2),10)
  1.  S (BAR("PATOT4"),BAR("PCTOT4"),BAR("RTOT4"),BAR("PTOT4"),BAR("BTOT4"),BAR("ATOT4"))=0
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. SUB5 ;
  1.  ; totals by A/R Account
  1.  Q:'BAR("BTOT5")
  1.  W !,"A/R Acct Tot:"
  1.  W ?15,$J($FN(BAR("PATOT5"),",",2),10)
  1.  W ?26,$J($FN(BAR("PCTOT5"),",",2),10)
  1.  W ?37,$J($FN(BAR("RTOT5"),",",2),10)
  1.  W ?48,$J($FN(BAR("PTOT5"),",",2),10)
  1.  W ?59,$J($FN(BAR("BTOT5"),",",2),10)
  1.  W ?70,$J($FN(BAR("ATOT5"),",",2),10)
  1.  S (BAR("PATOT5"),BAR("PCTOT5"),BAR("RTOT5"),BAR("PTOT5"),BAR("BTOT5"),BAR("ATOT5"))=0
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. TOT ;
  1.  ; Report (a/r clerk) totals
  1.  Q:'BAR("BTOT0")
  1.  W !,BAREQUAL
  1.  W !,"REPORT TOTAL"
  1.  W ?15,$J($FN(BAR("PATOT0"),",",2),10)
  1.  W ?26,$J($FN(BAR("PCTOT0"),",",2),10)
  1.  W ?37,$J($FN(BAR("RTOT0"),",",2),10)
  1.  W ?48,$J($FN(BAR("PTOT0"),",",2),10)
  1.   W ?59,$J($FN(BAR("BTOT0"),",",2),10)
  1.   W ?70,$J($FN(BAR("ATOT0"),",",2),10)
  1.  S (BAR("PATOT0"),BAR("PCTOT0"),BAR("RTOT0"),BAR("PTOT0"),BAR("BTOT0"),BAR("ATOT0"))=0
  1.  Q