Routine: BARRCXL1

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

 ; *********************************************************************

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

 ; *********************************************************************

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

 ; *********************************************************************

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

 ; ********************************************************************

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

 ; 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

BARRCXL1.m