BARRUTL ; IHS/SD/LSL - Report Utility ; 07/26/2010
;;1.8;IHS ACCOUNTS RECEIVABLE;**6,19**;OCT 26, 2005
;
; IHS/ASDS/LSL - 08/29/00 - Routine created
;
; IHS/SD/LSL - 04/12/02 - V1.6 Patch 2
; Modified LOOP line tag to allow it to be used for new Age
; Summary Report
;
; IHS/SD/LSL - 10/03/02 - V1.7 - NDA-0902-180080
; Modified LOOP lne tag to allow reports to sort by date
; correctly. Reports show ** NO DATA TO PRINT **
;
; IHS/SD/LSL - 12/06/02 - V1.7 - NHA-0601-180049
; Modified to find bill in 3P correctly.
;
; IHS/SD/TMM 1.8*19 7/26/10 Select by Group Plans
Q
; ***************************************************
;
LOOP ;EP for Looping thru Bill File
; Note: BARY("OBAL") may not work if other Inclusion Selections made
; "OBAL" is OpenBalance bills variable BARY("STCR") is a little tricky IHS/SD/PKD 1/20/11
I $G(BARY("DT"))]"" D ; Sort by Date
. I BARY("DT")="V" S BARP("X")="E" Q ; Sort by Visit Date
. I BARY("DT")="A" S BARP("X")="AG" Q ; Sort by 3P Approval Date
. I BARY("DT")="X" S BARP("X")="H" Q ; Sort by Transmittal Date
E I $D(BARY("ACCT")) S BARP("X")="D" ; Sort by A/R Account
E I $D(BARY("PAT")) S BARP("X")="C" ; Sort by Patient
E I $D(BARY("STCR")) S BARP("X")="OBAL" ; Sort by Open Balance
E S BARP("X")=1 ; Sort by A/R Bill
I BARP("X") D Q ; If no parameters loop entire file
. S BAR=0
. F S BAR=$O(^BARBL(DUZ(2),BAR)) Q:'+BAR D @("DATA^"_BARP("RTN"))
I $G(BARY("DT"))]"","AXV"[BARY("DT") D Q
. S BARP("DT")=BARY("DT",1)-.5
. F S BARP("DT")=$O(^BARBL(DUZ(2),BARP("X"),BARP("DT"))) Q:'BARP("DT")!(BARP("DT")>(BARY("DT",2)+.5)) D
. . S BAR=""
. . F S BAR=$O(^BARBL(DUZ(2),BARP("X"),BARP("DT"),BAR)) Q:'BAR D @("DATA^"_BARP("RTN"))
S:$D(BARY("DT")) BARP("DT")=BARY("DT",1)-1
I $G(BARY("STCR"))]"" D Q
. S BAR=0
. F S BAR=$O(^BARBL(DUZ(2),BARP("X"),BAR)) Q:'BAR D @("DATA^"_BARP("RTN"))
S BAR=""
S BARP("RI")=$S(BARP("X")="D":BARY("ACCT"),1:BARY("PAT"))
I $G(BAR("OPT"))="STA" D GRPINS Q ; IHS/SD/PKD 1.8*19 move specific code to the end
F S BAR=$O(^BARBL(DUZ(2),BARP("X"),BARP("RI"),BAR)) Q:'BAR D @("DATA^"_BARP("RTN"))
;
Q
; *********************************************************************
;
TRANS ;EP for Looping thru Transaction File
S BARP("X")=$S($G(BARY("DT"))="T":"B",1:1)
;S:$D(BARY("BATCH")) BARP("X")="ACB"
S:$D(BARY("BATCH"))&($G(BARY("DT"))'="T") BARP("X")="ACB" ;BAR*1.8*6 IHS/SD/TPF 8/12/2008
I BARP("X") D Q ; If no parameters loop entire file
. S BARTR=0
. F S BARTR=$O(^BARTR(DUZ(2),BARTR)) Q:'+BARTR D @("DATA^"_BARP("RTN"))
I $G(BARY("DT"))="T" D Q
. 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
. . S BARTR=0
. . F S BARTR=$O(^BARTR(DUZ(2),BARP("X"),BARP("DT"),BARTR)) Q:'BARTR D @("DATA^"_BARP("RTN"))
I $D(BARY("ITEM")) D Q
. S BART=""
. F S BART=$O(^BARTR(DUZ(2),BARP("X"),BARY("BATCH"),BARY("ITEM"),BART)) Q:'BART D
. . S BARTR=0
. . F S BARTR=$O(^BARTR(DUZ(2),BARP("X"),BARY("BATCH"),BARY("ITEM"),BART,BARTR)) Q:'+BARTR D @("DATA^"_BARP("RTN"))
E D Q
. S BARI=""
. F S BARI=$O(^BARTR(DUZ(2),BARP("X"),BARY("BATCH"),BARI)) Q:'BARI D
. . S BART=""
. . F S BART=$O(^BARTR(DUZ(2),BARP("X"),BARY("BATCH"),BARI,BART)) Q:'BART D
. . . S BARTR=0
. . . F S BARTR=$O(^BARTR(DUZ(2),BARP("X"),BARY("BATCH"),BARI,BART,BARTR)) Q:'+BARTR D @("DATA^"_BARP("RTN"))
S BARP("RI")=$S(BARP("X")="C":BARY("ACCT"),1:BARY("PAT"))
S:$D(BARY("DT")) BARP("DT")=BARY("DT",1)-1
Q
; *********************************************************************
;
PSR ; EP - Loop A/R Period Summary Report Data File
S BAR("L")=0
F S BAR("L")=$O(^BARPSR(BAR("L"))) Q:'+BAR("L") D
. I $D(BARY("LOC")),BARY("LOC")'=BAR("L") Q ; Not chosen visit loc
. S BARPSR=BARBDT-1
. F S BARPSR=$O(^BARPSR(BAR("L"),1,BARPSR)) Q:'+BARPSR D
. . Q:BARPSR>BAREDT
. . D @("DATA^"_BARP("RTN")_1)
Q
; *********************************************************************
;
PAZ ;EP to pause report
I '$D(IO("Q")),$E(IOST)="C",'$D(IO("S")) D
.F W ! Q:$Y+3>IOSL
.K DIR
.S DIR(0)="E"
.D ^DIR
.K DIR
Q
; *********************************************************************
;
POUT ;EP for exiting report
K:$D(BAR("SUBR")) ^TMP(BAR("SUBR"),$J)
D KILL^%ZTLOAD
K BARY,BARP,BAR,IO("Q"),POP,DIR,DUOUT,DTOUT,ZTSK,DIROUT,DIRUT,%ZIS
Q
; *********************************************************************
;
MM ;EP
; Correct A/R Account and Bill Amount for bills on Mismatch Report
S DA=0
F S DA=$O(^BARBLER(DUZ(2),"AMM",1,DA)) Q:'+DA D MM2
K DIE,DA,DR,DIQ,DIC,ABMAMT,ABMINS,ABMINSN,BAR,BAR3PDUZ
Q
; *********************************************************************
;
MM2 ;
; Check each entry in A/R bill error for Mismatch
K DIE,DR,DIC,DIQ,ABMAMT,ABMINS,ABMINSN,BAR,BAR3PDUZ,BAR3PIEN
S DIC="^BARBL(DUZ(2),"
S DIQ="BAR("
S DIQ(0)="IE"
S DR="3;13;17;22;108"
D EN^DIQ1
S BAR("3P LOC")=$$FIND3PB^BARUTL(DUZ(2),DA)
S BAR3PDUZ=$P(BAR("3P LOC"),",")
S BAR3PIEN=$P(BAR("3P LOC"),",",2)
Q:'$G(BAR3PDUZ)
S BAR3PINS=$P($G(^ABMDBILL(BAR3PDUZ,BAR3PIEN,0)),U,8)
Q:BAR3PINS=""
S BAR3PINN=$P($G(^AUTNINS(BAR3PINS,0)),U)
I BAR3PINN'=$G(BAR(90050.01,DA,3,"E")) D
. S DR="3///^S X=BAR3PINN"
. I $P($G(^ABMDBILL(BAR3PDUZ,BAR3PIEN,13,BAR3PINS,0)),U,2)=1 S DR=DR_";205///^S X=BAR3PINN"
S BAR3PAMT=$P($G(^ABMDBILL(BAR3PDUZ,BAR3PIEN,2)),U)
I ((BAR3PAMT+.005)\.01/100)'=((BAR(90050.01,DA,13,"I")+.005)\.01/100) S DR=DR_";13///^S X=BAR3PAMT"
Q:'$D(DR)
S:$E(DR)=";" DR=$E(DR,2,99)
S DIE="^BARBL(DUZ(2),"
D ^DIE
K DR,DIE,BAR,BAR3PDUZ,BAR3PIEN
Q
;
GRPINS ; IHS/SD/TMM 1.8*19 7/20/10
; If Group Plan entered, filter
F S BAR=$O(^BARBL(DUZ(2),BARP("X"),BARP("RI"),BAR)) Q:'BAR D
. ;If user did not specify a group, report all groups
. I $G(BAR("OPT"))="STA",'$D(BARY("GRP PLAN")) D @("DATA^"_BARP("RTN")) Q ;1.8*19 8/16/10
. ;Verify if group was specified
. S BARGRPBL=$$GROUPLAN^BARUTL(BAR) ;Valid grp plan returns: 1^BARGPIEN^BARGPNUM^BARGPNAM...
. I $P(BARGRPBL,U)=0!$P(BARGRPBL,U)="" Q ;Group Plan not found in Employer Group Insurance
. S BARGPNUM=$P($P(BARGRPBL,U,2),"|",2)
. S BARGPIEN=$P($P(BARGRPBL,U,2),"|",1)
. S BARGPNAM=$P($P(BARGRPBL,U,2),"|",3)
. I BARGPIEN="" Q
. I '$D(BARY("GRP PLAN",BARGPIEN)) Q ;Group Plan for this bill not requested
. D @("DATA^"_BARP("RTN"))
; ;End 1.8*19
BARRUTL ; IHS/SD/LSL - Report Utility ; 07/26/2010
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**6,19**;OCT 26, 2005
+2 ;
+3 ; IHS/ASDS/LSL - 08/29/00 - Routine created
+4 ;
+5 ; IHS/SD/LSL - 04/12/02 - V1.6 Patch 2
+6 ; Modified LOOP line tag to allow it to be used for new Age
+7 ; Summary Report
+8 ;
+9 ; IHS/SD/LSL - 10/03/02 - V1.7 - NDA-0902-180080
+10 ; Modified LOOP lne tag to allow reports to sort by date
+11 ; correctly. Reports show ** NO DATA TO PRINT **
+12 ;
+13 ; IHS/SD/LSL - 12/06/02 - V1.7 - NHA-0601-180049
+14 ; Modified to find bill in 3P correctly.
+15 ;
+16 ; IHS/SD/TMM 1.8*19 7/26/10 Select by Group Plans
+17 QUIT
+18 ; ***************************************************
+19 ;
LOOP ;EP for Looping thru Bill File
+1 ; Note: BARY("OBAL") may not work if other Inclusion Selections made
+2 ; "OBAL" is OpenBalance bills variable BARY("STCR") is a little tricky IHS/SD/PKD 1/20/11
+3 ; Sort by Date
IF $GET(BARY("DT"))]""
Begin DoDot:1
+4 ; Sort by Visit Date
IF BARY("DT")="V"
SET BARP("X")="E"
QUIT
+5 ; Sort by 3P Approval Date
IF BARY("DT")="A"
SET BARP("X")="AG"
QUIT
+6 ; Sort by Transmittal Date
IF BARY("DT")="X"
SET BARP("X")="H"
QUIT
End DoDot:1
+7 ; Sort by A/R Account
IF '$TEST
IF $DATA(BARY("ACCT"))
SET BARP("X")="D"
+8 ; Sort by Patient
IF '$TEST
IF $DATA(BARY("PAT"))
SET BARP("X")="C"
+9 ; Sort by Open Balance
IF '$TEST
IF $DATA(BARY("STCR"))
SET BARP("X")="OBAL"
+10 ; Sort by A/R Bill
IF '$TEST
SET BARP("X")=1
+11 ; If no parameters loop entire file
IF BARP("X")
Begin DoDot:1
+12 SET BAR=0
+13 FOR
SET BAR=$ORDER(^BARBL(DUZ(2),BAR))
IF '+BAR
QUIT
DO @("DATA^"_BARP("RTN"))
End DoDot:1
QUIT
+14 IF $GET(BARY("DT"))]""
IF "AXV"[BARY("DT")
Begin DoDot:1
+15 SET BARP("DT")=BARY("DT",1)-.5
+16 FOR
SET BARP("DT")=$ORDER(^BARBL(DUZ(2),BARP("X"),BARP("DT")))
IF 'BARP("DT")!(BARP("DT")>(BARY("DT",2)+.5))
QUIT
Begin DoDot:2
+17 SET BAR=""
+18 FOR
SET BAR=$ORDER(^BARBL(DUZ(2),BARP("X"),BARP("DT"),BAR))
IF 'BAR
QUIT
DO @("DATA^"_BARP("RTN"))
End DoDot:2
End DoDot:1
QUIT
+19 IF $DATA(BARY("DT"))
SET BARP("DT")=BARY("DT",1)-1
+20 IF $GET(BARY("STCR"))]""
Begin DoDot:1
+21 SET BAR=0
+22 FOR
SET BAR=$ORDER(^BARBL(DUZ(2),BARP("X"),BAR))
IF 'BAR
QUIT
DO @("DATA^"_BARP("RTN"))
End DoDot:1
QUIT
+23 SET BAR=""
+24 SET BARP("RI")=$SELECT(BARP("X")="D":BARY("ACCT"),1:BARY("PAT"))
+25 ; IHS/SD/PKD 1.8*19 move specific code to the end
IF $GET(BAR("OPT"))="STA"
DO GRPINS
QUIT
+26 FOR
SET BAR=$ORDER(^BARBL(DUZ(2),BARP("X"),BARP("RI"),BAR))
IF 'BAR
QUIT
DO @("DATA^"_BARP("RTN"))
+27 ;
+28 QUIT
+29 ; *********************************************************************
+30 ;
TRANS ;EP for Looping thru Transaction File
+1 SET BARP("X")=$SELECT($GET(BARY("DT"))="T":"B",1:1)
+2 ;S:$D(BARY("BATCH")) BARP("X")="ACB"
+3 ;BAR*1.8*6 IHS/SD/TPF 8/12/2008
IF $DATA(BARY("BATCH"))&($GET(BARY("DT"))'="T")
SET BARP("X")="ACB"
+4 ; If no parameters loop entire file
IF BARP("X")
Begin DoDot:1
+5 SET BARTR=0
+6 FOR
SET BARTR=$ORDER(^BARTR(DUZ(2),BARTR))
IF '+BARTR
QUIT
DO @("DATA^"_BARP("RTN"))
End DoDot:1
QUIT
+7 IF $GET(BARY("DT"))="T"
Begin DoDot:1
+8 SET BARP("DT")=BARY("DT",1)-.5
+9 FOR
SET BARP("DT")=$ORDER(^BARTR(DUZ(2),BARP("X"),BARP("DT")))
IF 'BARP("DT")!(BARP("DT")>(BARY("DT",2)+.5))
QUIT
Begin DoDot:2
+10 SET BARTR=0
+11 FOR
SET BARTR=$ORDER(^BARTR(DUZ(2),BARP("X"),BARP("DT"),BARTR))
IF 'BARTR
QUIT
DO @("DATA^"_BARP("RTN"))
End DoDot:2
End DoDot:1
QUIT
+12 IF $DATA(BARY("ITEM"))
Begin DoDot:1
+13 SET BART=""
+14 FOR
SET BART=$ORDER(^BARTR(DUZ(2),BARP("X"),BARY("BATCH"),BARY("ITEM"),BART))
IF 'BART
QUIT
Begin DoDot:2
+15 SET BARTR=0
+16 FOR
SET BARTR=$ORDER(^BARTR(DUZ(2),BARP("X"),BARY("BATCH"),BARY("ITEM"),BART,BARTR))
IF '+BARTR
QUIT
DO @("DATA^"_BARP("RTN"))
End DoDot:2
End DoDot:1
QUIT
+17 IF '$TEST
Begin DoDot:1
+18 SET BARI=""
+19 FOR
SET BARI=$ORDER(^BARTR(DUZ(2),BARP("X"),BARY("BATCH"),BARI))
IF 'BARI
QUIT
Begin DoDot:2
+20 SET BART=""
+21 FOR
SET BART=$ORDER(^BARTR(DUZ(2),BARP("X"),BARY("BATCH"),BARI,BART))
IF 'BART
QUIT
Begin DoDot:3
+22 SET BARTR=0
+23 FOR
SET BARTR=$ORDER(^BARTR(DUZ(2),BARP("X"),BARY("BATCH"),BARI,BART,BARTR))
IF '+BARTR
QUIT
DO @("DATA^"_BARP("RTN"))
End DoDot:3
End DoDot:2
End DoDot:1
QUIT
+24 SET BARP("RI")=$SELECT(BARP("X")="C":BARY("ACCT"),1:BARY("PAT"))
+25 IF $DATA(BARY("DT"))
SET BARP("DT")=BARY("DT",1)-1
+26 QUIT
+27 ; *********************************************************************
+28 ;
PSR ; EP - Loop A/R Period Summary Report Data File
+1 SET BAR("L")=0
+2 FOR
SET BAR("L")=$ORDER(^BARPSR(BAR("L")))
IF '+BAR("L")
QUIT
Begin DoDot:1
+3 ; Not chosen visit loc
IF $DATA(BARY("LOC"))
IF BARY("LOC")'=BAR("L")
QUIT
+4 SET BARPSR=BARBDT-1
+5 FOR
SET BARPSR=$ORDER(^BARPSR(BAR("L"),1,BARPSR))
IF '+BARPSR
QUIT
Begin DoDot:2
+6 IF BARPSR>BAREDT
QUIT
+7 DO @("DATA^"_BARP("RTN")_1)
End DoDot:2
End DoDot:1
+8 QUIT
+9 ; *********************************************************************
+10 ;
PAZ ;EP to pause report
+1 IF '$DATA(IO("Q"))
IF $EXTRACT(IOST)="C"
IF '$DATA(IO("S"))
Begin DoDot:1
+2 FOR
WRITE !
IF $Y+3>IOSL
QUIT
+3 KILL DIR
+4 SET DIR(0)="E"
+5 DO ^DIR
+6 KILL DIR
End DoDot:1
+7 QUIT
+8 ; *********************************************************************
+9 ;
POUT ;EP for exiting report
+1 IF $DATA(BAR("SUBR"))
KILL ^TMP(BAR("SUBR"),$JOB)
+2 DO KILL^%ZTLOAD
+3 KILL BARY,BARP,BAR,IO("Q"),POP,DIR,DUOUT,DTOUT,ZTSK,DIROUT,DIRUT,%ZIS
+4 QUIT
+5 ; *********************************************************************
+6 ;
MM ;EP
+1 ; Correct A/R Account and Bill Amount for bills on Mismatch Report
+2 SET DA=0
+3 FOR
SET DA=$ORDER(^BARBLER(DUZ(2),"AMM",1,DA))
IF '+DA
QUIT
DO MM2
+4 KILL DIE,DA,DR,DIQ,DIC,ABMAMT,ABMINS,ABMINSN,BAR,BAR3PDUZ
+5 QUIT
+6 ; *********************************************************************
+7 ;
MM2 ;
+1 ; Check each entry in A/R bill error for Mismatch
+2 KILL DIE,DR,DIC,DIQ,ABMAMT,ABMINS,ABMINSN,BAR,BAR3PDUZ,BAR3PIEN
+3 SET DIC="^BARBL(DUZ(2),"
+4 SET DIQ="BAR("
+5 SET DIQ(0)="IE"
+6 SET DR="3;13;17;22;108"
+7 DO EN^DIQ1
+8 SET BAR("3P LOC")=$$FIND3PB^BARUTL(DUZ(2),DA)
+9 SET BAR3PDUZ=$PIECE(BAR("3P LOC"),",")
+10 SET BAR3PIEN=$PIECE(BAR("3P LOC"),",",2)
+11 IF '$GET(BAR3PDUZ)
QUIT
+12 SET BAR3PINS=$PIECE($GET(^ABMDBILL(BAR3PDUZ,BAR3PIEN,0)),U,8)
+13 IF BAR3PINS=""
QUIT
+14 SET BAR3PINN=$PIECE($GET(^AUTNINS(BAR3PINS,0)),U)
+15 IF BAR3PINN'=$GET(BAR(90050.01,DA,3,"E"))
Begin DoDot:1
+16 SET DR="3///^S X=BAR3PINN"
+17 IF $PIECE($GET(^ABMDBILL(BAR3PDUZ,BAR3PIEN,13,BAR3PINS,0)),U,2)=1
SET DR=DR_";205///^S X=BAR3PINN"
End DoDot:1
+18 SET BAR3PAMT=$PIECE($GET(^ABMDBILL(BAR3PDUZ,BAR3PIEN,2)),U)
+19 IF ((BAR3PAMT+.005)\.01/100)'=((BAR(90050.01,DA,13,"I")+.005)\.01/100)
SET DR=DR_";13///^S X=BAR3PAMT"
+20 IF '$DATA(DR)
QUIT
+21 IF $EXTRACT(DR)=";"
SET DR=$EXTRACT(DR,2,99)
+22 SET DIE="^BARBL(DUZ(2),"
+23 DO ^DIE
+24 KILL DR,DIE,BAR,BAR3PDUZ,BAR3PIEN
+25 QUIT
+26 ;
GRPINS ; IHS/SD/TMM 1.8*19 7/20/10
+1 ; If Group Plan entered, filter
+2 FOR
SET BAR=$ORDER(^BARBL(DUZ(2),BARP("X"),BARP("RI"),BAR))
IF 'BAR
QUIT
Begin DoDot:1
+3 ;If user did not specify a group, report all groups
+4 ;1.8*19 8/16/10
IF $GET(BAR("OPT"))="STA"
IF '$DATA(BARY("GRP PLAN"))
DO @("DATA^"_BARP("RTN"))
QUIT
+5 ;Verify if group was specified
+6 ;Valid grp plan returns: 1^BARGPIEN^BARGPNUM^BARGPNAM...
SET BARGRPBL=$$GROUPLAN^BARUTL(BAR)
+7 ;Group Plan not found in Employer Group Insurance
IF $PIECE(BARGRPBL,U)=0!$PIECE(BARGRPBL,U)=""
QUIT
+8 SET BARGPNUM=$PIECE($PIECE(BARGRPBL,U,2),"|",2)
+9 SET BARGPIEN=$PIECE($PIECE(BARGRPBL,U,2),"|",1)
+10 SET BARGPNAM=$PIECE($PIECE(BARGRPBL,U,2),"|",3)
+11 IF BARGPIEN=""
QUIT
+12 ;Group Plan for this bill not requested
IF '$DATA(BARY("GRP PLAN",BARGPIEN))
QUIT
+13 DO @("DATA^"_BARP("RTN"))
End DoDot:1
+14 ; ;End 1.8*19
