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

BARDRST.m

Go to the documentation of this file. 
  1. BARDRST ; IHS/SD/LSL - Statistical Report ; 07/31/2010
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**19**;OCT 26, 2005
  1.  ;
  1.  ; IHS/SD/SDR - V1.6 Patch 1 - Original code by Shonda Render
  1.  ;
  1.  ; IHS/SD/LSL - 03/14/2002 - V1.6 Patch 2 - NOIS NDA-0302-180099
  1.  ;     Resolve <UNDEF> DATA+34^BARDRST
  1.  ;
  1.  ; IHS/SD/LSL - 04/19/02 - V1.6 Patch 2
  1.  ;     Modified to accomodate new "Location to sort report by" parameter
  1.  ;
  1.  ; IHS/SD/LSL - 12/06/02 - V1.7 - NHA-0601-180049
  1.  ;      Look for 3P bill properly.
  1.  ; 
  1.  ; TMM 07/31/10 - V1.8 Patch 19
  1.  ;                       Modify A/R Statistical report to print selected
  1.  ;                       (Employer) Group Plans when BILLING ENTITY, 
  1.  ;                       6) Selected A/R ACCOUNT is selected.  Modify
  1.  ;                       report output to allow printing to a device
  1.  ;                       or creating a delimited file for import to Excel
  1.  ;                       file format
  1.  ;
  1.  ; *********************************************************************
  1.  ; P-1=VISIT CNT, P-2=UNDUP CNT, P-3=$BILLED, P-4=$PAID
  1.  ; P-5=$ADJUSTMENTS, P-6=$CURRENT BILLED
  1.  ;
  1.  K BAR,BARY
  1.  S BARP("RTN")="BARDRST"
  1.  S BAR("RTYP")=0,BAR("PAY")=""
  1.  S BAR("LOC")=$$GET1^DIQ(90052.06,DUZ(2),16)   ; BILLING or VISIT
  1.  I BAR("LOC")="" S BAR("LOC")="VISIT"
  1.  D ^BARRSEL G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
  1.  ;
  1.  W !
  1.  K DIR
  1.  S DIR("A",1)="This report will only contain APPROVED bills."
  1.  S DIR("A")="Do you wish to include CANCELLED bills"
  1.  S DIR("B")="N"
  1.  S DIR(0)="Y"
  1.  D ^DIR
  1.  K DIR
  1.  S BAR("STATUS")=Y
  1.  ;
  1.  K DIR,DTOUT,DUOUT,DIROUT,DIRUT
  1.  S DIR(0)="SA^P:PRINTED;D:DELIMITED"
  1.  S DIR("A")="Should the output be in (P)rinter format or (D)elimited file format?  P/D  "
  1.  K DA
  1.  D ^DIR
  1.  I $D(DIROUT)!$D(DTOUT)!$D(DUOUT) Q
  1.  S BARPRTYP=Y                 ;selected print type
  1.  S BARTEXT=0                  ;output = printer format
  1.  I Y="D" S BARTEXT=1          ;output = delimited file format
  1.  ;
  1.  S BAR("HD",0)="A/R STATISTICAL REPORT"
  1.  D ^BARRHD
  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.8*19 TMM 7/31/10
  1.  S BAR("CONJ")="at "
  1.  D CHK^BARRHD
  1.  ;
  1.  S BARQ("RC")="COMPUTE^BARDRST"
  1.  S BARQ("RX")="POUT^BARRUTL"
  1.  S BARQ("NS")="BAR"
  1.  S BARQ("RP")="PRINT^BARDRST1"
  1.  D ^BARDBQUE
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. COMPUTE ;EP - Entry Point for Setting up Data
  1.  K ^TMP($J,"BAR-ST")
  1.  K ^TMP($J,"BAR-B")
  1.  S BARP("RTN")="BARDRST"
  1.  I BAR("LOC")="BILLING" D  Q
  1.  . S (BAR("NLN"),BAR("NLC"),BAR("NLB"),BAR("NLP"),BAR("NLA"))=0
  1.  . D LOOP^BARRUTL
  1.  I BAR("LOC")'="BILLING" D  Q
  1.  . S BARDUZ2=DUZ(2)
  1.  .  S DUZ(2)=0
  1.  . F  S DUZ(2)=$O(^BARBL(DUZ(2))) Q:'DUZ(2)  D
  1.  .. S (BAR("NLN"),BAR("NLC"),BAR("NLB"),BAR("NLP"),BAR("NLA"))=0
  1.  .. D LOOP^BARRUTL
  1.  . S DUZ(2)=BARDUZ2
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. DATA ;
  1.  N BARREC,BARSTAT,BARTYP
  1.  S BARREC=^BARBL(DUZ(2),BAR,0)                 ;MOVE BILL FILE TO BARREC
  1.  ;SET VISIT TYPE FROM BILL FILE TO BARTYP
  1.  S BARTYP=$P($G(^BARBL(DUZ(2),BAR,1)),U,14)
  1.  S BARP("HIT")=0
  1.  D BILL^BARRCHK Q:'BARP("HIT")                 ;checks parameters
  1.  ;
  1.  S BAR3P("LOC")=$$FIND3PB^BARUTL(DUZ(2),BAR)   ;returns "" or 3PDUZ2^3PBIEN
  1.  Q:BAR3P("LOC")=""
  1.  S BAR3PDUZ=$P(BAR3P("LOC"),",")
  1.  S BAR3PDA=$P(BAR3P("LOC"),",",2)
  1.  ;
  1.  S BARSTAT=$P($G(^ABMDBILL(BAR3PDUZ,BAR3PDA,0)),U,4) ;3PB status
  1.  I BAR("STATUS")'=1,(BARSTAT="X") Q             ;Quit if cancelled bills not included
  1.  ;
  1.  I BARY("SORT")="C" S BAR("V")=BAR("C")              ;C=Clinic V=Visit
  1.  S BAR("PT")=$P(^BARBL(DUZ(2),BAR,1),U)              ;Patient IEN
  1.  S:'$D(BAR("LC",BAR("L"))) BAR("LC",BAR("L"))=0
  1.  I '$D(BAR(BAR("L"),BAR("V"))) D
  1.  .S BAR(BAR("L"),BAR("V"))="0^0^0^0^0^0"
  1.  ;
  1.  ;Next line counts # undup pats
  1.  I '$D(^TMP($J,"BAR-ST",BAR("L"),BAR("V"),BAR("PT"))) D
  1.  .S ^TMP($J,"BAR-ST",BAR("L"),BAR("V"),BAR("PT"))=""
  1.  .S $P(BAR(BAR("L"),BAR("V")),U,2)=$P(BAR(BAR("L"),BAR("V")),U,2)+1
  1.  ;
  1.  ;
  1.  ; NEXT 5 LINES ADDING PAID AMOUNTS
  1.  S BARTRAN=0
  1.  F  S BARTRAN=$O(^BARTR(DUZ(2),"AC",BAR,BARTRAN)) Q:'BARTRAN  D
  1.  .Q:'$D(^BARTR(DUZ(2),BARTRAN,0))    ; Q if no transaction
  1.  .S BAR("PDD")=+^BARTR(DUZ(2),BARTRAN,0)
  1.  .I $G(BARY("DT"))="P",BAR("PDD")<BARY("DT",1)!(BAR("PDD")>BARY("DT",2)) Q
  1.  .S BARCDT=$P($G(^BARTR(DUZ(2),BARTRAN,0)),U,2)
  1.  .S BARDBT=$P($G(^BARTR(DUZ(2),BARTRAN,0)),U,3)
  1.  .S BARTTYP=$P($G(^BARTR(DUZ(2),BARTRAN,1)),U)
  1.  .Q:BARTTYP=""
  1.  .S BARTTYP=$P($G(^BARTBL(BARTTYP,0)),U)
  1.  .; only want payment, not payment monthly
  1.  .I BARTTYP["PAYMENT",BARTTYP'["MONTHLY" D
  1.  ..S $P(BAR(BAR("L"),BAR("V")),U,4)=$P(BAR(BAR("L"),BAR("V")),U,4)+BARCDT-BARDBT
  1.  .I BARTTYP["ADJUST" D
  1.  ..S $P(BAR(BAR("L"),BAR("V")),U,5)=$P(BAR(BAR("L"),BAR("V")),U,5)+BARCDT-BARDBT
  1.  ;
  1.  ;
  1.  ; NEXT 3 LINES COUNT TOTAL NUMBER OF UNDUP PATIENTS
  1.  I '$D(^TMP($J,"BAR-ST",BAR("L"),BAR("PT"))) D
  1.  .S ^TMP($J,"BAR-ST",BAR("L"),BAR("PT"))=""
  1.  .S BAR("LC",BAR("L"))=BAR("LC",BAR("L"))+1
  1.  ;
  1.  I '$D(^TMP($J,"BAR-ST",BAR("PT"))) D
  1.  .S ^TMP($J,"BAR-ST",BAR("PT"))=""
  1.  .S BAR("NLC")=BAR("NLC")+1
  1.  ;
  1.  ; NEXT 3 LINES CHECKS FOR FIRST VALID BILL 
  1.  S BARBILL=BARREC
  1.  Q:$D(^TMP($J,"BAR-B",BARBILL))                          ;CK IF IS FOUND
  1.  S ^TMP($J,"BAR-B",BARBILL)=""          ;CK IF TMP IS UNIQUE USING BAR-B
  1.  ;
  1.  ; NEXT LINE COUNTS # OF VISITS
  1.  S $P(BAR(BAR("L"),BAR("V")),U)=$P(BAR(BAR("L"),BAR("V")),U)+1
  1.  ;
  1.  ;Next line is adding billed amount
  1.  S $P(BAR(BAR("L"),BAR("V")),U,3)=$P(BAR(BAR("L"),BAR("V")),U,3)+$P(^BARBL(DUZ(2),BAR,0),U,13)
  1.  I BARTYP=111 D     ;CK IF NOT EQUAL TO OUTPATIENT-NEED ONLY INPATIENTS
  1.  .S BAR(BAR("L"),"COVD")=$G(BAR(BAR("L"),"COVD"))+$P($G(^ABMDBILL(BAR3PDUZ,BAR3PDA,7)),U,3)
  1.  S $P(BAR(BAR("L"),BAR("V")),U,6)=$P(BAR(BAR("L"),BAR("V")),U,6)+$P($G(^BARBL(DUZ(2),BAR,0)),U,15)
  1.  ;
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. XIT K BAR,BARY,BARP
  1.  Q
  1.  ;
  1. TEXTCK() ;   Text delimited file  <--NEW TAG(TEXTCK) ;1.8*19 TMM 7/31/10
  1.  N BARTXT
  1.  S BARTXT=""
  1.  I $G(BARTEXT)=1 S BARTXT="^"
  1.  Q BARTXT