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

BARRNBRA.m

Go to the documentation of this file. 
  1. BARRNBRA ; IHS/SD/POT - Non Ben Payment Report ; 08/20/2008
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**24**;OCT 26, 2005;Build 69
  1.  ; IHS/SD/POT 07/15/13 HEAT114352 NEW REPORT BAR*1.8*24
  1.  ; IHS/SD/POT 01/14/14 FIXED: IDENTIFY PAYMENTS TO OTHER PAT BAR*1.8*24
  1.  ; IHS/SD/POT 04/07/14 FIXED CHECK FOR ELIGIBILITY STATUS FROM PAT FILE BAR*1.8*24
  1.  Q
  1.  ; **
  1.  ;
  1. EN ; EP
  1.  K BARY,BAR
  1.  S BARP("RTN")="BARRNBRA"
  1.  S BARY("RTYP")=1,BARY("RTYP","NM")="DETAIL"
  1.  S BAR("PRIVACY")=1  ; Privacy act applies
  1.  S BARY("SORT")=""   ; Init value to prevent <UNDEF>
  1.  D:'$D(BARUSR) INIT^BARUTL         ; Set A/R basic variable
  1.  S BAR("LOC")=$$GET1^DIQ(90052.06,DUZ(2),16)   ; BILLING or VISIT
  1.  I BAR("LOC")="" S BAR("LOC")="VISIT"
  1.  S DEBUG=0
  1. ASK1 D ASKAGAI1^BARRNBRS
  1.  I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q
  1.  I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q
  1.  I $D(BARY("RTYP")) S BAR("HD",0)=BARY("RTYP","NM")_" "_BARMENU
  1.  E  S BAR("HD",0)=BARMENU
  1.  ;-
  1.  I $G(BARY("SORT"))="C" S BARY("SORT","NM")="Clinic"
  1.  I $G(BARY("SORT"))="V" S BARY("SORT","NM")="Visit type"
  1.  I $G(BARY("DT"))="V" S BARY("DT","NM")="Visit"
  1.  I $G(BARY("DT"))="T" S BARY("DT","NM")="Transaction"
  1.  I '$D(BARY("DT")) D  ;
  1.  . S BARY("DT")="",BARY("DT",1)="",BARY("DT",2)=""
  1.  S BARY("TYP")="^N^"
  1.  S BARY("TYP","NM")="NON-BENEFICIARY"
  1.  ;-
  1.  D SETHDR                            ; Build header array
  1.  S BARQ("RC")="COMPUTE^BARRNBRA"     ; Build tmp global with data
  1.  S BARQ("RP")="PRINT^BARRNBRB"       ; Print reports from tmp global
  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. SETHDR ;
  1.  ; Build header array
  1.  S BAR("OPT")="NBR"
  1.  S BAR("LVL")=0
  1.  S BARMODE="S"
  1.  I $G(BARY("RTYP"))=1 S BARMODE="D"
  1.  I BARMODE="D" S BAR("HD",0)="Non-beneficiary Detailed Report"
  1.  I BARMODE="S" S BAR("HD",0)="Non-beneficiary Summary Report"
  1.  D DT^BARRHD
  1.  S BAR("LVL")=$G(BAR("LVL"))+1
  1.  S BAR("HD",BAR("LVL"))=""
  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.  I $D(BARY("PAT")) S BAR("TXT")=BAR("TXT")_$C(10,13)_"for "_BARY("PAT","NM")
  1.  S BAR("CONJ")="at "
  1.  D CHK^BARRHD
  1.  Q
  1.  ; **
  1.  ;
  1. COMPUTE ; EP
  1.  S BAR("SUBR")="BAR-NBR"
  1.  K ^TMP($J,"BAR-NBR")
  1.  K ^TMP($J,"BAR-NBR9")
  1.  K ^TMP($J,"BAR-NBRT")
  1.  K ^TMP($J,"BAR-BAR-NBR")
  1.  I BAR("LOC")="BILLING" ;**************
  1.  D TRANS,MAIN Q
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. TRANS ;EP for Looping thru Transaction File
  1.  I $G(BARY("PAT"))="" I BARY("DT")="T" S BARP("X")="B" D  Q  ;NO PAT - LOOP TXD FROM-TO
  1.  . S BARP("DT")=BARY("DT",1)-.5 F  S BARP("DT")=$O(^BARTR(DUZ(2),BARP("X"),BARP("DT"))) Q:'BARP("DT")!(BARP("DT")>(BARY("DT",2)+.5))  D
  1.  . . S BARTR=0 F  S BARTR=$O(^BARTR(DUZ(2),BARP("X"),BARP("DT"),BARTR)) Q:'BARTR  D DATA
  1.  ;-------------------------
  1.  I $G(BARY("PAT"))="" I BARY("DT")="V" D  Q   ;NO PAT - LOOP ALL TXD
  1.  . S BARP("DT")=0 F  S BARP("DT")=$O(^BARTR(DUZ(2),BARP("DT"))) Q:'+BARP("DT")  S BARTR=BARP("DT") D DATA
  1.  ;-------------------------
  1.  I BARY("DT")="T" S BARP("X")="AF" D  Q  ;PAT
  1.  . S BARP("DT")=BARY("DT",1)-.5 F  S BARP("DT")=$O(^BARTR(DUZ(2),BARP("X"),BARY("PAT"),BARP("DT"))) Q:'BARP("DT")!(BARP("DT")>(BARY("DT",2)+.5))  D
  1.  . . S BARTR=BARP("DT") D DATA
  1.  ;--------------------------
  1.  I BARY("DT")="V" S BARP("X")="AF" D  Q
  1.  . S BARP("DT")=0 F  S BARP("DT")=$O(^BARTR(DUZ(2),BARP("X"),BARY("PAT"),BARP("DT"))) Q:+BARP("DT")=0  D
  1.  . . S BARTR=BARP("DT") D DATA
  1.  ;--
  1.  Q
  1.  ; **
  1. DATA ; Gather data for transactions found in TRANS
  1.  ; S ^TMP($J,"BAR-NBR9",YBARBL,BARBL)
  1.  ; S ^TMP($J,"BAR-NBR9",YBARBL,BARBL,BARTR)
  1.  ;
  1.  S BARP("HIT")=0
  1.  S X=$$ISNONBEN(BARTR) I 'X Q
  1.  D CHKTRANS^BARRNBRE(BARTR)
  1.  I 'BARP("HIT") Q  ;
  1.  S BARTEST=","_$P($G(^BARTR(DUZ(2),BARTR,1)),U)_","
  1.  I BARTEST=",," Q
  1.  ;I ",115,116,117,118,"[BARTEST D  Q
  1.  I ",49,40,"'[BARTEST Q
  1.  ;
  1.  I $$ISERR(BARTR) Q  ;ERROR
  1.  S BARBL=$P($G(^BARTR(DUZ(2),BARTR,0)),U,4) ;
  1.  S BARTR(0)=$G(^BARTR(DUZ(2),BARTR,0))  ; A/R Transaction 0 node
  1.  S BARTR(1)=$G(^BARTR(DUZ(2),BARTR,1))  ; A/R Transaction 1 node
  1.  S BARTR("T")=$P(BARTR(1),U)            ; Transaction type
  1.  S BARTR("DT")=$P(BARTR(0),U)           ; Transaction date/time
  1.  S BARCR=$P(BARTR(0),"^",2)
  1.  S BARDB=$P(BARTR(0),"^",3)
  1.  S BARTRACC=$P(BARTR(0),U,6)            ;ACCNT
  1.  S BARPAT=$P(BAR(10),U,1)               ;PAT FROM BAR 1;1
  1.  S BARFLG=0
  1.  I BARTRACC]"" I $G(^BARAC(DUZ(2),BARTRACC,0))[";AUPNPAT" I +$G(^BARAC(DUZ(2),BARTRACC,0))=BARPAT S BARFLG=1 ;BILLED TO PAT
  1.  I BARTRACC]"" I $G(^BARAC(DUZ(2),BARTRACC,0))[";AUPNPAT" I +$G(^BARAC(DUZ(2),BARTRACC,0))'=BARPAT S BARFLG=-1 ;BILLED TO other PAT (in err) 1/14/2014
  1.  ;40 - payment
  1.  ;19 - refund
  1.  ;20 - payment credit
  1.  S BARPAY=0 I BARTR("T")=40 S BARPAY=$$VAL^XBDIQ1(90050.03,BARTR,3.5) ;PAYMENT #3.6
  1.  S BARADJ=0
  1.  I "^3^4^13^14^15^16^"[("^"_BARTR("T")_"^") S BARADJ=$$VAL^XBDIQ1(90050.03,BARTR,3.5) ;ADJ #3.7 ;
  1.  S BARPAYAD=BARPAY+BARADJ
  1.  ;BARFLG=-1 IF PAT WAS CHARGED IN ERR
  1.  ;BARFLG=1 IF PAT WAS CHARGED
  1.  ;BARFLG=0 IF INS WAS CHARGED
  1.  I BARTR("T")=49 Q  ;1/13/2014 
  1.  S TMP=BARTR("DT")_"^"_BARTR("T")_"^"_BARCR_"^"_BARDB_"^"_BARPAY_"^"_BARADJ_"^"_BARPAYAD_"^"_BARFLG
  1.  S YBARBL=+$P($G(^BARBL(DUZ(2),BARBL,0)),U,1)  ;1ST PART OF BILL #
  1.  S ^TMP($J,"BAR-NBR9",YBARBL,BARBL,BARTR)=TMP
  1.  S ^TMP($J,"BAR-NBR9",YBARBL,BARBL)=$P(BAR(0),U,1)_"^"_$P(BAR(0),U,13)_"^"_$P(BAR(0),U,15)_"^^^"_BARPAT
  1.  Q
  1.  ;---------------------------
  1. MAIN ;^TMP($J,"BAR-NBR9",-->^TMP($J,"BAR-NBRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4"),BAR("SUB5")),U,I)
  1.  ;
  1.  ; BAR("SUB1") = Visit Location
  1.  ; BAR("SUB2") = Clinic / visit type
  1.  ; BAR("SUB3") = N/A
  1.  ; BAR("SUB4") = N/A
  1.  ; BAR("SUB5") = A/R Bill
  1.  ; OUTPUT DATA - NOT USED
  1.  ; BAR(1) = Billed Amount
  1.  ; BAR(2) = Insurance Payment
  1.  ; BAR(3) = Patient  Payment
  1.  ; BAR(4) = Balance
  1.  ; BAR(5) = Transaction Date
  1.  ; -------------------------------
  1.  ;
  1.  F I=1:1:5 S BAR(I)=0
  1.  F I=1:1:5 K BAR("SUB"_I)
  1.  N BARX,BAR,BARXTR,BARTR,BARDDD
  1.  S BARY="" F  S BARY=$O(^TMP($J,"BAR-NBR9",BARY)) Q:BARY=""  D
  1.  . S BARX="0" F  S BARX=$O(^TMP($J,"BAR-NBR9",BARY,BARX)) Q:BARX=""  D ADDUPTR^BARRNBRF(BARY,BARX)
  1.  S BARY="" F  S BARY=$O(^TMP($J,"BAR-NBR9",BARY)) Q:BARY=""  D ADDUPBL^BARRNBRF(BARY)
  1.  S BARX="" F  S BARX=$O(^TMP($J,"BAR-NBR9",BARX)) Q:BARX=""  D MAIN2(BARX)
  1.  D 100^BARRNBRF
  1.  D 110^BARRNBRF
  1.  Q
  1.  ;
  1. MAIN2(YBARBL) ;YBARBL IS THE 1ST PART OF A BILL
  1.  N PATPAY,INSPAY,BARDATE,BARBL
  1.  F I=1:1:5 S BAR(I)=0
  1.  S BARBL=$O(^TMP($J,"BAR-NBR9",YBARBL,"0")) I BARBL="" Q
  1.  S BARDATE=+^TMP($J,"BAR-NBR9",YBARBL,BARBL)
  1.  D EXTRACT(BARBL) ;GET 'C' AND 'L'
  1.  S BAR("SUB1")=$$GET1^DIQ(9999999.06,BARTR("L"),.01) ;Visit Location
  1.  S:BAR("SUB1")="" BAR("SUB1")="No Visit Location"
  1.  I BARY("SORT")="C" D
  1.  . S BAR("SUB2")=BAR("C") ;Clinic / visit type
  1.  . I BAR("SUB2")]"",BAR("SUB2")'=99999 S BAR("SUB2")=$$GET1^DIQ(40.7,BAR("SUB2"),.01)
  1.  . I BAR("SUB2")=""!(BAR("SUB2")=99999) S BAR("SUB2")="No Clinic Type"
  1.  . D STANDARD
  1.  I BARY("SORT")="V" D
  1.  . S BAR("SUB2")=BAR("V") ;Clinic / visit type
  1.  . I BAR("SUB2")]"",BAR("SUB2")'=99999 S BAR("SUB2")=$$GET1^DIQ(9002274.8,BAR("SUB2"),.01)
  1.  . I BAR("SUB2")=""!(BAR("SUB2")=99999) S BAR("SUB2")="No Visit Type"
  1.  . D STANDARD
  1.  S BAR("SUB3")=" " ;N/A
  1.  S BAR("SUB4")=" " ;N/A
  1.  S BAR("SUB5")=YBARBL
  1.  I BAR("SUB5")="" Q
  1.  D DETAIL
  1.  D BILL
  1.  D SUMMARY
  1.  Q
  1.  ; *
  1. STANDARD ;
  1.  ; Temp global for SORT CRITERIA Clinic or Visit or A/R Account
  1.  ; or Discharge Service
  1.  ; Detail Lines
  1.  NEW I
  1.  S BARHLD=$G(^TMP($J,"BAR-NBR",BAR("SUB1"),BAR("SUB2")))
  1.  F I=1:1:4 S $P(^TMP($J,"BAR-NBR",BAR("SUB1"),BAR("SUB2")),U,I)=$P(BARHLD,U,I)+BAR(I)
  1.  ;
  1.  ; Visit Location Totals
  1.  S BARHLD=$G(^TMP($J,"BAR-NBR",BAR("SUB1")))
  1.  F I=1:1:4 S $P(^TMP($J,"BAR-NBR",BAR("SUB1")),U,I)=$P(BARHLD,U,I)+BAR(I)
  1.  ; Report Total
  1.  S BARHLD=$G(^TMP($J,"BAR-NBR"))
  1.  F I=1:1:4 S $P(^TMP($J,"BAR-NBR"),U,I)=$P(BARHLD,U,I)+BAR(I)
  1.  S ^TMP($J,"BAR-NBR",BAR("SUB1"),BAR("SUB2"),YBARBL)=""
  1.  Q
  1.  ; *
  1.  ;
  1. SUMMARY ;
  1.  ; Temp global for SORT CRITERIA Allowance Category or Billing Entity
  1.  ; and Report Type Summarize.
  1.  ;
  1.  ; Detail Lines
  1.  NEW I
  1.  S BARHLD=$G(^TMP($J,"BAR-NBRT",BAR("SUB1"),BAR("SUB3")))
  1.  F I=1:1:4 S $P(^TMP($J,"BAR-NBRT",BAR("SUB1"),BAR("SUB3")),U,4)=$P(BARHLD,U,I)+BAR(I)
  1.  ;
  1.  ; Visit Location Totals
  1.  S BARHLD=$G(^TMP($J,"BAR-NBRT",BAR("SUB1")))
  1.  F I=1:1:4 S $P(^TMP($J,"BAR-NBRT",BAR("SUB1")),U,I)=$P(BARHLD,U,I)+BAR(I)
  1.  S $P(^TMP($J,"BAR-NBRT",BAR("SUB1")),U,5)=BARTR("L")
  1.  ;
  1.  ; Report Total
  1.  S BARHLD=$G(^TMP($J,"BAR-NBRT"))
  1.  F I=1:1:4 S $P(^TMP($J,"BAR-NBRT"),U,I)=$P(BARHLD,U,I)+BAR(I)
  1.  Q
  1.  ; *
  1.  ;
  1. DETAIL ;
  1.  ; Temp global for SORT CRITERIA Allowance Category or Billing Entity
  1.  ; and Report Type Summarize by payor w/in.
  1.  ;
  1.  ; Detail Lines
  1.  NEW I
  1.  S BARHLD=$G(^TMP($J,"BAR-NBRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4")))
  1.  F I=1:1:4 S $P(^TMP($J,"BAR-NBRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4")),U,I)=$P(BARHLD,U,I)+BAR(I)
  1.  Q
  1.  ; *
  1.  ;
  1. BILL ;
  1.  ; Temp global for SORT CRITERIA Allowance Category or Billing Entity
  1.  ; and Report Type Summarize by BILL w/in payor w/in.
  1.  ;
  1.  ; Detail Lines
  1.  S BARHLD=$G(^TMP($J,"BAR-NBRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4"),BAR("SUB5")))
  1.  F I=1:1:4 S $P(^TMP($J,"BAR-NBRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4"),BAR("SUB5")),U,I)=$P(BARHLD,U,I)+BAR(I)
  1.  S $P(^TMP($J,"BAR-NBRT",BAR("SUB1"),BAR("SUB3"),BAR("SUB4"),BAR("SUB5")),U,5)=BARDATE
  1.  Q
  1.  ; *
  1.  ;
  1. XIT ;
  1.  D ^BARVKL0
  1.  Q
  1. ISERR(BARTRDT) ;
  1.  N BARTR,BARTTYP
  1.  D ENP^XBDIQ1(90050.03,BARTRDT,"101;102;103","BARTR(","I")
  1.  S BARTTYP=BARTR(101,"I")
  1.  I BARTTYP'=39,BARTTYP'=43,BARTTYP'=40,BARTTYP'=49,BARTTYP'=107 Q 0
  1.  I BARTR(103)["ERROR" Q 1
  1.  Q 0
  1. EXTRACT(BARBL) ;
  1.  N BAR0,BAR1
  1.  S BAR0=$G(^BARBL(DUZ(2),BARBL,0))  ; A/R Bill 0 node
  1.  S BAR1=$G(^BARBL(DUZ(2),BARBL,1))  ; A/R Bill 1 node
  1.  S BAR("V")=$P(BAR1,U,14)           ; Visit type (3P Visit Type)
  1.  S BARTR("L")=$P(BAR1,U,8)          ; Visit location (A/R Parent/Sat)
  1.  S BARTR("D")=$P(BAR1,U,2)          ; DOS Begin
  1.  S BARTR("C")=$P(BAR1,U,12)         ; Clinic  (Clinic Stop File)
  1.  Q
  1. ISNONBEN(BARTR) ;BAR*1.8*24
  1.  N BAR1,BARPAT,BARTR0,BARBL
  1.  S BARTR0=$G(^BARTR(DUZ(2),BARTR,0))
  1.  S BARBL=$P(BARTR0,U,4) I BARBL="" Q 0
  1.  S BAR1=$G(^BARBL(DUZ(2),BARBL,1))  ; A/R Bill 1 node
  1.  S BARPAT=$P(BAR1,U,1)          ; Patient (Patient file)
  1.  I BARPAT="" Q 0                ; <SUBSCRIPT>ISNONBEN+6^BARRNBRA 4/8/14
  1.  I $P($G(^AUPNPAT(BARPAT,11)),U,12)="I" Q 1 ;Not eligible = > is non-ben
  1.  Q 0
  1.  ;------EOR----------