BARRPRP ; IHS/SD/LSL - Payment Summary Report by Collection Batch ;08/20/2008
;;1.8;IHS ACCOUNTS RECEIVABLE;**7**;OCT 26, 2005
; MODIFIED XTMP FILE NAME TO TMP TO MEET SAC REQUIREMENTS;MRS:BAR*1.8*7 IM29892
; IHS/SD/LSL - 04/18/03 - V1.8
; Routine created
Q
; *********************************************************************
;
EN ; EP
K BARY,BAR
D:'$D(BARUSR) INIT^BARUTL ; Setup basic A/R variables
S BARP("RTN")="BARRPRP" ; Routine used to get data
S BAR("PRIVACY")=1 ; Privacy act applies
S BAR("LOC")="BILLING" ; Location is ALWAYS billing
D ^BARRSEL ; Select exclusion parameters
I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q
W !!," ============ Entry of COLLECTION BATCH OPEN DATE Range =============",!
D DATES
Q:+BARSTART<1 ; Dates answered wrong
D ASKSORT^BARRSEL ; Ask sort by Clinic/Visit
D:BARASK SORT^BARRSEL ; Ask Clinic/Visit
S BARQ("RC")="COMPUTE^BARRPRP" ; Compute routine
S BARQ("RP")="PRINT^BARRPRP2" ; Print routine
S BARQ("NS")="BAR" ; Namespace for variables
S BARQ("RX")="POUT^BARRUTL" ; Clean-up routine
D ^BARDBQUE ; Double queuing
D PAZ^BARRUTL
Q
; *********************************************************************
;
DATES ;
; Ask Collection Batch Open Date Range
S BARSTART=$$DATE^BARDUTL(1)
I BARSTART<1 Q
S BAREND=$$DATE^BARDUTL(2)
I BAREND<1 W ! G DATES
I BAREND<BARSTART D G DATES
.W *7
.W !!,"The END date must not be before the START date.",!
S X1=BAREND
S X2=BARSTART
D ^%DTC
I X>31 D G DATES
. W *7
. W !!,"The date range must not exceed 31 days. Please try a different range.",!
S BARY("DT",1)=BARSTART
S BARY("DT",2)=BAREND
Q
; ********************************************************************
;
COMPUTE ; EP
; Find bills matching criteria and store in ^TMP($J,"BAR-PRP")
K ^TMP($J,"BAR-PRP")
; First loop Collection batch open dates
S BARDT=$O(^BARCOL(DUZ(2),"C",BARSTART),-1)
F S BARDT=$O(^BARCOL(DUZ(2),"C",BARDT)) Q:((BARDT>BAREND)!(BARDT="")) D BATCH
;
; Find Batched total for header
K BARBTOT
S BARBNAME=""
F S BARBNAME=$O(BARB(BARBNAME)) Q:BARBNAME="" D
. S $P(BARBTOT,U)=$P(BARB(BARBNAME),U)+$P($G(BARBTOT),U)
. S $P(BARBTOT,U,2)=$P(BARB(BARBNAME),U,2)+$P($G(BARBTOT),U,2)
. S $P(BARBTOT,U,3)=$P(BARB(BARBNAME),U,3)+$P($G(BARBTOT),U,3)
Q
; ********************************************************************
;
BATCH ;
; Loop batches opened on BARDT
S BARBATCH=0
F S BARBATCH=$O(^BARCOL(DUZ(2),"C",BARDT,BARBATCH)) Q:'+BARBATCH D DATA
Q
; ********************************************************************
;
DATA ;
; Collect data for report
Q:'$D(^BARCOL(DUZ(2),BARBATCH,0)) ; No data for col batch
Q:'$D(^BARTR(DUZ(2),"ACB",BARBATCH)) ; Batch not in TRANS file
S BARCB(0)=$G(^BARCOL(DUZ(2),BARBATCH,0)) ; 0 node for batch
I $D(BARY("COLPT")),BARY("COLPT")'=$P(BARCB(0),U,2) Q ; Not col pt
S BARBNAME=$P(BARCB(0),U) ; Collection batch name
S BARBAMT=$$GET1^DIQ(90051.01,BARBATCH,15) ; Batch amount
S BARBPST=$$GET1^DIQ(90051.01,BARBATCH,16) ; Batch posted amount
S BARBUPST=$$GET1^DIQ(90051.01,BARBATCH,17) ; Batch unposted amount
S BARITM=0
F S BARITM=$O(^BARTR(DUZ(2),"ACB",BARBATCH,BARITM)) Q:'+BARITM D TRANS
Q
; ********************************************************************
;
TRANS ;
; Loop payment transanctions on the batch
Q:'$D(^BARTR(DUZ(2),"ACB",BARBATCH,BARITM,40)) ; No payments
S BARTR=0
F S BARTR=$O(^BARTR(DUZ(2),"ACB",BARBATCH,BARITM,40,BARTR)) Q:'+BARTR D MORE
Q
; ********************************************************************
;
MORE ;
Q:'$D(^BARTR(DUZ(2),BARTR,0)) ; No transaction data
S BARTR(0)=$G(^BARTR(DUZ(2),BARTR,0))
Q:'+$P(BARTR(0),U,4) ; No bill on transaction
S BARBL=$P(BARTR(0),U,4) ; A/R Bill IEN
Q:'$D(^BARBL(DUZ(2),BARBL,0)) ; No bill data
S BAR(0)=$G(^BARBL(DUZ(2),BARBL,0)) ; O node A/R Bill file
S BAR(1)=$G(^BARBL(DUZ(2),BARBL,1)) ; 1 node A/R Bill file
S BARAC=$P(BAR(0),U,3) ; A/R Account IEN
S:+BARAC BARITYP=$$GET1^DIQ(90050.02,BARAC,1.08) ; Insurer Type
I $D(BARY("ITYP")),$G(BARITYP)'=BARY("ITYP","NM") Q ; Not chsn Ins Type
I $D(BARY("CLIN")),'$D(BARY("CLIN",$P(BAR(1),U,12))) Q ;Not chsn clin
I $D(BARY("VTYP")),'$D(BARY("VTYP",$P(BAR(1),U,14))) Q ;Not chsn vtyp
I $D(BARY("LOC")),BARY("LOC")'=$P(BAR(1),U,8) Q ; Not chsn loc
S BARVIS=$$GET1^DIQ(90050.01,BARBL,108) ; Visit Location
S:BARVIS="" BARVIS="No Visit Location"
S BARCLIN=$$GET1^DIQ(90050.01,BARBL,112) ; Clinic
S:BARCLIN="" BARCLIN="No clinic"
S BARVTYP=$$GET1^DIQ(90050.01,BARBL,114) ; Visit Type
S:BARVTYP="" BARVTYP="No Visit Type"
S BARBLAMT=$P(BAR(0),U,13) ; Bill Amount
S BARPAY=$$GET1^DIQ(90050.03,BARTR,3.6) ; Payment
S BARDOS=$$GET1^DIQ(90050.01,BARBL,102,"I") ; DOS Begin
S BARMDOS=$E(BARDOS,1,5)_"00" ; DOS Mon/yr
S BARB(BARBNAME)=BARBAMT_U_BARBPST_U_BARBUPST
I +BARASK D Q
. I BARY("SORT")="C" S BARSORT=BARCLIN
. I BARY("SORT")="V" S BARSORT=BARVTYP
. D CLINVIS
D DETAIL
Q
; ********************************************************************
;
CLINVIS ;
; Data sorted by Clinic/Visit
S BARHOLD=$G(^TMP($J,"BAR-PRP",BARVIS,BARSORT,BARMDOS))
I $D(^TMP($J,"BAR-PRP",BARVIS,BARSORT,BARMDOS,BARBL)) D Q
. S $P(^TMP($J,"BAR-PRP",BARVIS,BARSORT,BARMDOS),U,3)=$P(BARHOLD,U,3)+BARPAY
S ^TMP($J,"BAR-PRP",BARVIS,BARSORT,BARMDOS,BARBL)=""
S $P(^TMP($J,"BAR-PRP",BARVIS,BARSORT,BARMDOS),U)=$P(BARHOLD,U,1)+1
S $P(^TMP($J,"BAR-PRP",BARVIS,BARSORT,BARMDOS),U,2)=$P(BARHOLD,U,2)+BARBLAMT
S $P(^TMP($J,"BAR-PRP",BARVIS,BARSORT,BARMDOS),U,3)=$P(BARHOLD,U,3)+BARPAY
Q
; ********************************************************************
;
DETAIL ;
; Detail Report data
S BARHOLD=$G(^TMP($J,"BAR-PRP",BARVIS,BARMDOS))
I $D(^TMP($J,"BAR-PRP",BARVIS,BARMDOS,BARBL)) D Q
. S $P(^TMP($J,"BAR-PRP",BARVIS,BARMDOS),U,3)=$P(BARHOLD,U,3)+BARPAY
S ^TMP($J,"BAR-PRP",BARVIS,BARMDOS,BARBL)=""
S $P(^TMP($J,"BAR-PRP",BARVIS,BARMDOS),U)=$P(BARHOLD,U)+1
S $P(^TMP($J,"BAR-PRP",BARVIS,BARMDOS),U,2)=$P(BARHOLD,U,2)+BARBLAMT
S $P(^TMP($J,"BAR-PRP",BARVIS,BARMDOS),U,3)=$P(BARHOLD,U,3)+BARPAY
Q
BARRPRP ; IHS/SD/LSL - Payment Summary Report by Collection Batch ;08/20/2008
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**7**;OCT 26, 2005
+2 ; MODIFIED XTMP FILE NAME TO TMP TO MEET SAC REQUIREMENTS;MRS:BAR*1.8*7 IM29892
+3 ; IHS/SD/LSL - 04/18/03 - V1.8
+4 ; Routine created
+5 QUIT
+6 ; *********************************************************************
+7 ;
EN ; EP
+1 KILL BARY,BAR
+2 ; Setup basic A/R variables
IF '$DATA(BARUSR)
DO INIT^BARUTL
+3 ; Routine used to get data
SET BARP("RTN")="BARRPRP"
+4 ; Privacy act applies
SET BAR("PRIVACY")=1
+5 ; Location is ALWAYS billing
SET BAR("LOC")="BILLING"
+6 ; Select exclusion parameters
DO ^BARRSEL
+7 IF $DATA">DATA">DATA">DATA(DTOUT)!$DATA">DATA">DATA">DATA(DUOUT)!$DATA">DATA">DATA">DATA(DIROUT)
QUIT
+8 WRITE !!," ============ Entry of COLLECTION BATCH OPEN DATE Range =============",!
+9 DO DATES
+10 ; Dates answered wrong
IF +BARSTART<1
QUIT
+11 ; Ask sort by Clinic/Visit
DO ASKSORT^BARRSEL
+12 ; Ask Clinic/Visit
IF BARASK
DO SORT^BARRSEL
+13 ; Compute routine
SET BARQ("RC")="COMPUTE^BARRPRP"
+14 ; Print routine
SET BARQ("RP")="PRINT^BARRPRP2"
+15 ; Namespace for variables
SET BARQ("NS")="BAR"
+16 ; Clean-up routine
SET BARQ("RX")="POUT^BARRUTL"
+17 ; Double queuing
DO ^BARDBQUE
+18 DO PAZ^BARRUTL
+19 QUIT
+20 ; *********************************************************************
+21 ;
DATES ;
+1 ; Ask Collection Batch Open Date Range
+2 SET BARSTART=$$DATE^BARDUTL(1)
+3 IF BARSTART<1
QUIT
+4 SET BAREND=$$DATE^BARDUTL(2)
+5 IF BAREND<1
WRITE !
GOTO DATES
+6 IF BAREND<BARSTART
Begin DoDot:1
+7 WRITE *7
+8 WRITE !!,"The END date must not be before the START date.",!
End DoDot:1
GOTO DATES
+9 SET X1=BAREND
+10 SET X2=BARSTART
+11 DO ^%DTC
+12 IF X>31
Begin DoDot:1
+13 WRITE *7
+14 WRITE !!,"The date range must not exceed 31 days. Please try a different range.",!
End DoDot:1
GOTO DATES
+15 SET BARY("DT",1)=BARSTART
+16 SET BARY("DT",2)=BAREND
+17 QUIT
+18 ; ********************************************************************
+19 ;
COMPUTE ; EP
+1 ; Find bills matching criteria and store in ^TMP($J,"BAR-PRP")
+2 KILL ^TMP($JOB,"BAR-PRP")
+3 ; First loop Collection batch open dates
+4 SET BARDT=$ORDER(^BARCOL(DUZ(2),"C",BARSTART),-1)
+5 FOR
SET BARDT=$ORDER(^BARCOL(DUZ(2),"C",BARDT))
IF ((BARDT>BAREND)!(BARDT=""))
QUIT
DO BATCH
+6 ;
+7 ; Find Batched total for header
+8 KILL BARBTOT
+9 SET BARBNAME=""
+10 FOR
SET BARBNAME=$ORDER(BARB(BARBNAME))
IF BARBNAME=""
QUIT
Begin DoDot:1
+11 SET $PIECE(BARBTOT,U)=$PIECE(BARB(BARBNAME),U)+$PIECE($GET(BARBTOT),U)
+12 SET $PIECE(BARBTOT,U,2)=$PIECE(BARB(BARBNAME),U,2)+$PIECE($GET(BARBTOT),U,2)
+13 SET $PIECE(BARBTOT,U,3)=$PIECE(BARB(BARBNAME),U,3)+$PIECE($GET(BARBTOT),U,3)
End DoDot:1
+14 QUIT
+15 ; ********************************************************************
+16 ;
BATCH ;
+1 ; Loop batches opened on BARDT
+2 SET BARBATCH=0
+3 FOR
SET BARBATCH=$ORDER(^BARCOL(DUZ(2),"C",BARDT,BARBATCH))
IF '+BARBATCH
QUIT
DO DATA
+4 QUIT
+5 ; ********************************************************************
+6 ;
DATA ;
+1 ; Collect data for report
+2 ; No data for col batch
IF '$DATA(^BARCOL(DUZ(2),BARBATCH,0))
QUIT
+3 ; Batch not in TRANS file
IF '$DATA(^BARTR(DUZ(2),"ACB",BARBATCH))
QUIT
+4 ; 0 node for batch
SET BARCB(0)=$GET(^BARCOL(DUZ(2),BARBATCH,0))
+5 ; Not col pt
IF $DATA(BARY("COLPT"))
IF BARY("COLPT")'=$PIECE(BARCB(0),U,2)
QUIT
+6 ; Collection batch name
SET BARBNAME=$PIECE(BARCB(0),U)
+7 ; Batch amount
SET BARBAMT=$$GET1^DIQ(90051.01,BARBATCH,15)
+8 ; Batch posted amount
SET BARBPST=$$GET1^DIQ(90051.01,BARBATCH,16)
+9 ; Batch unposted amount
SET BARBUPST=$$GET1^DIQ(90051.01,BARBATCH,17)
+10 SET BARITM=0
+11 FOR
SET BARITM=$ORDER(^BARTR(DUZ(2),"ACB",BARBATCH,BARITM))
IF '+BARITM
QUIT
DO TRANS
+12 QUIT
+13 ; ********************************************************************
+14 ;
TRANS ;
+1 ; Loop payment transanctions on the batch
+2 ; No payments
IF '$DATA(^BARTR(DUZ(2),"ACB",BARBATCH,BARITM,40))
QUIT
+3 SET BARTR=0
+4 FOR
SET BARTR=$ORDER(^BARTR(DUZ(2),"ACB",BARBATCH,BARITM,40,BARTR))
IF '+BARTR
QUIT
DO MORE
+5 QUIT
+6 ; ********************************************************************
+7 ;
MORE ;
+1 ; No transaction data
IF '$DATA(^BARTR(DUZ(2),BARTR,0))
QUIT
+2 SET BARTR(0)=$GET(^BARTR(DUZ(2),BARTR,0))
+3 ; No bill on transaction
IF '+$PIECE(BARTR(0),U,4)
QUIT
+4 ; A/R Bill IEN
SET BARBL=$PIECE(BARTR(0),U,4)
+5 ; No bill data
IF '$DATA(^BARBL(DUZ(2),BARBL,0))
QUIT
+6 ; O node A/R Bill file
SET BAR(0)=$GET(^BARBL(DUZ(2),BARBL,0))
+7 ; 1 node A/R Bill file
SET BAR(1)=$GET(^BARBL(DUZ(2),BARBL,1))
+8 ; A/R Account IEN
SET BARAC=$PIECE(BAR(0),U,3)
+9 ; Insurer Type
IF +BARAC
SET BARITYP=$$GET1^DIQ(90050.02,BARAC,1.08)
+10 ; Not chsn Ins Type
IF $DATA(BARY("ITYP"))
IF $GET(BARITYP)'=BARY("ITYP","NM")
QUIT
+11 ;Not chsn clin
IF $DATA(BARY("CLIN"))
IF '$DATA(BARY("CLIN",$PIECE(BAR(1),U,12)))
QUIT
+12 ;Not chsn vtyp
IF $DATA(BARY("VTYP"))
IF '$DATA(BARY("VTYP",$PIECE(BAR(1),U,14)))
QUIT
+13 ; Not chsn loc
IF $DATA(BARY("LOC"))
IF BARY("LOC")'=$PIECE(BAR(1),U,8)
QUIT
+14 ; Visit Location
SET BARVIS=$$GET1^DIQ(90050.01,BARBL,108)
+15 IF BARVIS=""
SET BARVIS="No Visit Location"
+16 ; Clinic
SET BARCLIN=$$GET1^DIQ(90050.01,BARBL,112)
+17 IF BARCLIN=""
SET BARCLIN="No clinic"
+18 ; Visit Type
SET BARVTYP=$$GET1^DIQ(90050.01,BARBL,114)
+19 IF BARVTYP=""
SET BARVTYP="No Visit Type"
+20 ; Bill Amount
SET BARBLAMT=$PIECE(BAR(0),U,13)
+21 ; Payment
SET BARPAY=$$GET1^DIQ(90050.03,BARTR,3.6)
+22 ; DOS Begin
SET BARDOS=$$GET1^DIQ(90050.01,BARBL,102,"I")
+23 ; DOS Mon/yr
SET BARMDOS=$EXTRACT(BARDOS,1,5)_"00"
+24 SET BARB(BARBNAME)=BARBAMT_U_BARBPST_U_BARBUPST
+25 IF +BARASK
Begin DoDot:1
+26 IF BARY("SORT")="C"
SET BARSORT=BARCLIN
+27 IF BARY("SORT")="V"
SET BARSORT=BARVTYP
+28 DO CLINVIS
End DoDot:1
QUIT
+29 DO DETAIL
+30 QUIT
+31 ; ********************************************************************
+32 ;
CLINVIS ;
+1 ; Data sorted by Clinic/Visit
+2 SET BARHOLD=$GET(^TMP($JOB,"BAR-PRP",BARVIS,BARSORT,BARMDOS))
+3 IF $DATA(^TMP($JOB,"BAR-PRP",BARVIS,BARSORT,BARMDOS,BARBL))
Begin DoDot:1
+4 SET $PIECE(^TMP($JOB,"BAR-PRP",BARVIS,BARSORT,BARMDOS),U,3)=$PIECE(BARHOLD,U,3)+BARPAY
End DoDot:1
QUIT
+5 SET ^TMP($JOB,"BAR-PRP",BARVIS,BARSORT,BARMDOS,BARBL)=""
+6 SET $PIECE(^TMP($JOB,"BAR-PRP",BARVIS,BARSORT,BARMDOS),U)=$PIECE(BARHOLD,U,1)+1
+7 SET $PIECE(^TMP($JOB,"BAR-PRP",BARVIS,BARSORT,BARMDOS),U,2)=$PIECE(BARHOLD,U,2)+BARBLAMT
+8 SET $PIECE(^TMP($JOB,"BAR-PRP",BARVIS,BARSORT,BARMDOS),U,3)=$PIECE(BARHOLD,U,3)+BARPAY
+9 QUIT
+10 ; ********************************************************************
+11 ;
DETAIL ;
+1 ; Detail Report data
+2 SET BARHOLD=$GET(^TMP($JOB,"BAR-PRP",BARVIS,BARMDOS))
+3 IF $DATA(^TMP($JOB,"BAR-PRP",BARVIS,BARMDOS,BARBL))
Begin DoDot:1
+4 SET $PIECE(^TMP($JOB,"BAR-PRP",BARVIS,BARMDOS),U,3)=$PIECE(BARHOLD,U,3)+BARPAY
End DoDot:1
QUIT
+5 SET ^TMP($JOB,"BAR-PRP",BARVIS,BARMDOS,BARBL)=""
+6 SET $PIECE(^TMP($JOB,"BAR-PRP",BARVIS,BARMDOS),U)=$PIECE(BARHOLD,U)+1
+7 SET $PIECE(^TMP($JOB,"BAR-PRP",BARVIS,BARMDOS),U,2)=$PIECE(BARHOLD,U,2)+BARBLAMT
+8 SET $PIECE(^TMP($JOB,"BAR-PRP",BARVIS,BARMDOS),U,3)=$PIECE(BARHOLD,U,3)+BARPAY
+9 QUIT
