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

BARRADJ3.m

Go to the documentation of this file. 
  1. BARRADJ3 ; IHS/SD/LSL - TRANSACTION/ADJUSTMENT REPORT ;08/20/2008
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**6,7**;MAY 26, 2008
  1.  Q
  1.  ; MODIFIED XTMP FILE NAME TO TMP TO MEET SAC REQUIREMENTS;MRS:BAR*1.8*7 IM29892
  1.  ; *********************************************************************
  1. SUMM ; EP
  1.  S BAR("COL")="W !,?57,""Amount"",?68,""Transaction"""
  1.  S BAR("COL",0)="W !?33,""Bill Count"",?57,""Billed"",?71,""Amount"""
  1.  S BAR("HD",0)="SUMMARY Transaction"_$P(BAR("HD",0),"Transaction",2,99)
  1.  D HDB^BARRADJ2
  1.  S BARDASH="---------- ----------"
  1.  S BAREQUAL="========== =========="
  1.  ;
  1.  ;INITIALIZE TOTALS
  1.  K VLOCBTOT,TRANBTOT,ADJTBTOT,SORTBTOT,ARBTOT
  1.  K VLOCTTOT,TRANTTOT,ADJTTTOT,SORTTTOT,ARTTOT
  1.  ;
  1.  ;
  1.  S GRANBILL=0  ;BILL AMT GRAND TOT
  1.  S GRANTRAN=0  ;TRANS AMT GRAND TOT
  1.  I '$D(^TMP($J,"BAR-TSRS")) D  Q
  1.  . W $$CJ^XLFSTR("*** NO DATA TO PRINT FOR "_$P($G(^DIC(4,DUZ(2),0)),U)_" ***",IOM)
  1.  . D EOP^BARUTL(0)
  1.  S (BAR("AR"),BAR("OAR"))=""
  1.  F  S BAR("AR")=$O(^TMP($J,"BAR-TSRS",BAR("AR"))) Q:BAR("AR")']""!($G(BAR("F1")))  D
  1.  . I +BAR("AR") W !!,"A/R Entry Clerk: ",$P(^VA(200,BAR("AR"),0),U)
  1.  . S BAR("DUZ")=0
  1.  . F  S BAR("DUZ")=$O(^TMP($J,"BAR-TSRS",BAR("AR"),BAR("DUZ"))) Q:'+BAR("DUZ")!($G(BAR("F1")))  D
  1.  . . S (BAR("L"),BAR("OL"))=""
  1.  . . F  S BAR("L")=$O(^TMP($J,"BAR-TSRS",BAR("AR"),BAR("DUZ"),BAR("L"))) Q:BAR("L")=""!($G(BAR("F1")))  D TRANS
  1.  Q:$G(BAR("F1"))
  1.  W !?52,BAREQUAL
  1.  W !,"REPORT TOTAL"
  1.  W ?52,$J($FN(GRANBILL,",",2),10)
  1.  W ?67,$J($FN(GRANTRAN,",",2),10)
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. TRANS ;
  1.  S BAR("ADJCAT")="NOT USED"
  1.  S BAR("TRANS")=""
  1.  F  S BAR("TRANS")=$O(^TMP($J,"BAR-TSRS",BAR("AR"),BAR("DUZ"),BAR("L"),BAR("ADJCAT"),BAR("TRANS"))) Q:BAR("TRANS")=""!($G(BAR("F1")))  D SORT
  1.  Q:$G(BAR("F1"))
  1.  W !,?52,BARDASH
  1.  W !,"Transaction Tot:"
  1.  W ?52,$J($FN($P(BAR("DATA"),U,6),",",2),10)  ; bill amt
  1.  S TRANAMT=$P(BAR("DATA"),U,2)+$P(BAR("DATA"),U,3)+$P(BAR("DATA"),U,4)+$P(BAR("DATA"),U,5)+$P(BAR("DATA"),U,7)
  1.  W ?67,$J($FN($P(TRANSAMT,U,7),",",2),10)  ; adjustments
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. SORT ;
  1.  S BAR("SORT")=""
  1.  F  S BAR("SORT")=$O(^TMP($J,"BAR-TSRS",BAR("AR"),BAR("DUZ"),BAR("L"),BAR("TRANS"),BAR("ADJCAT"),BAR("SORT"))) Q:BAR("SORT")=""!($G(BAR("F1")))  D
  1.  .Q:$G(BAR("F1"))
  1.  .W !?52,BARDASH
  1.  .S SORTBTOT=$G(SORTBTOT)+$P(BAR("DATA"),U,6)
  1.  .S TRANAMT=$P(BAR("DATA"),U,2)+$P(BAR("DATA"),U,3)+$P(BAR("DATA"),U,4)+$P(BAR("DATA"),U,5)+$P(BAR("DATA"),U,7)
  1.  .S SORTTTOT=$G(SORTTTOT)+TRANAMT
  1.  I BARY("SORT")="C" W !,"  Clinic Tot:"
  1.  E  W !,"   Visit Tot:"
  1.  ;W ?15,$J($FN(BAR("4TOTA"),",",2),10)
  1.  ;W ?26,$J($FN(BAR("4TOTB"),",",2),10)
  1.  ;W ?37,$J($FN(BAR("4TOTC"),",",2),10)
  1.  ;W ?48,$J($FN(BAR("4TOTD"),",",2),10)
  1.  W ?52,$J($FN(SORTBTOT,",",2),10)  ; bill amt
  1.  W ?67,$J($FN(SORTTTOT,",",2),10)  ; adjustments
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. ACCT ;
  1.  Q:$G(BAR("F1"))
  1.  I $Y>(IOSL-5) D HD^BARRADJ2 Q:$G(BAR("F1"))
  1.  I BAR("OL")'=BAR("L") W ! D HD1 W !
  1.  E  I BAR("OTRANS")'=BAR("TRANS") W ! D HD2 W !
  1.  E  I BAR("OADJCAT")'=BAR("ADJCAT") W ! D HD3 W !
  1.  E  I BAR("OSORT")'=BAR("SSORT") W ! D HD4 W !
  1.  S BAR("DATA")=^TMP($J,"BAR-TSRS",BAR("AR"),BAR("DUZ"),BAR("L"),BAR("TRANS"),BAR("ADJCAT"),BAR("SORT"))
  1.  ;W ?15,$J($FN($P(BAR("DATA"),U,2),",",2),10)  ; Pay Amt
  1.  ;W ?26,$J($FN($P(BAR("DATA"),U,3),",",2),10)  ; Prev Credit
  1.  ;W ?37,$J($FN($P(BAR("DATA"),U,4),",",2),10)  ; Refunds
  1.  ;W ?48,$J($FN($P(BAR("DATA"),U,5),",",2),10)  ; payment
  1.  ;W ?38,BAR("4TOTG")
  1.  W ?52,$J($FN($P(BAR("DATA"),U,6),",",2),10)  ; bill amt
  1.  S TRANAMT=$P(BAR("DATA"),U,2)+$P(BAR("DATA"),U,3)+$P(BAR("DATA"),U,4)+$P(BAR("DATA"),U,5)+$P(BAR("DATA"),U,7)
  1.  W ?67,$J($FN($P(BAR("DATA"),U,7),",",2),10)  ; adjustments
  1.  F I=0:1:4 D                                ; Accumulate totals
  1.  . S Y=1
  1.  . F X="TOTA","TOTB","TOTC","TOTD","TOTE","TOTF","TOTG" D
  1.  . . S Y=Y+1
  1.  . . S BARV=I_X
  1.  . . S BARV2="BAR("""_BARV_""")"
  1.  . . S @BARV2=@BARV2+$P(BAR("DATA"),U,Y)
  1.  . . I X="TOTG" S @BARV2=@BARV2+1
  1.  K I,X,Y
  1.  S BAR("0TOTH")=BAR("0TOTH")+BAR("0TOTG")
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. HD1 ;     
  1.  W !?10,"Visit Location.......: ",BAR("L")
  1.  S BAR("OL")=BAR("L")
  1.  S (BAR("1TOTA"),BAR("1TOTB"),BAR("1TOTC"),BAR("1TOTD"),BAR("1TOTE"),BAR("1TOTF"),BAR("1TOTG"))=0
  1.  D HD2
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. HD2 ;     
  1.  W !?10,"Transaction Type.....: "
  1.  I +BAR("B"),$P($G(^BARCOL(DUZ(2),BAR("TRANS"),0)),U)'="" D
  1.  .W $P(^BARCOL(DUZ(2),BAR("TRANS"),0),U)  ;IM17362
  1.  E  W BAR("B")
  1.  S BAR("OTRANS")=BAR("TRANS")
  1.  S (BAR("2TOTA"),BAR("2TOTB"),BAR("2TOTC"),BAR("2TOTD"),BAR("2TOTE"),BAR("2TOTF"),BAR("2TOTG"))=0
  1.  D HD3
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. HD3 ;     
  1.  W !?10,"Collection Batch Item: ",BAR("IT")
  1.  S BAR("OIT")=BAR("IT")
  1.  S (BAR("3TOTA"),BAR("3TOTB"),BAR("3TOTC"),BAR("3TOTD"),BAR("3TOTE"),BAR("3TOTF"),BAR("3TOTG"))=0
  1.  D HD4
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. HD4 ;
  1.  W !?10
  1.  I BARY("SORT")="C" D
  1.  . W "Clinic Type..........: "
  1.  . I BAR("S")=99999 W "NO CLINIC" Q
  1.  . W $P(^DIC(40.7,BAR("S"),0),U)
  1.  I BARY("SORT")="V" D
  1.  . W "Visit Type...........: "
  1.  . I BAR("S")=99999 W "NO VISIT TYPE" Q
  1.  . W $P($G(^ABMDVTYP(BAR("S"),0)),U)
  1.  S BAR("OSORT")=BAR("SORT")
  1.  S (BAR("4TOTA"),BAR("4TOTB"),BAR("4TOTC"),BAR("4TOTD"),BAR("4TOTE"),BAR("4TOTF"),BAR("4TOTG"))=0
  1.  Q