Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BARUP

BARUP.m

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