BARUP ; IHS/SD/LSL - UPLOAD BILL FROM 3P ;
;;1.8;IHS ACCOUNTS RECEIVABLE;**19,23,24**;OCT 26, 2005;Build 69
;
; IHS/SD/LSL - 11/27/02 - V1.7 - QAA-1200-130051
; Inserted documentation.
;
; IHS/SD/LSL - 06/09/03 - V1.7 Patch 1
; Don't new BAROPT. Needed to determine if path to this
; routine originated from an AR Upload menu option.
;
; *********************************************************************
;
; Global change to use indirection ABMA - @BAR3PUP@
;
;** Upload from 3P BILL file to A/R BILL/IHS file
;
;** This routine is intended to be called from the 3p billing module
; at the time an item is created in the 3P BILL file.
;
;** Calling this routine at the entry point TPB^BARUP(ABMA ARRAY)
; will create an entry in the A/R BILL/IHS file.
;
;** Calling this routine at the entry point TPBPRT^BARUP(ABMA ARRAY)
; will update the 3P Print date and the date billed for ageing
;
;** ACTION from 3P ABMAPASS will now be numeric.
; 99 - indicates a cancelled bill in 3P
; 1,2,3 - indicates that the active insurer is primary,secondary,etc
;IHS/SD/POT HEAT73895 - DISPLAY REASON OF NOT UPLOADING 08/21/2012 BAR*1.8*23
;IHS/SD/SDR HEAT118656 BARERR BAR*1.8*24
Q
; *********************************************************************
;
TPB(BAR3PUP) ;** entry point from third party billing
;
Q:'$L($G(@BAR3PUP@("BLNM")))
N BARDUZ2
;
INIT ;
D EN^XBNEW("NEW0^BARUP","ABMA,BAR3PUP,BAROPT")
Q
; *********************************************************************
;
NEW0 ;
CHECK ;
S BARDUZ2=DUZ(2)
S X=@BAR3PUP@("BLNM")
I @BAR3PUP@("ACTION")="99" D ^BARBLCN Q ; Cancelling bill in 3PB
K BARGO
D SET ; Set up variables
Q:'$G(BARGO)
D UPLOAD^BARUP1 ; Create bill in A/R
;IHS/SD/AR BAR*1.8*19 06.17.2010
S BARMIEN=0
F S BARMIEN=$O(@BAR3PUP@(74,BARMIEN)) Q:(+$G(BARMIEN)<1) D
. D MSGTX^BARUP1 ; CREATE MESSAGE TRANSACTION
S DUZ(2)=BARDUZ2
K BARDUZ2
Q
; *********************************************************************
;
SET ;EP - set up variables
;
GETSERV ;** hospital service section
S BARSERV=$O(^DIC(49,"B","BUSINESS OFFICE","")) ; Serv/Sect=BO
;
; -------------------------------
GETPAR ;** visit location comes from #.03 of 3p bill file
;** GET duz(2)
; get parent from parent/satellite file
S BARSAT=$G(@BAR3PUP@("VSLC")) ; Satellite = 3P Visit loc
S BARPAR=0 ; Parent
S DA=0,BARERR=0 ;HEAT73895 - SET BARERR BAR*1.8*23
F S DA=$O(^BAR(90052.06,DA)) Q:DA'>0 D Q:BARPAR
. ;;;;I DUZ=838 W !,$ZN," ",DA
. I '$D(^BAR(90052.06,DA,DA)) S BARERR=1_";"_DA QUIT ; Pos Parent UNDEF Site Parameter
. I '$D(^BAR(90052.05,DA,BARSAT)) S BARERR=2_";"_DA_";"_BARSAT QUIT ; Satellite UNDEF Parent/Satellit
. I +$P($G(^BAR(90052.05,DA,BARSAT,0)),U,5) S BARERR=3_";"_DA_";"_BARSAT QUIT ; Par/Sat not usable
. ; Q if sat NOT active at DOS
. I @BAR3PUP@("DOSB")<$P($G(^BAR(90052.05,DA,BARSAT,0)),U,6) S BARERR=4_";"_DA_";"_BARSAT_";DOS="_@BAR3PUP@("DOSB")_";Activated:"_$P($G(^BAR(90052.05,DA,BARSAT,0)),U,6) QUIT
. ; Q if sat became NOT active before DOS
. I $P($G(^BAR(90052.05,DA,BARSAT,0)),U,7),(@BAR3PUP@("DOSB")>$P($G(^BAR(90052.05,DA,BARSAT,0)),U,7)) S BARERR=5_";"_DA_";"_BARSAT QUIT
. S BARPAR=$S(BARSAT:$P($G(^BAR(90052.05,DA,BARSAT,0)),U,3),1:"") I BARPAR="" S BARERR=6_";"_DA_";"_BARSAT
I 'BARPAR D ERRMSG(BARERR) Q ; No parent defined for satellite
;------------------------------------------------------
;start new code IHS/SD/SDR belcourt HEAT118656 BARERR BAR*1.8*24
;this is for the UPAP option; parent found is not the one we are running upload for - skip it
;
I +$G(^BARTMP("BARUP","STARTDUZ(2)"))'=0,(BARPAR'=+$G(^BARTMP("BARUP","STARTDUZ(2)"))) D Q
.W !!,"Claim is for a different parent location and won't be uploaded."
.W !,"Claim number: "_@BAR3PUP@("BLNM"),!
.S BARERR=+$O(^BARTMP("BARUP","ERRORS",999999999),-1)
.S BARERR=BARERR+1
.S ^BARTMP("BARUP","ERRORS",BARERR)=(@BAR3PUP@("BLNM"))_U_"Different Parent Location"
.W !,BARERR
;end new code belcourt HEAT118656
;------------------------------------------------------
S DUZ(2)=BARPAR
;
; -------------------------------
; check to see if site ready for 3P bills, if Site not define or
; if 12 piece not set to 1 quit
Q:'$P($G(^BAR(90052.06,BARPAR,BARPAR,0)),U,12)
S BARGO=1
;
; -------------------------------
GETACC ;** a/r facility account
S BARACC=$G(@BAR3PUP@("INS"))_";AUTNINS("
S:+BARACC=0 BARACC=$G(@BAR3PUP@("PTNM"))_";AUPNPAT("
S BARACEIN=$O(^BARAC(DUZ(2),"B",BARACC,""))
S:'BARACEIN BARACEIN=$$SETACC(BARACC) ; IEN to A/R FACILITY ACCOUNT
;
; -------------------------------
GETTYP ;** bill type from file ^BAR(90052.01
S BARBLTYP=$S(@BAR3PUP@("ACTION")=99:"",@BAR3PUP@("ACTION")>1:"R",1:"P")
;
INSORD ;
S BARTMP1(205)=$G(@BAR3PUP@("PRIM"))
S BARTMP1(206)=$G(@BAR3PUP@("SEC"))
S BARTMP1(207)=$G(@BAR3PUP@("TERT"))
F J=205:1:207 D
. Q:'$L(BARTMP1(J))
. S BARACC=BARTMP1(J)_";AUTNINS("
. S BARACODA=$O(^BARAC(DUZ(2),"B",BARACC,""))
. I 'BARACODA S BARACODA=$$SETACC(BARACC)
. S BARTMP1(J)=BARACODA
;
; -------------------------------
GETSTAT ;** bill status = open
N DIC D
.S DIC="^BARTBL(",DIC(0)="M",X="OPEN"
.S DIC("S")="I $P(^(0),U,2)=$O(^BAR(90052.01,""B"",""BILL STATUS"",0))"
.K D,DO
.D ^DIC
.K DIC
.S BARSTAT=$S(+Y:+Y,1:"")
.Q
;
; -------------------------------
PATDATA ;** patient data from patient file
S (BARSSN,BARHRN,BARTYP,BARPBEN,BARTOC)=""
S BARPTDA=$G(@BAR3PUP@("PTNM"))
I 'BARPTDA G GETPRV
S BARSSN=$P($G(^DPT(BARPTDA,0)),U,9)
I $G(@BAR3PUP@("VSLC")) S BARHRN=$P($G(^AUPNPAT(BARPTDA,41,@BAR3PUP@("VSLC"),0)),U,2)
S BARPTYP="??"
S BARPBEN=""
S X="AUPNPAT1"
X ^%ZOSF("TEST")
I $T S BARPBEN=$$BEN^AUPNPAT1(BARPTDA)
S BARPBEN=$S(BARPBEN=1:1,BARPBEN="":"",1:0)
;
; -------------------------------
GETPRV ;** primary provider
S BARPRV=$G(@BAR3PUP@("PROV"))
Q
; ********************************************************************
;
SETACC(BARACC) ;EP - establish record in A/R FACILITY ACCOUNT file
N DIC,BARACODA
S DIC="^BARAC(DUZ(2),"
S DIC(0)="L"
S X=BARACC
S DIC("DR")="2////^S X=96"
S DIC("DR")=DIC("DR")_";3////^S X=DT"
S DIC("DR")=DIC("DR")_";8////^S X=$G(DUZ(2))"
S DIC("DR")=DIC("DR")_";10////^S X=$G(BARSERV)"
S DLAYGO=90050
K DD,DO
D FILE^DICN
K DLAYGO,DIC
S BARACODA=$S(+Y<0:"",1:+Y)
Q BARACODA
ERRMSG(BARERR) ;P.OTTIS HEAT # 73895 - DISPLAY BARERR TYPE BAR*1.8*23
W !,"A bill could not be created in A/R. Reason:"
I +BARERR=1 W !,"Parent site not defined in: Site Parameter File"
I +BARERR=2 W !,"Satellite site not defined in: Parent/Satellit File"
I +BARERR=3 W !,"Parent/Satellite marked as 'not usable'"
I +BARERR=4 W !,"'Date of Service' is before the 'visit location activated date'"
I +BARERR=5 W !,"'Date of Service' is AFTER the 'visit location closed date'"
I +BARERR=6 w !,"Parent not defined for satellite in: Parent/Satellite file"
;W !,"[internal BARERR code: ",BARERR,"]"
QUIT
BARUP ; IHS/SD/LSL - UPLOAD BILL FROM 3P ;
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**19,23,24**;OCT 26, 2005;Build 69
+2 ;
+3 ; IHS/SD/LSL - 11/27/02 - V1.7 - QAA-1200-130051
+4 ; Inserted documentation.
+5 ;
+6 ; IHS/SD/LSL - 06/09/03 - V1.7 Patch 1
+7 ; Don't new BAROPT. Needed to determine if path to this
+8 ; routine originated from an AR Upload menu option.
+9 ;
+10 ; *********************************************************************
+11 ;
+12 ; Global change to use indirection ABMA - @BAR3PUP@
+13 ;
+14 ;** Upload from 3P BILL file to A/R BILL/IHS file
+15 ;
+16 ;** This routine is intended to be called from the 3p billing module
+17 ; at the time an item is created in the 3P BILL file.
+18 ;
+19 ;** Calling this routine at the entry point TPB^BARUP(ABMA ARRAY)
+20 ; will create an entry in the A/R BILL/IHS file.
+21 ;
+22 ;** Calling this routine at the entry point TPBPRT^BARUP(ABMA ARRAY)
+23 ; will update the 3P Print date and the date billed for ageing
+24 ;
+25 ;** ACTION from 3P ABMAPASS will now be numeric.
+26 ; 99 - indicates a cancelled bill in 3P
+27 ; 1,2,3 - indicates that the active insurer is primary,secondary,etc
+28 ;IHS/SD/POT HEAT73895 - DISPLAY REASON OF NOT UPLOADING 08/21/2012 BAR*1.8*23
+29 ;IHS/SD/SDR HEAT118656 BARERR BAR*1.8*24
+30 QUIT
+31 ; *********************************************************************
+32 ;
TPB(BAR3PUP) ;** entry point from third party billing
+1 ;
+2 IF '$LENGTH($GET(@BAR3PUP@("BLNM")))
QUIT
+3 NEW BARDUZ2
+4 ;
INIT ;
+1 DO EN^XBNEW("NEW0^BARUP","ABMA,BAR3PUP,BAROPT")
+2 QUIT
+3 ; *********************************************************************
+4 ;
NEW0 ;
CHECK ;
+1 SET BARDUZ2=DUZ(2)
+2 SET X=@BAR3PUP@("BLNM")
+3 ; Cancelling bill in 3PB
IF @BAR3PUP@("ACTION")="99"
DO ^BARBLCN
QUIT
+4 KILL BARGO
+5 ; Set up variables
DO SET
+6 IF '$GET(BARGO)
QUIT
+7 ; Create bill in A/R
DO UPLOAD^BARUP1
+8 ;IHS/SD/AR BAR*1.8*19 06.17.2010
+9 SET BARMIEN=0
+10 FOR
SET BARMIEN=$ORDER(@BAR3PUP@(74,BARMIEN))
IF (+$GET(BARMIEN)<1)
QUIT
Begin DoDot:1
+11 ; CREATE MESSAGE TRANSACTION
DO MSGTX^BARUP1
End DoDot:1
+12 SET DUZ(2)=BARDUZ2
+13 KILL BARDUZ2
+14 QUIT
+15 ; *********************************************************************
+16 ;
SET ;EP - set up variables
+1 ;
GETSERV ;** hospital service section
+1 ; Serv/Sect=BO
SET BARSERV=$ORDER(^DIC(49,"B","BUSINESS OFFICE",""))
+2 ;
+3 ; -------------------------------
GETPAR ;** visit location comes from #.03 of 3p bill file
+1 ;** GET duz(2)
+2 ; get parent from parent/satellite file
+3 ; Satellite = 3P Visit loc
SET BARSAT=$GET(@BAR3PUP@("VSLC"))
+4 ; Parent
SET BARPAR=0
+5 ;HEAT73895 - SET BARERR BAR*1.8*23
SET DA=0
SET BARERR=0
+6 FOR
SET DA=$ORDER(^BAR(90052.06,DA))
IF DA'>0
QUIT
Begin DoDot:1
+7 ;;;;I DUZ=838 W !,$ZN," ",DA
+8 ; Pos Parent UNDEF Site Parameter
IF '$DATA(^BAR(90052.06,DA,DA))
SET BARERR=1_";"_DA
QUIT
+9 ; Satellite UNDEF Parent/Satellit
IF '$DATA(^BAR(90052.05,DA,BARSAT))
SET BARERR=2_";"_DA_";"_BARSAT
QUIT
+10 ; Par/Sat not usable
IF +$PIECE($GET(^BAR(90052.05,DA,BARSAT,0)),U,5)
SET BARERR=3_";"_DA_";"_BARSAT
QUIT
+11 ; Q if sat NOT active at DOS
+12 IF @BAR3PUP@("DOSB")<$PIECE($GET(^BAR(90052.05,DA,BARSAT,0)),U,6)
SET BARERR=4_";"_DA_";"_BARSAT_";DOS="_@BAR3PUP@("DOSB")_";Activated:"_$PIECE($GET(^BAR(90052.05,DA,BARSAT,0)),U,6)
QUIT
+13 ; Q if sat became NOT active before DOS
+14 IF $PIECE($GET(^BAR(90052.05,DA,BARSAT,0)),U,7)
IF (@BAR3PUP@("DOSB")>$PIECE($GET(^BAR(90052.05,DA,BARSAT,0)),U,7))
SET BARERR=5_";"_DA_";"_BARSAT
QUIT
+15 SET BARPAR=$SELECT(BARSAT:$PIECE($GET(^BAR(90052.05,DA,BARSAT,0)),U,3),1:"")
IF BARPAR=""
SET BARERR=6_";"_DA_";"_BARSAT
End DoDot:1
IF BARPAR
QUIT
+16 ; No parent defined for satellite
IF 'BARPAR
DO ERRMSG(BARERR)
QUIT
+17 ;------------------------------------------------------
+18 ;start new code IHS/SD/SDR belcourt HEAT118656 BARERR BAR*1.8*24
+19 ;this is for the UPAP option; parent found is not the one we are running upload for - skip it
+20 ;
+21 IF +$GET(^BARTMP("BARUP","STARTDUZ(2)"))'=0
IF (BARPAR'=+$GET(^BARTMP("BARUP","STARTDUZ(2)")))
Begin DoDot:1
+22 WRITE !!,"Claim is for a different parent location and won't be uploaded."
+23 WRITE !,"Claim number: "_@BAR3PUP@("BLNM"),!
+24 SET BARERR=+$ORDER(^BARTMP("BARUP","ERRORS",999999999),-1)
+25 SET BARERR=BARERR+1
+26 SET ^BARTMP("BARUP","ERRORS",BARERR)=(@BAR3PUP@("BLNM"))_U_"Different Parent Location"
+27 WRITE !,BARERR
End DoDot:1
QUIT
+28 ;end new code belcourt HEAT118656
+29 ;------------------------------------------------------
+30 SET DUZ(2)=BARPAR
+31 ;
+32 ; -------------------------------
+33 ; check to see if site ready for 3P bills, if Site not define or
+34 ; if 12 piece not set to 1 quit
+35 IF '$PIECE($GET(^BAR(90052.06,BARPAR,BARPAR,0)),U,12)
QUIT
+36 SET BARGO=1
+37 ;
+38 ; -------------------------------
GETACC ;** a/r facility account
+1 SET BARACC=$GET(@BAR3PUP@("INS"))_";AUTNINS("
+2 IF +BARACC=0
SET BARACC=$GET(@BAR3PUP@("PTNM"))_";AUPNPAT("
+3 SET BARACEIN=$ORDER(^BARAC(DUZ(2),"B",BARACC,""))
+4 ; IEN to A/R FACILITY ACCOUNT
IF 'BARACEIN
SET BARACEIN=$$SETACC(BARACC)
+5 ;
+6 ; -------------------------------
GETTYP ;** bill type from file ^BAR(90052.01
+1 SET BARBLTYP=$SELECT(@BAR3PUP@("ACTION")=99:"",@BAR3PUP@("ACTION")>1:"R",1:"P")
+2 ;
INSORD ;
+1 SET BARTMP1(205)=$GET(@BAR3PUP@("PRIM"))
+2 SET BARTMP1(206)=$GET(@BAR3PUP@("SEC"))
+3 SET BARTMP1(207)=$GET(@BAR3PUP@("TERT"))
+4 FOR J=205:1:207
Begin DoDot:1
+5 IF '$LENGTH(BARTMP1(J))
QUIT
+6 SET BARACC=BARTMP1(J)_";AUTNINS("
+7 SET BARACODA=$ORDER(^BARAC(DUZ(2),"B",BARACC,""))
+8 IF 'BARACODA
SET BARACODA=$$SETACC(BARACC)
+9 SET BARTMP1(J)=BARACODA
End DoDot:1
+10 ;
+11 ; -------------------------------
GETSTAT ;** bill status = open
+1 NEW DIC
Begin DoDot:1
+2 SET DIC="^BARTBL("
SET DIC(0)="M"
SET X="OPEN"
+3 SET DIC("S")="I $P(^(0),U,2)=$O(^BAR(90052.01,""B"",""BILL STATUS"",0))"
+4 KILL D,DO
+5 DO ^DIC
+6 KILL DIC
+7 SET BARSTAT=$SELECT(+Y:+Y,1:"")
+8 QUIT
End DoDot:1
+9 ;
+10 ; -------------------------------
PATDATA ;** patient data from patient file
+1 SET (BARSSN,BARHRN,BARTYP,BARPBEN,BARTOC)=""
+2 SET BARPTDA=$GET(@BAR3PUP@("PTNM"))
+3 IF 'BARPTDA
GOTO GETPRV
+4 SET BARSSN=$PIECE($GET(^DPT(BARPTDA,0)),U,9)
+5 IF $GET(@BAR3PUP@("VSLC"))
SET BARHRN=$PIECE($GET(^AUPNPAT(BARPTDA,41,@BAR3PUP@("VSLC"),0)),U,2)
+6 SET BARPTYP="??"
+7 SET BARPBEN=""
+8 SET X="AUPNPAT1"
+9 XECUTE ^%ZOSF("TEST")
+10 IF $TEST
SET BARPBEN=$$BEN^AUPNPAT1(BARPTDA)
+11 SET BARPBEN=$SELECT(BARPBEN=1:1,BARPBEN="":"",1:0)
+12 ;
+13 ; -------------------------------
GETPRV ;** primary provider
+1 SET BARPRV=$GET(@BAR3PUP@("PROV"))
+2 QUIT
+3 ; ********************************************************************
+4 ;
SETACC(BARACC) ;EP - establish record in A/R FACILITY ACCOUNT file
+1 NEW DIC,BARACODA
+2 SET DIC="^BARAC(DUZ(2),"
+3 SET DIC(0)="L"
+4 SET X=BARACC
+5 SET DIC("DR")="2////^S X=96"
+6 SET DIC("DR")=DIC("DR")_";3////^S X=DT"
+7 SET DIC("DR")=DIC("DR")_";8////^S X=$G(DUZ(2))"
+8 SET DIC("DR")=DIC("DR")_";10////^S X=$G(BARSERV)"
+9 SET DLAYGO=90050
+10 KILL DD,DO
+11 DO FILE^DICN
+12 KILL DLAYGO,DIC
+13 SET BARACODA=$SELECT(+Y<0:"",1:+Y)
+14 QUIT BARACODA
ERRMSG(BARERR) ;P.OTTIS HEAT # 73895 - DISPLAY BARERR TYPE BAR*1.8*23
+1 WRITE !,"A bill could not be created in A/R. Reason:"
+2 IF +BARERR=1
WRITE !,"Parent site not defined in: Site Parameter File"
+3 IF +BARERR=2
WRITE !,"Satellite site not defined in: Parent/Satellit File"
+4 IF +BARERR=3
WRITE !,"Parent/Satellite marked as 'not usable'"
+5 IF +BARERR=4
WRITE !,"'Date of Service' is before the 'visit location activated date'"
+6 IF +BARERR=5
WRITE !,"'Date of Service' is AFTER the 'visit location closed date'"
+7 IF +BARERR=6
WRITE !,"Parent not defined for satellite in: Parent/Satellite file"
+8 ;W !,"[internal BARERR code: ",BARERR,"]"
+9 QUIT
