BARRCXL1 ; IHS/SD/LSL - Cancelled Bills Report - Gather Data ;08/20/2008
;;1.8;IHS ACCOUNTS RECEIVABLE;**7,19**;OCT 26, 2005
;
; IHS/SD/PKD - 05/07/10 - BAR*1.8.19
; IHS/SD/LSL - 03/10/03 - Routine created
; Called by BARRCXL
; MODIFIED XTMP FILE NAME TO TMP TO MEET SAC REQUIREMENTS;MRS:BAR*1.8*7 IM29892
Q
; *********************************************************************
;
;
COMPUTE ; EP
;
S BAR("SUBR")="BAR-CXL"
K ^TMP($J,"BAR-CXL"),^TMP($J,"BAR-CXL MULT"),^TMP($J,"BAR-CXL SUMY")
S BARP("RTN")="BARRCXL1" ; Routine used to get data if no parameters
;S BARDUZ2=DUZ(2)
;S DUZ(2)=0
;F S DUZ(2)=$O(^BARBL(DUZ(2))) Q:'DUZ(2)!($G(BAR("F1")))
; Index "OBAL" should supercede any other Index
S BAR=0
I BARY("OBAL")=1 D Q
. F S BAR=$O(^BARBL(DUZ(2),"OBAL",BAR)) Q:'BAR D DATA
D LOOP^BARRUTL
;S DUZ(2)=BARDUZ2
Q
; *********************************************************************
;
DATA ; EP
; Called by BARRUTL if no parameters
S BARP("HIT")=0
D BILL^BARRCHK
Q:'BARP("HIT")
S BAR("3P LOC")=$$FIND3PB^BARUTL(DUZ(2),BAR)
Q:BAR("3P LOC")="" ; Bill not found 3PB
S BAR3PDUZ=$P(BAR("3P LOC"),",")
S BAR3PIEN=$P(BAR("3P LOC"),",",2)
; BAR*1.8*19 IHS/SD/PKD 5/10/10 START
;S BARBSTAT=$P($G(^ABMDBILL(BAR3PDUZ,BAR3PIEN,0),U,4)
S BARB3PB0=$G(^ABMDBILL(BAR3PDUZ,BAR3PIEN,0)) ; Need 3 pieces
S BARBSTAT=$P(BARB3PB0,U,4) ; Bill Status
I '($I(PKDTOT)#1000) W "."
Q:BARBSTAT'="X"
;I '($I(PKDTOTC)#1000) W "X" ; Bill not cancelled in 3P
I $G(BARY("PTYP"))=2,$P($G(^AUPNPAT(BAR("P"),11)),U,12)'="I" Q ;Not eligible
I $G(BARY("PTYP"))=1,$P($G(^AUPNPAT(BAR("P"),11)),U,12)="I" Q ; Eligible
S BARBVSTY=$P(BARB3PB0,U,7) ;Visit Type
S BARBCLNC=$P(BARB3PB0,U,10) ; Visit Clinic
S BARBCANC=$P($G(^ABMDBILL(BAR3PDUZ,BAR3PIEN,1)),U,11) ; Cancelling Official
I $D(BARY("CANC")) Q:BARY("CANC")'=BARBCANC ; Quit if Cancelling Official doesn't match selection
S:BARBCANC="" BARBCANC=0 ; Piece not set In come older records
S BARBREAS=$P($G(^ABMDBILL(BAR3PDUZ,BAR3PIEN,1)),U,13) ; Reason Cancelled
S:BARBREAS="" BARBREAS="Not Listed"
; END
;
S BARLOC=""
S:BAR("L")]"" BARLOC=$$GET1^DIQ(4,BAR("L"),.01)
S:BARLOC="" BARLOC="No Visit Location" ; Visit Location Name
S BARACCT=""
S:BAR("I")]"" BARACCT=$$GET1^DIQ(90050.02,BAR("I"),.01)
S:BARACCT="" BARACCT="No A/R Account" ; A/R Account Name
S BARPAT=""
S:BAR("P")]"" BARPAT=$$GET1^DIQ(9000001,BAR("P"),.01)
S:BARPAT="" BARPAT="No Patient Name" ; Patient Name
S BARBILL=$P(BAR(0),U) ; Bill Number
S BARBAMT=$P(BAR(0),U,13) ; Amount Billed
S BARBAL=$P(BAR(0),U,15) ; Bill Balance
;
I BARY("RTYP")=1 D DETDATA
D SUMDATA
Q
; *********************************************************************
DETDATA ;
; Build global for Detail Report
; BAR*1.8*19 IHS/SD/PKD 5/10/10 - Cancelling Official is primary sort - BEGIN
;S ^TMP($J,"BAR-CXL",BARLOC,BARACCT,BAR("D"),BARPAT,BARBILL)=BARBAMT_U_BARBAL
; SORT: Cashier, Location, Visit Type (or Clinic) plus PT NM,HRN,BILL#
N BARSORT S BARSORT=$S(BARY("SORT")="V":BARBVSTY,1:BARBCLNC) ; visit type or Clinic
N HRN S HRN=$P(BARBILL,"-",3) I 'HRN S HRN=$P(BAR(1),"^",7)
I HRN="" S HRN="***** "
S ^TMP($J,"BAR-CXL MULT",BARBCANC,BARLOC,BARSORT,BARPAT,BARBILL)=""
S ^TMP($J,"BAR-CXL",BARBCANC,BARLOC,BARSORT,BARPAT,BARBILL)=BARBAMT_U_BARBAL
S ^TMP($J,"BAR-CXL",BARBCANC,BARLOC,BARSORT,BARPAT,BARBILL,"MORE")=BARACCT_U_BAR("D")_U_HRN_U_BARBREAS
; END 1.8*19
Q
; ********************************************************************
;
SUMDATA ;
; BAR*1.8*19 IHS/SD/PKD 5/10/10 - Add Cancelling Official as primary sort
; Build global for Summary Report (and Detail totals)
; Sum by AR Account
;S BARHOLD=$G(^TMP($J,"BAR-CXL",BARLOC,BARACCT))
;S $P(^TMP($J,"BAR-CXL",BARLOC,BARACCT),U)=$P(BARHOLD,U)+1
;S $P(^TMP($J,"BAR-CXL",BARLOC,BARACCT),U,2)=$P(BARHOLD,U,2)+BARBAMT
;S $P(^TMP($J,"BAR-CXL",BARLOC,BARACCT),U,3)=$P(BARHOLD,U,3)+BARBAL
;
; Sum by Visit Location
;S BARHOLD=$G(^TMP($J,"BAR-CXL",BARLOC))
;S $P(^TMP($J,"BAR-CXL",BARLOC),U)=$P(BARHOLD,U)+1
;S $P(^TMP($J,"BAR-CXL",BARLOC),U,2)=$P(BARHOLD,U,2)+BARBAMT
;S $P(^TMP($J,"BAR-CXL",BARLOC),U,3)=$P(BARHOLD,U,3)+BARBAL
;
; Sum for Report
;S BARHOLD=$G(^TMP($J,"BAR-CXL"))
;S $P(^TMP($J,"BAR-CXL"),U)=$P(BARHOLD,U)+1
;S $P(^TMP($J,"BAR-CXL"),U,2)=$P(BARHOLD,U,2)+BARBAMT
;S $P(^TMP($J,"BAR-CXL"),U,3)=$P(BARHOLD,U,3)+BARBAL
; Build global for Summary Report (and Detail totals)
;
; BAR*1.8*19 BEGIN NEW CODE
;
; Sum by AR Visit TYPE or CLINIC
N BARSORT S BARSORT=$S(BARY("SORT")="V":BARBVSTY,1:BARBCLNC)
S BARHOLD=$G(^TMP($J,"BAR-CXL",BARBCANC,BARLOC,BARSORT))
S $P(BARHOLD,U)=$P(BARHOLD,U)+1
S $P(BARHOLD,U,2)=$P(BARHOLD,U,2)+BARBAMT
S $P(BARHOLD,U,3)=$P(BARHOLD,U,3)+BARBAL
S ^TMP($J,"BAR-CXL",BARBCANC,BARLOC,BARSORT)=BARHOLD
;
; Sum by Visit Location
S BARHOLD=$G(^TMP($J,"BAR-CXL",BARBCANC,BARLOC))
S $P(BARHOLD,U)=$P(BARHOLD,U)+1
S $P(BARHOLD,U,2)=$P(BARHOLD,U,2)+BARBAMT
S $P(BARHOLD,U,3)=$P(BARHOLD,U,3)+BARBAL
S ^TMP($J,"BAR-CXL",BARBCANC,BARLOC)=BARHOLD
;
; Sum by Cancelling Official (cashier in 3PB)
S BARHOLD=$G(^TMP($J,"BAR-CXL",BARBCANC))
S $P(BARHOLD,U)=$P(BARHOLD,U)+1
S $P(BARHOLD,U,2)=$P(BARHOLD,U,2)+BARBAMT
S $P(BARHOLD,U,3)=$P(BARHOLD,U,3)+BARBAL
S ^TMP($J,"BAR-CXL",BARBCANC)=BARHOLD
;
; Sum for Report
S BARHOLD=$G(^TMP($J,"BAR-CXL"))
S $P(BARHOLD,U)=$P(BARHOLD,U)+1
S $P(BARHOLD,U,2)=$P(BARHOLD,U,2)+BARBAMT
S $P(BARHOLD,U,3)=$P(BARHOLD,U,3)+BARBAL
S ^TMP($J,"BAR-CXL")=BARHOLD
Q
; END BAR*1.8*19
BARRCXL1 ; IHS/SD/LSL - Cancelled Bills Report - Gather Data ;08/20/2008
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**7,19**;OCT 26, 2005
+2 ;
+3 ; IHS/SD/PKD - 05/07/10 - BAR*1.8.19
+4 ; IHS/SD/LSL - 03/10/03 - Routine created
+5 ; Called by BARRCXL
+6 ; MODIFIED XTMP FILE NAME TO TMP TO MEET SAC REQUIREMENTS;MRS:BAR*1.8*7 IM29892
+7 QUIT
+8 ; *********************************************************************
+9 ;
+10 ;
COMPUTE ; EP
+1 ;
+2 SET BAR("SUBR")="BAR-CXL"
+3 KILL ^TMP($JOB,"BAR-CXL"),^TMP($JOB,"BAR-CXL MULT"),^TMP($JOB,"BAR-CXL SUMY")
+4 ; Routine used to get data if no parameters
SET BARP("RTN")="BARRCXL1"
+5 ;S BARDUZ2=DUZ(2)
+6 ;S DUZ(2)=0
+7 ;F S DUZ(2)=$O(^BARBL(DUZ(2))) Q:'DUZ(2)!($G(BAR("F1")))
+8 ; Index "OBAL" should supercede any other Index
+9 SET BAR=0
+10 IF BARY("OBAL")=1
Begin DoDot:1
+11 FOR
SET BAR=$ORDER(^BARBL(DUZ(2),"OBAL",BAR))
IF 'BAR
QUIT
DO DATA
End DoDot:1
QUIT
+12 DO LOOP^BARRUTL
+13 ;S DUZ(2)=BARDUZ2
+14 QUIT
+15 ; *********************************************************************
+16 ;
DATA ; EP
+1 ; Called by BARRUTL if no parameters
+2 SET BARP("HIT")=0
+3 DO BILL^BARRCHK
+4 IF 'BARP("HIT")
QUIT
+5 SET BAR("3P LOC")=$$FIND3PB^BARUTL(DUZ(2),BAR)
+6 ; Bill not found 3PB
IF BAR("3P LOC")=""
QUIT
+7 SET BAR3PDUZ=$PIECE(BAR("3P LOC"),",")
+8 SET BAR3PIEN=$PIECE(BAR("3P LOC"),",",2)
+9 ; BAR*1.8*19 IHS/SD/PKD 5/10/10 START
+10 ;S BARBSTAT=$P($G(^ABMDBILL(BAR3PDUZ,BAR3PIEN,0),U,4)
+11 ; Need 3 pieces
SET BARB3PB0=$GET(^ABMDBILL(BAR3PDUZ,BAR3PIEN,0))
+12 ; Bill Status
SET BARBSTAT=$PIECE(BARB3PB0,U,4)
+13
*** ERROR ***
IF '($I(PKDTOT)#1000)
WRITE "."
+14 IF BARBSTAT'="X"
QUIT
+15 ;I '($I(PKDTOTC)#1000) W "X" ; Bill not cancelled in 3P
+16 ;Not eligible
IF $GET(BARY("PTYP"))=2
IF $PIECE($GET(^AUPNPAT(BAR("P"),11)),U,12)'="I"
QUIT
+17 ; Eligible
IF $GET(BARY("PTYP"))=1
IF $PIECE($GET(^AUPNPAT(BAR("P"),11)),U,12)="I"
QUIT
+18 ;Visit Type
SET BARBVSTY=$PIECE(BARB3PB0,U,7)
+19 ; Visit Clinic
SET BARBCLNC=$PIECE(BARB3PB0,U,10)
+20 ; Cancelling Official
SET BARBCANC=$PIECE($GET(^ABMDBILL(BAR3PDUZ,BAR3PIEN,1)),U,11)
+21 ; Quit if Cancelling Official doesn't match selection
IF $DATA(BARY("CANC"))
IF BARY("CANC")'=BARBCANC
QUIT
+22 ; Piece not set In come older records
IF BARBCANC=""
SET BARBCANC=0
+23 ; Reason Cancelled
SET BARBREAS=$PIECE($GET(^ABMDBILL(BAR3PDUZ,BAR3PIEN,1)),U,13)
+24 IF BARBREAS=""
SET BARBREAS="Not Listed"
+25 ; END
+26 ;
+27 SET BARLOC=""
+28 IF BAR("L")]""
SET BARLOC=$$GET1^DIQ(4,BAR("L"),.01)
+29 ; Visit Location Name
IF BARLOC=""
SET BARLOC="No Visit Location"
+30 SET BARACCT=""
+31 IF BAR("I")]""
SET BARACCT=$$GET1^DIQ(90050.02,BAR("I"),.01)
+32 ; A/R Account Name
IF BARACCT=""
SET BARACCT="No A/R Account"
+33 SET BARPAT=""
+34 IF BAR("P")]""
SET BARPAT=$$GET1^DIQ(9000001,BAR("P"),.01)
+35 ; Patient Name
IF BARPAT=""
SET BARPAT="No Patient Name"
+36 ; Bill Number
SET BARBILL=$PIECE(BAR(0),U)
+37 ; Amount Billed
SET BARBAMT=$PIECE(BAR(0),U,13)
+38 ; Bill Balance
SET BARBAL=$PIECE(BAR(0),U,15)
+39 ;
+40 IF BARY("RTYP")=1
DO DETDATA
+41 DO SUMDATA
+42 QUIT
+43 ; *********************************************************************
DETDATA ;
+1 ; Build global for Detail Report
+2 ; BAR*1.8*19 IHS/SD/PKD 5/10/10 - Cancelling Official is primary sort - BEGIN
+3 ;S ^TMP($J,"BAR-CXL",BARLOC,BARACCT,BAR("D"),BARPAT,BARBILL)=BARBAMT_U_BARBAL
+4 ; SORT: Cashier, Location, Visit Type (or Clinic) plus PT NM,HRN,BILL#
+5 ; visit type or Clinic
NEW BARSORT
SET BARSORT=$SELECT(BARY("SORT")="V":BARBVSTY,1:BARBCLNC)
+6 NEW HRN
SET HRN=$PIECE(BARBILL,"-",3)
IF 'HRN
SET HRN=$PIECE(BAR(1),"^",7)
+7 IF HRN=""
SET HRN="***** "
+8 SET ^TMP($JOB,"BAR-CXL MULT",BARBCANC,BARLOC,BARSORT,BARPAT,BARBILL)=""
+9 SET ^TMP($JOB,"BAR-CXL",BARBCANC,BARLOC,BARSORT,BARPAT,BARBILL)=BARBAMT_U_BARBAL
+10 SET ^TMP($JOB,"BAR-CXL",BARBCANC,BARLOC,BARSORT,BARPAT,BARBILL,"MORE")=BARACCT_U_BAR("D")_U_HRN_U_BARBREAS
+11 ; END 1.8*19
+12 QUIT
+13 ; ********************************************************************
+14 ;
SUMDATA ;
+1 ; BAR*1.8*19 IHS/SD/PKD 5/10/10 - Add Cancelling Official as primary sort
+2 ; Build global for Summary Report (and Detail totals)
+3 ; Sum by AR Account
+4 ;S BARHOLD=$G(^TMP($J,"BAR-CXL",BARLOC,BARACCT))
+5 ;S $P(^TMP($J,"BAR-CXL",BARLOC,BARACCT),U)=$P(BARHOLD,U)+1
+6 ;S $P(^TMP($J,"BAR-CXL",BARLOC,BARACCT),U,2)=$P(BARHOLD,U,2)+BARBAMT
+7 ;S $P(^TMP($J,"BAR-CXL",BARLOC,BARACCT),U,3)=$P(BARHOLD,U,3)+BARBAL
+8 ;
+9 ; Sum by Visit Location
+10 ;S BARHOLD=$G(^TMP($J,"BAR-CXL",BARLOC))
+11 ;S $P(^TMP($J,"BAR-CXL",BARLOC),U)=$P(BARHOLD,U)+1
+12 ;S $P(^TMP($J,"BAR-CXL",BARLOC),U,2)=$P(BARHOLD,U,2)+BARBAMT
+13 ;S $P(^TMP($J,"BAR-CXL",BARLOC),U,3)=$P(BARHOLD,U,3)+BARBAL
+14 ;
+15 ; Sum for Report
+16 ;S BARHOLD=$G(^TMP($J,"BAR-CXL"))
+17 ;S $P(^TMP($J,"BAR-CXL"),U)=$P(BARHOLD,U)+1
+18 ;S $P(^TMP($J,"BAR-CXL"),U,2)=$P(BARHOLD,U,2)+BARBAMT
+19 ;S $P(^TMP($J,"BAR-CXL"),U,3)=$P(BARHOLD,U,3)+BARBAL
+20 ; Build global for Summary Report (and Detail totals)
+21 ;
+22 ; BAR*1.8*19 BEGIN NEW CODE
+23 ;
+24 ; Sum by AR Visit TYPE or CLINIC
+25 NEW BARSORT
SET BARSORT=$SELECT(BARY("SORT")="V":BARBVSTY,1:BARBCLNC)
+26 SET BARHOLD=$GET(^TMP($JOB,"BAR-CXL",BARBCANC,BARLOC,BARSORT))
+27 SET $PIECE(BARHOLD,U)=$PIECE(BARHOLD,U)+1
+28 SET $PIECE(BARHOLD,U,2)=$PIECE(BARHOLD,U,2)+BARBAMT
+29 SET $PIECE(BARHOLD,U,3)=$PIECE(BARHOLD,U,3)+BARBAL
+30 SET ^TMP($JOB,"BAR-CXL",BARBCANC,BARLOC,BARSORT)=BARHOLD
+31 ;
+32 ; Sum by Visit Location
+33 SET BARHOLD=$GET(^TMP($JOB,"BAR-CXL",BARBCANC,BARLOC))
+34 SET $PIECE(BARHOLD,U)=$PIECE(BARHOLD,U)+1
+35 SET $PIECE(BARHOLD,U,2)=$PIECE(BARHOLD,U,2)+BARBAMT
+36 SET $PIECE(BARHOLD,U,3)=$PIECE(BARHOLD,U,3)+BARBAL
+37 SET ^TMP($JOB,"BAR-CXL",BARBCANC,BARLOC)=BARHOLD
+38 ;
+39 ; Sum by Cancelling Official (cashier in 3PB)
+40 SET BARHOLD=$GET(^TMP($JOB,"BAR-CXL",BARBCANC))
+41 SET $PIECE(BARHOLD,U)=$PIECE(BARHOLD,U)+1
+42 SET $PIECE(BARHOLD,U,2)=$PIECE(BARHOLD,U,2)+BARBAMT
+43 SET $PIECE(BARHOLD,U,3)=$PIECE(BARHOLD,U,3)+BARBAL
+44 SET ^TMP($JOB,"BAR-CXL",BARBCANC)=BARHOLD
+45 ;
+46 ; Sum for Report
+47 SET BARHOLD=$GET(^TMP($JOB,"BAR-CXL"))
+48 SET $PIECE(BARHOLD,U)=$PIECE(BARHOLD,U)+1
+49 SET $PIECE(BARHOLD,U,2)=$PIECE(BARHOLD,U,2)+BARBAMT
+50 SET $PIECE(BARHOLD,U,3)=$PIECE(BARHOLD,U,3)+BARBAL
+51 SET ^TMP($JOB,"BAR-CXL")=BARHOLD
+52 QUIT
+53 ; END BAR*1.8*19
