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

BARRATS.m

Go to the documentation of this file. 
  1. BARRATS ; IHS/SD/LSL - File Synchronization ;09/15/2008
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**7,19,20,24**;OCT 26, 2005;Build 69
  1.  ;
  1.  ; IHS/SD/LSL - 06/04/02 - V1.6 Patch 2
  1.  ;     Routine created
  1.  ; MODIFIED XTMP FILE NAME TO TMP TO MEET SAC REQUIREMENTS;MRS:BAR*1.8*7 IM29892
  1.  ;
  1.  ; IHS/SD/POT HEAT141692 CHANGE DEFAULT VALUE (detail or summary) BAR*1.8*24
  1.  ; *********************************************************************
  1.  ;
  1.  ;     This routine will compare the Current Bill Amount of the A/R Bill
  1.  ;     File to the A/R Transaction history balance.  If they are not
  1.  ;     equal, relevant data will be stored in a temp global.  A report
  1.  ;     (A/R BILL AND TRANSACTION SYNCHRONIZATION REPORT) will be
  1.  ;     generated containing A/R Bill, Date of Service, A/R Account,
  1.  ;     Current Bill Amount, Transaction History Balance, and the
  1.  ;     difference between the two.
  1.  ;
  1.  ;     The user may select a visit location for the report.
  1.  ;     The user may choose to print a detail report.  If detail, then
  1.  ;     the transaction history will show as well (Transaction Date,
  1.  ;     Transaction Type, A/R Account, Transaction Amount, and
  1.  ;     Transaction Balance)
  1.  ;
  1.  ; *********************************************************************
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. EN ; EP
  1.  ;
  1.  K BARY,BAR
  1.  D:'$D(BARUSR) INIT^BARUTL           ; Set up basic A/R variables
  1.  S BARP("RTN")="BARRATS"             ; Routine used to gather data
  1.  S BAR("PRIVACY")=1                  ; Privacy act applies (used BARRHD)
  1.  S BAR("LOC")=$$GET1^DIQ(90052.06,DUZ(2),16)   ; BILLING or VISIT
  1.  I BAR("LOC")="" S BAR("LOC")="VISIT"
  1.  D MSG^BARRSEL                       ; Message about BILLING/VISIT loc
  1.  D LOC^BARRSL1                       ; Ask location - BARY("LOC")
  1.  Q:$D(DTOUT)!($D(DUOUT))
  1.  W:'$D(BARY("LOC")) "ALL"
  1.  D RTYP                              ; Ask Report type
  1.  Q:$D(DTOUT)!($D(DUOUT))
  1.  D SETHDR                            ; Build header array
  1.  S BARQ("RC")="COMPUTE^BARRATS"      ; Gather data
  1.  S BARQ("RP")="PRINT^BARRATS"        ; Print report
  1.  S BARQ("NS")="BAR"                  ; Namespace for variables
  1.  S BARQ("RX")="POUT^BARRUTL"         ; Clean-up routine
  1.  D ^BARDBQUE                         ; Double queuing
  1.  D PAZ^BARRUTL                       ; Press return to continue
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. RTYP ;
  1.  ; Ask report type (detail or summary)         
  1.  K DIR,BARY("RTYP")
  1.  S DIR(0)="SO^1:Detail;2:Summary"
  1.  S DIR("A")="Select TYPE of REPORT desired"
  1.  S DIR("B")=1 ;P.OTT HEAT141692 CHANGE DEFAULT VALUE
  1.  S DIR("?")="Select detail or summary.  Detail contains transaction history"
  1.  D ^DIR
  1.  K DIR
  1.  I $D(DUOUT)!$D(DTOUT) Q
  1.  S BARY("RTYP")=Y
  1.  S BARY("RTYP","NM")=Y(0)
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. SETHDR ;
  1.  ; Build header array
  1.  S BAR("LVL")=0
  1.  I $G(BARY("RTYP"))=2 S BAR("HD",0)="SUMMARY "
  1.  E  S BAR("HD",0)="DETAIL "
  1.  S BAR("HD",0)=BAR("HD",0)_"A/R Bill and Transaction Synchronization Report"
  1.  S BAR("TXT")="ALL"
  1.  I $D(BARY("LOC")) S BAR("TXT")=$P(^DIC(4,BARY("LOC"),0),U)
  1.  I BAR("LOC")="BILLING" D
  1.  . S BAR("TXT")=BAR("TXT")_" Visit location(s) under "
  1.  . S BAR("TXT")=BAR("TXT")_$P(^DIC(4,DUZ(2),0),U)
  1.  . S BAR("TXT")=BAR("TXT")_" Billing Location"
  1.  E  S BAR("TXT")=BAR("TXT")_" Visit location(s) regardless of Billing Location"
  1.  S BAR("CONJ")="at "
  1.  D CHK^BARRHD
  1.  Q
  1.  ; *********************************************************************
  1.  ; *********************************************************************
  1.  ;
  1. COMPUTE ;
  1.  ; Build temporary data global
  1.  K ^TMP($J,"BAR-ATS")
  1.  I BAR("LOC")="BILLING" D DATA
  1.  E  D LOOP
  1.  Q
  1.  ; *********************************************************************
  1. LOOP ;
  1.  S BARDUZ=DUZ(2)
  1.  S DUZ(2)=0
  1.  F  S DUZ(2)=$O(^BARBL(DUZ(2))) Q:'+DUZ(2)  D DATA
  1.  S DUZ(2)=BARDUZ
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. DATA ;
  1.  S BARBILL=0
  1.  F  S BARBILL=$O(^BARBL(DUZ(2),BARBILL)) Q:'+BARBILL  D
  1.  . Q:'$D(^BARBL(DUZ(2),BARBILL,0))        ; No data on bill
  1.  . D BILLDATA                             ; Gather A/R Bill data
  1.  . I $D(BARY("LOC")),BARY("LOC")'=BARVIS Q  ; Not chosen visit location
  1.  . D TRDATA                               ; Gather A/R Transaction data
  1.  . Q:+BARBAMT=BARTAMT                     ; Files are in sync
  1.  . S BARDIF=BARBAMT-BARTAMT
  1.  . ;S ^TMP($J,"BAR-ATS",BARVISOU,BARAC,BARDOS,BARBILL)=BARBAMT_U_BARTAMT_U_DUZ(2)  ;IHS/SD/AML 5/27/09 - Old code
  1.  . S ^TMP($J,"BAR-ATS",BARVISOU,BARAC,BARDOS,BARBILL,BARBAPP,BARHRN)=BARBAMT_U_BARTAMT_U_DUZ(2)  ;IHS/SD/AML 5/27/09 - Add Appr date and HRN
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. BILLDATA ;
  1.  ; Gather data from A/R Bill file.
  1.  F I=0:1:1 S BARBL(I)=$G(^BARBL(DUZ(2),BARBILL,I))
  1.  S BARBAMT=$P(BARBL(0),U,15)              ; Current bill amount
  1.  S BARAC=$$GET1^DIQ(90050.01,BARBILL,3)   ; A/R Account (external)
  1.  S:BARAC="" BARAC="NO A/R ACCOUNT"
  1.  S BARDOS=$P(BARBL(1),U,2)                ; DOS Begin
  1.  I BARDOS="" S BARDOS=99
  1.  S BARVIS=$P(BARBL(1),U,8)                ; Visit location
  1.  I +BARVIS S BARVISOU=$$GET1^DIQ(4,BARVIS,.01)
  1.  E  S BARVISOU="NO VISIT LOCATION"
  1.  S BARBAPP=$P(BARBL(0),U,18)              ;3P Approve date - IHS/SD/AML 4/13/09 - Added to make working ATS report easier
  1.  S BARHRN=$P(BARBL(1),U,7)                ;HRN - IHS/SD/AML 4/13/09 - Added to make working ATS report easier
  1.  S:BARHRN="" BARHRN="NO HRN"  ;Null if missing HRN
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. TRDATA ;
  1.  ; Gather data for A/R Bill from A/R Transaction File via "AC" x-ref
  1.  ; Find PSR transactions and do math to find balance
  1.  S (BARTR,BARTAMT)=0
  1.  F  S BARTR=$O(^BARTR(DUZ(2),"AC",BARBILL,BARTR)) Q:'+BARTR  D
  1.  . Q:'$D(^BARTR(DUZ(2),BARTR,0))          ; No transaction data
  1.  . F I=0:1:1 S BARTR(I)=$G(^BARTR(DUZ(2),BARTR,I))
  1.  . S BARTRTYP=$P(BARTR(1),U)              ; Trans type (pointer)
  1.  . S BARADCAT=$P(BARTR(1),U,2)            ; Adjust cat (pointer)
  1.  . S BARCDT=$P(BARTR(0),U,2)
  1.  . S BARDBT=$P(BARTR(0),U,3)
  1.  . ; IHS/SD/PKD 1.8*20 3/11/11 Include Sent to Collections as part of Adjustments
  1.  . ; 25 - Sent to Collections w/ TRANTYP = 993 - STATUS CHANGE
  1.  . ; I ",3,4,13,14,15,16,19,20,"'[(","_BARADCAT_",")&(",40,49,39,108,503,504,"'[(","_BARTRTYP_",")) Q
  1.  . I ",3,4,13,14,15,16,19,20,25"'[(","_BARADCAT_",")&(",40,49,39,108,503,504,993,"'[(","_BARTRTYP_",")) Q
  1.  . S BARTAMT=BARTAMT+BARDBT-BARCDT
  1.  Q
  1.  ; *********************************************************************
  1.  ; *********************************************************************
  1.  ;
  1. PRINT ;
  1.  ; Print report
  1.  K BARRCNT,BARR1,BARR2,BARR3
  1.  S (BARRCNT,BARR1,BARR2,BARR3)=0   ;MRS:BAR*1.8*7 IM30525
  1.  S BAR("PG")=0
  1.  S BARDASH="W !?43,""----------   ----------   ----------"""
  1.  S BAREQUAL="W !?43,""==========   ==========   =========="""
  1.  D HDB                             ; Print page and column headers
  1.  I '$D(^TMP($J,"BAR-ATS")) D  Q
  1.  . W !!!,"*** NO DATA TO PRINT ***"
  1.  . D EOP^BARUTL(0)
  1.  S BARVIS=""
  1.  F  S BARVIS=$O(^TMP($J,"BAR-ATS",BARVIS)) Q:BARVIS=""!$G(BAR("F1"))  D
  1.  . K BARVCNT,BARV1,BARV2,BARV3
  1.  . S (BARVCNT,BARV1,BARV2,BARV3)=0   ;MRS:BAR*1.8*7 IM30525
  1.  . W !!?5,"Visit Location: ",BARVIS,!
  1.  . S BARAC=""
  1.  . F  S BARAC=$O(^TMP($J,"BAR-ATS",BARVIS,BARAC)) Q:BARAC=""!$G(BAR("F1"))  D
  1.  . . S BARDOS=0
  1.  . . F  S BARDOS=$O(^TMP($J,"BAR-ATS",BARVIS,BARAC,BARDOS)) Q:'+BARDOS!$G(BAR("F1"))  D
  1.  . . . S BARBILL=0
  1.  . . . F  S BARBILL=$O(^TMP($J,"BAR-ATS",BARVIS,BARAC,BARDOS,BARBILL)) Q:'+BARBILL!$G(BAR("F1"))  D
  1.  . . . . ;IHS/SD/AML 5/27/09 - Added to ^TMP to allow Approval date and HRN to print on report
  1.  . . . . S BARBAPP=0
  1.  . . . . F  S BARBAPP=$O(^TMP($J,"BAR-ATS",BARVIS,BARAC,BARDOS,BARBILL,BARBAPP)) Q:'+BARBAPP!$G(BAR("F1"))  D
  1.  . . . . . S BARHRN=0
  1.  . . . . . F  S BARHRN=$O(^TMP($J,"BAR-ATS",BARVIS,BARAC,BARDOS,BARBILL,BARBAPP,BARHRN)) Q:BARHRN=""!$G(BAR("F1"))  D
  1.  . . . . . . S BARTMP=^TMP($J,"BAR-ATS",BARVIS,BARAC,BARDOS,BARBILL,BARBAPP,BARHRN)
  1.  . . . . . . S BARHLD=DUZ(2)
  1.  . . . . . . S DUZ(2)=$P(BARTMP,U,3)
  1.  . . . . . . D PRNTLINE
  1.  . . . . . . I $G(BARY("RTYP"))=1 D HIST
  1.  . . . . . . S DUZ(2)=BARHLD
  1.  . . . . ;IHS/SD/AML 5/27/09 - End new code, begin old code
  1.  . . . . ;S BARTMP=^TMP($J,"BAR-ATS",BARVIS,BARAC,BARDOS,BARBILL)
  1.  . . . . ;S BARHLD=DUZ(2)
  1.  . . . . ;S DUZ(2)=$P(BARTMP,U,3)
  1.  . . . . ;D PRNTLINE
  1.  . . . . ;I $G(BARY("RTYP"))=1 D HIST
  1.  . . . . ;S DUZ(2)=BARHLD
  1.  . . . . ;IHS/SD/AML 5/27/09 - End code changes to allow ^TMP global population of new fields
  1.  . X BARDASH
  1.  . W !," ** Visit Location Total  (Bill cnt:"
  1.  . W ?37,$J(BARVCNT,4),")"
  1.  . W ?43,$J($FN(BARV1,",",2),10)
  1.  . W ?56,$J($FN(BARV2,",",2),10)
  1.  . W ?69,$J($FN(BARV3,",",2),10)
  1.  X BAREQUAL
  1.  W !,"*** REPORT TOTAL          (Bill cnt:"
  1.  W ?37,$J(BARRCNT,4),")"
  1.  W ?43,$J($FN(BARR1,",",2),10)
  1.  W ?56,$J($FN(BARR2,",",2),10)
  1.  W ?69,$J($FN(BARR3,",",2),10)
  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.  ;
  1. HDB ; EP
  1.  ; Page and column header
  1.  S BAR("PG")=BAR("PG")+1
  1.  S BAR("I")=""
  1.  D WHD^BARRHD                       ; Page header
  1.  W !?48,"BILL",?56,"TRANSACTION"
  1.  W !,"A/R BILL",?15,"DOS",?27,"A/R ACCOUNT",?46,"BALANCE"
  1.  W ?56,"HISTORY BAL",?69,"DIFFERENCE"
  1.  S $P(BAR("DASH"),"=",$S($D(BAR(132)):132,1:80))=""
  1.  W !,BAR("DASH"),!
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. PRNTLINE ;
  1.  ; PRINT DATA LINES
  1.  S BARBAMT=$P(BARTMP,U)
  1.  S BARTAMT=$P(BARTMP,U,2)
  1.  S BARDIFF=BARBAMT-BARTAMT
  1.  ;S BARBAPP=$G(BARBAPP)               ;MRS:BAR*1.8*7 IM30525
  1.  ;S BARHRN=$G(BARHRN)                 ;MRS:BAR*1.8*7 IM30525
  1.  I $Y>(IOSL-5) D HD Q:$G(BAR("F1"))
  1.  W !,$E($$GET1^DIQ(90050.01,BARBILL,.01),1,12)
  1.  I BARDOS=99 W ?14,"NO DOS"
  1.  E  W ?14,$$SDT^BARDUTL(BARDOS)
  1.  W ?26,$E(BARAC,1,15)
  1.  W ?43,$J($FN(BARBAMT,",",2),10)
  1.  W ?56,$J($FN(BARTAMT,",",2),10)
  1.  W ?69,$J($FN(BARDIFF,",",2),10)
  1.  ;IHS/SD/AML 5/15/2008 - Begin new code - print additional items on ATS
  1.  W !,?3,"Appr Dt: "_$$CDT^BARDUTL(BARBAPP)_" ("_(BARBAPP)_")"  ;IHS/SD/SDR 9/28/10
  1.  W ?47,"HRN: "_BARHRN  ;IHS/SD/SDR 9/28/10
  1.  W ?64,$J($FN(($$GET1^DIQ(90050.01,BARBILL,13)),",",2),10)  ;IHS/SD/SDR 9/28/10
  1.  W ?75,"[ ]"  ;IHS/SD/SDR 9/28/10
  1.  ;IHS/SD/AML 5/15/2008 - End new code - print additional lines on ATS
  1.  ;
  1.  S BARVCNT=$G(BARVCNT)+1
  1.  S BARRCNT=$G(BARRCNT)+1
  1.  S BARV1=$G(BARV1)+BARBAMT
  1.  S BARV2=$G(BARV2)+BARTAMT
  1.  S BARV3=$G(BARV3)+BARDIFF
  1.  S BARR1=$G(BARR1)+BARBAMT
  1.  S BARR2=$G(BARR2)+BARTAMT
  1.  S BARR3=$G(BARR3)+BARDIFF
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. HIST ;
  1.  ; Detail report...print transaction history
  1.  S (BARTR,BARTAMT,BARTBAL)=0
  1.  W !!?6,"TR DATE",?17,"TR TYPE",?33,"A/R ACCOUNT",?50,"TR AMOUNT",?65,"TR BALANCE"
  1.  W !?6,"----------",?17,"--------------",?33,"--------------",?50,"----------",?65,"----------"  ;IHS/SD/SDR 9/28/10
  1.  F  S BARTR=$O(^BARTR(DUZ(2),"AC",BARBILL,BARTR)) Q:'+BARTR!($G(BAR("F1")))  D
  1.  . Q:'$D(^BARTR(DUZ(2),BARTR,0))          ; No transaction data
  1.  . F I=0:1:1 S BARTR(I)=$G(^BARTR(DUZ(2),BARTR,I))
  1.  . S BARTRTYP=$P(BARTR(1),U)              ; Trans type (pointer)
  1.  . S BARADCAT=$P(BARTR(1),U,2)            ; Adjust cat (pointer)
  1.  . S BARCDT=$P(BARTR(0),U,2)
  1.  . S BARDBT=$P(BARTR(0),U,3)
  1.  . ;I ",3,4,13,14,15,16,19,20,"'[(","_BARADCAT_",")&(",40,49,39,108,503,504,"'[(","_BARTRTYP_",")) Q  ;bar*1.8*20
  1.  . ;include sent to collections
  1.  . I ",3,4,13,14,15,16,19,20,25"'[(","_BARADCAT_",")&(",40,49,39,108,503,504,993,"'[(","_BARTRTYP_",")) Q  ;bar*1.8*20
  1.  . ;
  1.  . S BARTAMT=BARDBT-BARCDT
  1.  . S BARTBAL=$G(BARTBAL)+BARTAMT
  1.  . I $Y>(IOSL-4) D HD Q:$G(BAR("F1"))
  1.  . ;I DUZ(0)="@" W !?2,BARTR  ;IHS/SD/AML 5/27/09
  1.  . ;E  W !?6,$$SDT^BARDUTL(BARTR)  ;IHS/SD/AML 5/27/09
  1.  . W !?2,BARTR  ;IHS/SD/AML 5/27/09
  1.  . W ?17,$E($$GET1^DIQ(90050.03,BARTR,101),1,14)
  1.  . W ?33,$E($$GET1^DIQ(90050.03,BARTR,6),1,14)
  1.  . W ?50,$J($FN(BARTAMT,",",2),10)
  1.  . W ?65,$J($FN(BARTBAL,",",2),10)
  1.  W ! F A=1:1:80 W "-"  ;IHS/SD/SDR 9/28/10
  1.  W !
  1.  Q