BAREDPA1 ; IHS/SD/LSL - INITIATORY ROUTINE FOR MEDICARE 3051.4A ; 12/12/2007
;;1.8;IHS ACCOUNTS RECEIVABLE;**1,4,5,6,20**;OCT 26,2005
;
; IHS/ASDS/LSL - 06/19/2001 - V1.5 Patch 1 - NOIS HQW-0201-100027
; FM 22 issue. Modified to include E in DIC(0)
;
; IHS/SD/LSL - 08/22/2002 - V1.7 Patch 4 - HIPAA
; Added REFID line tag to set VVERNUM and VPATHRN
;
; IHS/SD/LSL - 11/17/03 - V1.7 Patch 4 - HIPAA
; Allow POS bills to look at DOS at the Service Level. POS
; bills can be identified from the RA in CLP01 where the first
; character is always a 0 (zero) as set in ABSPOSBB.
;
; IHS/SD/LSL - 02/10/04 - V1.7 Patch 5 - Remark Codes
; Add RMKCD linetag that takes ERA Remark Code values and
; populates REMARK CODE multiple of CLAIM multiple in
; A/R EDI IMPORT File
;
; IHS/SD/LSL - 02/24/04 - V1.7 Patch 5 - IM12723
; Resolve <SBSCR>IDENT+18^BAREDPA1. Occurs when loading streamed
; files that contain EOF.
;
; IHS/SD/LSL - 03/04/04 - V1.7 Patch 5 - NCPDP
; Add LQ linetag that takes code from LQ02 and populates REMARK
; CODE or NCPDP REJ/PAY multiple of CLAIM multiple in A/R
; EDI IMPORT file accordingly.
;
; IHS/SD/LSL - 03/17/04 - V1.7 Patch 5
; Allow DOS from SVC loop if no claim start date sent.
;
; ********************************************************************
;
SEP(IMPDA) ; EP
; find seperators according to standards for transport
; E - Element seperator
; S - Segment seperator
; SE - Sub Element seperator
; The following is specific to the MEDICARE 835 3051.4a and HIPAA 835
;E is 4th character of 1st segment
;S is 2nd character of 17th element of 1st segment
;SE is 1st character of 17th element of 1st segment
;
K A
N I
F I=1:1:3 S A(I)=^BAREDI("I",DUZ(2),IMPDA,10,I,0)
D STRIP ; remove trailing spaces
S X=A(1)_A(2)_A(3)
S E=$E(X,4) ; Element Separator
S Y=$P(X,E,17)
S SE=$E(Y) ; Sub - Element Separator
S S=$E(Y,2) ; Segment Separator
Q
; ********************************************************************
;
STRIP ;
F I=1:1:3 D
. F S L=$L(A(I)) Q:$E(A(I),L)'=" " S A(I)=$E(A(I),1,L-1)
Q
; ********************************************************************
;
BILNUM ;EP
; process a new bill
W:'(COUNT#10) "."
W:'(COUNT#100) " ",COUNT,!
S COUNT=COUNT+1
K DIC,DR,DA
S DIC=$$DIC^XBDIQ1(90056.0205)
S DIC(0)="EXL"
S DIC("P")="90056.0205A"
S DIC("DR")=".03////^S X=$G(VNEWPRV)"
S X=VNEWBILL
W !,X
S DA(1)=IMPDA
K DD,DO D FILE^DICN
S CLMDA=+Y
S DA=+Y
S DIE=DIC
K DIC
K DR
S DR=".04///^S X=VCLMPAY"
S DR=DR_";.05///^S X=VCLMCHG"
S DR=DR_";302///^S X=VBILNUM" ;BAR*1.8*5 POPULATE 'PAYER CLAIM CONTROL # (ICN)'
;BAR*1.8*4 SCR56,SCR58
S DR=DR_";.11///^S X=$E($G(VCLMSTAT),1,25)"
;END BAR*1.8*4
S DR=DR_";205///^S X=$G(VBPRAMT)" ;BAR*1.8*6 SCR119 POPULATE NEW BPR AMOUNT FIELD
;
D ^DIE
; other processing to be done at newbill
S ADJDA=0
; Put check number at claim level to capture multiple checks per RA
S DR="201///^S X=VCHECK"
D ^DIE
S RMKDA=0
S LQDA=0
Q
; ********************************************************************
;
RMKCD ; EP
; Populate remark codes to impda,clmda
Q:'$L(VRMKCD)
K DIC,DA,DR,X,Y
S X=$P(VRMKCD," ")
S DIC="^BARMKCD("
S DIC(0)="ZX"
K DD,DO
D ^DIC
S VRMKCDP=+Y
Q:$D(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,40,"C",VRMKCDP))
S RMKDA=RMKDA+1
K DIE,DR,DA,X,DIC
S DA(2)=IMPDA
S DA(1)=CLMDA
S X=RMKDA
S DLAYGO=90056
S DIC=$$DIC^XBDIQ1(90056.0211)
S DIC("P")=$P($G(^DD(90056.0205,40,0)),U,2)
S DIC(0)="EXL"
S DIC("DR")=".02///^S X=VRMKCD"
I VRMKCDP>0 S DIC("DR")=DIC("DR")_";.03////^S X=VRMKCDP"
K DD,DO
D ^DIC
Q
; ********************************************************************
;
LQ ; EP
; Populate remark codes/NCPDP codes to impda,clmda
Q:'$L(VLQCD)
I $P(XREC(1.01),E,2)="HE" D Q
. S VRMKCD=VLQCD
. D RMKCD
I $P(XREC(1.01),E,2)'="RX" Q
K DIC,DA,DR,X,Y
S X=$P(VLQCD," ")
S DIC="^ABSPF(9002313.93,"
S DIC(0)="ZX"
K DD,DO
D ^DIC
S VLQCDP=+Y
Q:$D(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,50,"C",VLQCDP))
S LQDA=LQDA+1
K DIE,DR,DA,X,DIC
S DA(2)=IMPDA
S DA(1)=CLMDA
S X=LQDA
S DLAYGO=90056
S DIC=$$DIC^XBDIQ1(90056.0212)
S DIC("P")=$P($G(^DD(90056.0205,50,0)),U,2)
S DIC(0)="EXL"
S DIC("DR")=".02///^S X=VLQCD"
I VLQCDP>0 S DIC("DR")=DIC("DR")_";.03////^S X=VLQCDP"
K DD,DO
D ^DIC
Q
; ********************************************************************
;
CLMDOSE ;EP
; Process the claim at the VCLMDOSE variable
K DIE,DR,DA
S DIE=$$DIC^XBDIQ1(90056.0205)
S DA=CLMDA
S DA(1)=IMPDA
S PAT=VPATLN_","_VPATFN_" "_VPATMID
S PATID=$G(VPATHRN)_" | "_$G(VPATHIC)
S DR=".06///^S X=$E(PAT,1,30)"
S DR=DR_";.07///^S X=PATID"
S DR=DR_";.08///^S X=VCLMDOSB"
S DR=DR_";.09///^S X=VCLMDOSE"
D ^DIE
Q
;*********************************************************************
;
ADJAMT ;EP
; Process reason and amount into claim impda,clmda
I '$L(VADJREA),'$L(VADJAMT) Q
S ADJDA=ADJDA+1
K DIE,DR,DA,X,DIC
S DA(2)=IMPDA
S DA(1)=CLMDA
S X=ADJDA
S DIC=$$DIC^XBDIQ1(90056.0208)
S DIC("P")="90056.0208A"
S DIC(0)="EXL"
S DIC("DR")=".02///^S X=VADJAMT"
S DIC("DR")=DIC("DR")_";.03////^S X=VADJREA"
K DD,DO
D ^DIC
Q
; ********************************************************************
;
CHECK ;EP
; Enter Check mumber into Import
K DIE,DR,DA
S DIE=$$DIC^XBDIQ1(90056.02)
S DA=IMPDA
S DR=".09////^S X=VCHECK"
D ^DIE
Q
; ********************************************************************
HIPAACHK ; EP
; Create entry in A/R EDI CHECK file
K BARBATCH,BARITEM,BARCHECK
K BARCHKN S BARCHKN=VCHECK ;bar*1.8*20 REQ3
S BARCHECK=VCHECK
S (BARBATCH,BARITEM)=""
D UPDCHECK^BAREDP09 ; Returns BARCKIEN
K BARBATCH,BARITEM,BARCHECK
Q
; ********************************************************************
;
VPRCNTCT ; EP
; Create Payer Contact multiple in A/R EDI Check File
Q:'+BARCKIEN ; Check not in A/R EDI Check File
Q:(VPRCONBR="") ; No payer contact information
K DIC,DR,DA,X,Y
S DA(1)=BARCKIEN
S DLAYGO=90056
S DIC=$$DIC^XBDIQ1(90056.2203)
S DIC(0)="XZL"
S DIC("P")=$P(^DD(90056.22,.3,0),U,2)
S DIC("DR")=".02////^S X=$E(VPRCONCD,1,2)"
S DIC("DR")=DIC("DR")_";.03////^S X=VPRCONAM"
S X=VPRCONBR
K DD,DO D FILE^DICN
Q
; ********************************************************************
;
PAY ; EP
; Set payer address AND payee name in A/R EDI CHECK file
K DIC,DIE,X,Y,DR
Q:'+BARCKIEN
S DA=BARCKIEN
S DIE=$$DIC^XBDIQ1(90056.22)
S DR=".07////^S X=VPAYEE"
S DR=DR_";.21////^S X=VPAYER"
S DR=DR_";.22////^S X=VPRADR"
S DR=DR_";.23////^S X=VPRADR2"
S DR=DR_";.24////^S X=VPRCITY"
S DR=DR_";.25////^S X=VPRSTATE"
S DR=DR_";.26////^S X=VPRZIP"
D ^DIE
Q
;BAR*1.8*1 3/20/2007 SRS PATCH 1 ADDENDUM
VIC ;EP - SET 'IDENTIFICATION CODE QUALIFIER' AND 'INDENTIFICATION CODE' INTO A/R EDI CHECK file
K DIC,DIE,X,Y,DR
Q:$G(VICQ)=""!($G(VIC)="")
Q:'+BARCKIEN
S DA=BARCKIEN
S DIE=$$DIC^XBDIQ1(90056.22)
S VICQ=$TR($P(VICQ,"|")," ")
S DR=".08////^S X=VICQ" ;Identification Code NPI or Tax id
I VICQ="XX" S DR=DR_";.09////^S X=VIC" ;IF 'XX' THEN NPI
E I VICQ="FI" S DR=DR_";.11////^S X=VIC" ;IF 'FI' THEN Tax id
D ^DIE
Q
;BAR*1.8*1 3/20/2007 SRS PATCH 1 ADDENDUM
;PROCESS PAYEE 'ADDITONAL PAYEE ID' LOOP B 1-120.B-REF
VREFB ; EP
Q:'$D(VREFBID)
K DIC,DIE,X,Y,DR
Q:'+BARCKIEN
S DA(1)=BARCKIEN
S DIC="^BARECHK("_DA(1)_",11,"
S X=$P(VREFBIQ," ")
S DIC(0)="ZL"
D ^DIC
Q:Y<0
K DIC,DR,DIE,DA
S DA(1)=BARCKIEN
S DA=+Y
S DIE="^BARECHK("_DA(1)_",11,"
S DR=".02////^S X=VREFBID"
D ^DIE
Q
; ********************************************************************
;
PATIENT ; EP
; Capture patient data per claim, not dependent on Claim Date
I $P(^BAREDI("1T",TRDA,10,SEGDA,0),U)="3-030.A-NM1" D
. I $P(XREC(1.01),E,2)="QC" D
. . K DIE,DR,DA
. . S DIE=$$DIC^XBDIQ1(90056.0205)
. . S DA=CLMDA
. . S DA(1)=IMPDA
. . S PAT=VPATLN_","_VPATFN_" "_VPATMID
. . S PATID=$G(VPATHRN)_" | "_$G(VPATHIC)
. . S DR=".06///^S X=$E(PAT,1,30)"
. . S DR=DR_";.07///^S X=PATID"
. . D ^DIE
Q
; ********************************************************************
;
CLMDATE ; EP
; Based on Segment and Identifier, Set DOS Begin and End
I $P(^BAREDI("1T",TRDA,10,SEGDA,0),U)="3-050-DTM" D
. K DIE,DR,DA
. S DIE=$$DIC^XBDIQ1(90056.0205)
. S DA=CLMDA
. S DA(1)=IMPDA
. I $P(XREC(1.01),E,2)=232 D
. . S VCLMDOSB=VCLMDATE
. . S IMGDA=$G(IMGDA)+1
. . S ^BAREDI("I",DUZ(2),IMPDA,40,IMGDA,0)="VCLMDOSB "_VCLMDOSB
. . S DR=".08///^S X=VCLMDOSB"
. . D ^DIE
. I $P(XREC(1.01),E,2)=233 D
. . S VCLMDOSE=VCLMDATE
. . S IMGDA=$G(IMGDA)+1
. . S ^BAREDI("I",DUZ(2),IMPDA,40,IMGDA,0)="VCLMDOSE "_VCLMDOSE
. . S DR=".09///^S X=VCLMDOSE"
. . D ^DIE
;
; If Pharmacy POS bill and no claim level DOS,
; look for Service level DOS
I $P(^BAREDI("1T",TRDA,10,SEGDA,0),U)="3-080-DTM",'$D(VCLDOSB) D
. K DIE,DR,DA
. S DIE=$$DIC^XBDIQ1(90056.0205)
. S DA=CLMDA
. S DA(1)=IMPDA
. I $P(XREC(1.01),E,2)=472 D
. . S VCLMDOSB=VCLMDATE
. . S IMGDA=$G(IMGDA)+1
. . S ^BAREDI("I",DUZ(2),IMPDA,40,IMGDA,0)="VCLMDOSB "_VCLMDOSB
. . S DR=".08///^S X=VCLMDOSB"
. . D ^DIE
Q
; ********************************************************************
;
READ(BARPATH,BARFILE) ; EP
; Read host file into ^TMP($J,"ERA")
Q:BARPATH=""
Q:BARFILE=""
K ^TMP($J,"ERA")
N BARCNT,BARTXT,BARDONE
S (BARCNT,BARDONE)=0
D OPEN^%ZISH("835FILE"_$J,BARPATH,BARFILE,"R")
I POP D Q
. W !!,"Error opening file....please verify filename and directory and try again"
. S BARDONE=1
. D EOP^BARUTL(1)
D READTST
D CLOSE^%ZISH("835FILE"_$J)
H 5
D OPEN^%ZISH("835FILE"_$J,BARPATH,BARFILE,"R")
I BARFTYP="STREAM" F D STREAM Q:+BARDONE
I BARFTYP'="STREAM" F D CRLF Q:+BARDONE
D CLOSE^%ZISH("835FILE"_$J)
Q
; ********************************************************************
;
READTST ;
; Test file type
U IO
R BARTXT#200:DTIME ;Direct read of flat file
I $L(BARTXT)>120 S BARFTYP="STREAM" Q
S BARFTYP="CR/LF"
Q
; ********************************************************************
;
STREAM ;
U IO
R BARTXT#250:DTIME ;Direct read of flat file
I $$STATUS^%ZISH D
. S BARCNT=BARCNT+1
. S ^TMP($J,"ERA",BARCNT)=BARTXT
. S BARTXT=""
I '+$L(BARTXT) S BARDONE=1 Q
S BARCNT=BARCNT+1
S ^TMP($J,"ERA",BARCNT)=BARTXT
Q
; ********************************************************************
;
CRLF ;
U IO
R BARTXT:DTIME
I $$STATUS^%ZISH!'+$L(BARTXT) S BARDONE=1 Q
S BARCNT=BARCNT+1
S ^TMP($J,"ERA",BARCNT)=BARTXT
Q
BAREDPA1 ; IHS/SD/LSL - INITIATORY ROUTINE FOR MEDICARE 3051.4A ; 12/12/2007
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**1,4,5,6,20**;OCT 26,2005
+2 ;
+3 ; IHS/ASDS/LSL - 06/19/2001 - V1.5 Patch 1 - NOIS HQW-0201-100027
+4 ; FM 22 issue. Modified to include E in DIC(0)
+5 ;
+6 ; IHS/SD/LSL - 08/22/2002 - V1.7 Patch 4 - HIPAA
+7 ; Added REFID line tag to set VVERNUM and VPATHRN
+8 ;
+9 ; IHS/SD/LSL - 11/17/03 - V1.7 Patch 4 - HIPAA
+10 ; Allow POS bills to look at DOS at the Service Level. POS
+11 ; bills can be identified from the RA in CLP01 where the first
+12 ; character is always a 0 (zero) as set in ABSPOSBB.
+13 ;
+14 ; IHS/SD/LSL - 02/10/04 - V1.7 Patch 5 - Remark Codes
+15 ; Add RMKCD linetag that takes ERA Remark Code values and
+16 ; populates REMARK CODE multiple of CLAIM multiple in
+17 ; A/R EDI IMPORT File
+18 ;
+19 ; IHS/SD/LSL - 02/24/04 - V1.7 Patch 5 - IM12723
+20 ; Resolve <SBSCR>IDENT+18^BAREDPA1. Occurs when loading streamed
+21 ; files that contain EOF.
+22 ;
+23 ; IHS/SD/LSL - 03/04/04 - V1.7 Patch 5 - NCPDP
+24 ; Add LQ linetag that takes code from LQ02 and populates REMARK
+25 ; CODE or NCPDP REJ/PAY multiple of CLAIM multiple in A/R
+26 ; EDI IMPORT file accordingly.
+27 ;
+28 ; IHS/SD/LSL - 03/17/04 - V1.7 Patch 5
+29 ; Allow DOS from SVC loop if no claim start date sent.
+30 ;
+31 ; ********************************************************************
+32 ;
SEP(IMPDA) ; EP
+1 ; find seperators according to standards for transport
+2 ; E - Element seperator
+3 ; S - Segment seperator
+4 ; SE - Sub Element seperator
+5 ; The following is specific to the MEDICARE 835 3051.4a and HIPAA 835
+6 ;E is 4th character of 1st segment
+7 ;S is 2nd character of 17th element of 1st segment
+8 ;SE is 1st character of 17th element of 1st segment
+9 ;
+10 KILL A
+11 NEW I
+12 FOR I=1:1:3
SET A(I)=^BAREDI("I",DUZ(2),IMPDA,10,I,0)
+13 ; remove trailing spaces
DO STRIP
+14 SET X=A(1)_A(2)_A(3)
+15 ; Element Separator
SET E=$EXTRACT(X,4)
+16 SET Y=$PIECE(X,E,17)
+17 ; Sub - Element Separator
SET SE=$EXTRACT(Y)
+18 ; Segment Separator
SET S=$EXTRACT(Y,2)
+19 QUIT
+20 ; ********************************************************************
+21 ;
STRIP ;
+1 FOR I=1:1:3
Begin DoDot:1
+2 FOR
SET L=$LENGTH(A(I))
IF $EXTRACT(A(I),L)'=" "
QUIT
SET A(I)=$EXTRACT(A(I),1,L-1)
End DoDot:1
+3 QUIT
+4 ; ********************************************************************
+5 ;
BILNUM ;EP
+1 ; process a new bill
+2 IF '(COUNT#10)
WRITE "."
+3 IF '(COUNT#100)
WRITE " ",COUNT,!
+4 SET COUNT=COUNT+1
+5 KILL DIC,DR,DA
+6 SET DIC=$$DIC^XBDIQ1(90056.0205)
+7 SET DIC(0)="EXL"
+8 SET DIC("P")="90056.0205A"
+9 SET DIC("DR")=".03////^S X=$G(VNEWPRV)"
+10 SET X=VNEWBILL
+11 WRITE !,X
+12 SET DA(1)=IMPDA
+13 KILL DD,DO
DO FILE^DICN
+14 SET CLMDA=+Y
+15 SET DA=+Y
+16 SET DIE=DIC
+17 KILL DIC
+18 KILL DR
+19 SET DR=".04///^S X=VCLMPAY"
+20 SET DR=DR_";.05///^S X=VCLMCHG"
+21 ;BAR*1.8*5 POPULATE 'PAYER CLAIM CONTROL # (ICN)'
SET DR=DR_";302///^S X=VBILNUM"
+22 ;BAR*1.8*4 SCR56,SCR58
+23 SET DR=DR_";.11///^S X=$E($G(VCLMSTAT),1,25)"
+24 ;END BAR*1.8*4
+25 ;BAR*1.8*6 SCR119 POPULATE NEW BPR AMOUNT FIELD
SET DR=DR_";205///^S X=$G(VBPRAMT)"
+26 ;
+27 DO ^DIE
+28 ; other processing to be done at newbill
+29 SET ADJDA=0
+30 ; Put check number at claim level to capture multiple checks per RA
+31 SET DR="201///^S X=VCHECK"
+32 DO ^DIE
+33 SET RMKDA=0
+34 SET LQDA=0
+35 QUIT
+36 ; ********************************************************************
+37 ;
RMKCD ; EP
+1 ; Populate remark codes to impda,clmda
+2 IF '$LENGTH(VRMKCD)
QUIT
+3 KILL DIC,DA,DR,X,Y
+4 SET X=$PIECE(VRMKCD," ")
+5 SET DIC="^BARMKCD("
+6 SET DIC(0)="ZX"
+7 KILL DD,DO
+8 DO ^DIC
+9 SET VRMKCDP=+Y
+10 IF $DATA(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,40,"C",VRMKCDP))
QUIT
+11 SET RMKDA=RMKDA+1
+12 KILL DIE,DR,DA,X,DIC
+13 SET DA(2)=IMPDA
+14 SET DA(1)=CLMDA
+15 SET X=RMKDA
+16 SET DLAYGO=90056
+17 SET DIC=$$DIC^XBDIQ1(90056.0211)
+18 SET DIC("P")=$PIECE($GET(^DD(90056.0205,40,0)),U,2)
+19 SET DIC(0)="EXL"
+20 SET DIC("DR")=".02///^S X=VRMKCD"
+21 IF VRMKCDP>0
SET DIC("DR")=DIC("DR")_";.03////^S X=VRMKCDP"
+22 KILL DD,DO
+23 DO ^DIC
+24 QUIT
+25 ; ********************************************************************
+26 ;
LQ ; EP
+1 ; Populate remark codes/NCPDP codes to impda,clmda
+2 IF '$LENGTH(VLQCD)
QUIT
+3 IF $PIECE(XREC(1.01),E,2)="HE"
Begin DoDot:1
+4 SET VRMKCD=VLQCD
+5 DO RMKCD
End DoDot:1
QUIT
+6 IF $PIECE(XREC(1.01),E,2)'="RX"
QUIT
+7 KILL DIC,DA,DR,X,Y
+8 SET X=$PIECE(VLQCD," ")
+9 SET DIC="^ABSPF(9002313.93,"
+10 SET DIC(0)="ZX"
+11 KILL DD,DO
+12 DO ^DIC
+13 SET VLQCDP=+Y
+14 IF $DATA(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,50,"C",VLQCDP))
QUIT
+15 SET LQDA=LQDA+1
+16 KILL DIE,DR,DA,X,DIC
+17 SET DA(2)=IMPDA
+18 SET DA(1)=CLMDA
+19 SET X=LQDA
+20 SET DLAYGO=90056
+21 SET DIC=$$DIC^XBDIQ1(90056.0212)
+22 SET DIC("P")=$PIECE($GET(^DD(90056.0205,50,0)),U,2)
+23 SET DIC(0)="EXL"
+24 SET DIC("DR")=".02///^S X=VLQCD"
+25 IF VLQCDP>0
SET DIC("DR")=DIC("DR")_";.03////^S X=VLQCDP"
+26 KILL DD,DO
+27 DO ^DIC
+28 QUIT
+29 ; ********************************************************************
+30 ;
CLMDOSE ;EP
+1 ; Process the claim at the VCLMDOSE variable
+2 KILL DIE,DR,DA
+3 SET DIE=$$DIC^XBDIQ1(90056.0205)
+4 SET DA=CLMDA
+5 SET DA(1)=IMPDA
+6 SET PAT=VPATLN_","_VPATFN_" "_VPATMID
+7 SET PATID=$GET(VPATHRN)_" | "_$GET(VPATHIC)
+8 SET DR=".06///^S X=$E(PAT,1,30)"
+9 SET DR=DR_";.07///^S X=PATID"
+10 SET DR=DR_";.08///^S X=VCLMDOSB"
+11 SET DR=DR_";.09///^S X=VCLMDOSE"
+12 DO ^DIE
+13 QUIT
+14 ;*********************************************************************
+15 ;
ADJAMT ;EP
+1 ; Process reason and amount into claim impda,clmda
+2 IF '$LENGTH(VADJREA)
IF '$LENGTH(VADJAMT)
QUIT
+3 SET ADJDA=ADJDA+1
+4 KILL DIE,DR,DA,X,DIC
+5 SET DA(2)=IMPDA
+6 SET DA(1)=CLMDA
+7 SET X=ADJDA
+8 SET DIC=$$DIC^XBDIQ1(90056.0208)
+9 SET DIC("P")="90056.0208A"
+10 SET DIC(0)="EXL"
+11 SET DIC("DR")=".02///^S X=VADJAMT"
+12 SET DIC("DR")=DIC("DR")_";.03////^S X=VADJREA"
+13 KILL DD,DO
+14 DO ^DIC
+15 QUIT
+16 ; ********************************************************************
+17 ;
CHECK ;EP
+1 ; Enter Check mumber into Import
+2 KILL DIE,DR,DA
+3 SET DIE=$$DIC^XBDIQ1(90056.02)
+4 SET DA=IMPDA
+5 SET DR=".09////^S X=VCHECK"
+6 DO ^DIE
+7 QUIT
+8 ; ********************************************************************
HIPAACHK ; EP
+1 ; Create entry in A/R EDI CHECK file
+2 KILL BARBATCH,BARITEM,BARCHECK
+3 ;bar*1.8*20 REQ3
KILL BARCHKN
SET BARCHKN=VCHECK
+4 SET BARCHECK=VCHECK
+5 SET (BARBATCH,BARITEM)=""
+6 ; Returns BARCKIEN
DO UPDCHECK^BAREDP09
+7 KILL BARBATCH,BARITEM,BARCHECK
+8 QUIT
+9 ; ********************************************************************
+10 ;
VPRCNTCT ; EP
+1 ; Create Payer Contact multiple in A/R EDI Check File
+2 ; Check not in A/R EDI Check File
IF '+BARCKIEN
QUIT
+3 ; No payer contact information
IF (VPRCONBR="")
QUIT
+4 KILL DIC,DR,DA,X,Y
+5 SET DA(1)=BARCKIEN
+6 SET DLAYGO=90056
+7 SET DIC=$$DIC^XBDIQ1(90056.2203)
+8 SET DIC(0)="XZL"
+9 SET DIC("P")=$PIECE(^DD(90056.22,.3,0),U,2)
+10 SET DIC("DR")=".02////^S X=$E(VPRCONCD,1,2)"
+11 SET DIC("DR")=DIC("DR")_";.03////^S X=VPRCONAM"
+12 SET X=VPRCONBR
+13 KILL DD,DO
DO FILE^DICN
+14 QUIT
+15 ; ********************************************************************
+16 ;
PAY ; EP
+1 ; Set payer address AND payee name in A/R EDI CHECK file
+2 KILL DIC,DIE,X,Y,DR
+3 IF '+BARCKIEN
QUIT
+4 SET DA=BARCKIEN
+5 SET DIE=$$DIC^XBDIQ1(90056.22)
+6 SET DR=".07////^S X=VPAYEE"
+7 SET DR=DR_";.21////^S X=VPAYER"
+8 SET DR=DR_";.22////^S X=VPRADR"
+9 SET DR=DR_";.23////^S X=VPRADR2"
+10 SET DR=DR_";.24////^S X=VPRCITY"
+11 SET DR=DR_";.25////^S X=VPRSTATE"
+12 SET DR=DR_";.26////^S X=VPRZIP"
+13 DO ^DIE
+14 QUIT
+15 ;BAR*1.8*1 3/20/2007 SRS PATCH 1 ADDENDUM
VIC ;EP - SET 'IDENTIFICATION CODE QUALIFIER' AND 'INDENTIFICATION CODE' INTO A/R EDI CHECK file
+1 KILL DIC,DIE,X,Y,DR
+2 IF $GET(VICQ)=""!($GET(VIC)="")
QUIT
+3 IF '+BARCKIEN
QUIT
+4 SET DA=BARCKIEN
+5 SET DIE=$$DIC^XBDIQ1(90056.22)
+6 SET VICQ=$TRANSLATE($PIECE(VICQ,"|")," ")
+7 ;Identification Code NPI or Tax id
SET DR=".08////^S X=VICQ"
+8 ;IF 'XX' THEN NPI
IF VICQ="XX"
SET DR=DR_";.09////^S X=VIC"
+9 ;IF 'FI' THEN Tax id
IF '$TEST
IF VICQ="FI"
SET DR=DR_";.11////^S X=VIC"
+10 DO ^DIE
+11 QUIT
+12 ;BAR*1.8*1 3/20/2007 SRS PATCH 1 ADDENDUM
+13 ;PROCESS PAYEE 'ADDITONAL PAYEE ID' LOOP B 1-120.B-REF
VREFB ; EP
+1 IF '$DATA(VREFBID)
QUIT
+2 KILL DIC,DIE,X,Y,DR
+3 IF '+BARCKIEN
QUIT
+4 SET DA(1)=BARCKIEN
+5 SET DIC="^BARECHK("_DA(1)_",11,"
+6 SET X=$PIECE(VREFBIQ," ")
+7 SET DIC(0)="ZL"
+8 DO ^DIC
+9 IF Y<0
QUIT
+10 KILL DIC,DR,DIE,DA
+11 SET DA(1)=BARCKIEN
+12 SET DA=+Y
+13 SET DIE="^BARECHK("_DA(1)_",11,"
+14 SET DR=".02////^S X=VREFBID"
+15 DO ^DIE
+16 QUIT
+17 ; ********************************************************************
+18 ;
PATIENT ; EP
+1 ; Capture patient data per claim, not dependent on Claim Date
+2 IF $PIECE(^BAREDI("1T",TRDA,10,SEGDA,0),U)="3-030.A-NM1"
Begin DoDot:1
+3 IF $PIECE(XREC(1.01),E,2)="QC"
Begin DoDot:2
+4 KILL DIE,DR,DA
+5 SET DIE=$$DIC^XBDIQ1(90056.0205)
+6 SET DA=CLMDA
+7 SET DA(1)=IMPDA
+8 SET PAT=VPATLN_","_VPATFN_" "_VPATMID
+9 SET PATID=$GET(VPATHRN)_" | "_$GET(VPATHIC)
+10 SET DR=".06///^S X=$E(PAT,1,30)"
+11 SET DR=DR_";.07///^S X=PATID"
+12 DO ^DIE
End DoDot:2
End DoDot:1
+13 QUIT
+14 ; ********************************************************************
+15 ;
CLMDATE ; EP
+1 ; Based on Segment and Identifier, Set DOS Begin and End
+2 IF $PIECE(^BAREDI("1T",TRDA,10,SEGDA,0),U)="3-050-DTM"
Begin DoDot:1
+3 KILL DIE,DR,DA
+4 SET DIE=$$DIC^XBDIQ1(90056.0205)
+5 SET DA=CLMDA
+6 SET DA(1)=IMPDA
+7 IF $PIECE(XREC(1.01),E,2)=232
Begin DoDot:2
+8 SET VCLMDOSB=VCLMDATE
+9 SET IMGDA=$GET(IMGDA)+1
+10 SET ^BAREDI("I",DUZ(2),IMPDA,40,IMGDA,0)="VCLMDOSB "_VCLMDOSB
+11 SET DR=".08///^S X=VCLMDOSB"
+12 DO ^DIE
End DoDot:2
+13 IF $PIECE(XREC(1.01),E,2)=233
Begin DoDot:2
+14 SET VCLMDOSE=VCLMDATE
+15 SET IMGDA=$GET(IMGDA)+1
+16 SET ^BAREDI("I",DUZ(2),IMPDA,40,IMGDA,0)="VCLMDOSE "_VCLMDOSE
+17 SET DR=".09///^S X=VCLMDOSE"
+18 DO ^DIE
End DoDot:2
End DoDot:1
+19 ;
+20 ; If Pharmacy POS bill and no claim level DOS,
+21 ; look for Service level DOS
+22 IF $PIECE(^BAREDI("1T",TRDA,10,SEGDA,0),U)="3-080-DTM"
IF '$DATA(VCLDOSB)
Begin DoDot:1
+23 KILL DIE,DR,DA
+24 SET DIE=$$DIC^XBDIQ1(90056.0205)
+25 SET DA=CLMDA
+26 SET DA(1)=IMPDA
+27 IF $PIECE(XREC(1.01),E,2)=472
Begin DoDot:2
+28 SET VCLMDOSB=VCLMDATE
+29 SET IMGDA=$GET(IMGDA)+1
+30 SET ^BAREDI("I",DUZ(2),IMPDA,40,IMGDA,0)="VCLMDOSB "_VCLMDOSB
+31 SET DR=".08///^S X=VCLMDOSB"
+32 DO ^DIE
End DoDot:2
End DoDot:1
+33 QUIT
+34 ; ********************************************************************
+35 ;
READ(BARPATH,BARFILE) ; EP
+1 ; Read host file into ^TMP($J,"ERA")
+2 IF BARPATH=""
QUIT
+3 IF BARFILE=""
QUIT
+4 KILL ^TMP($JOB,"ERA")
+5 NEW BARCNT,BARTXT,BARDONE
+6 SET (BARCNT,BARDONE)=0
+7 DO OPEN^%ZISH("835FILE"_$JOB,BARPATH,BARFILE,"R")
+8 IF POP
Begin DoDot:1
+9 WRITE !!,"Error opening file....please verify filename and directory and try again"
+10 SET BARDONE=1
+11 DO EOP^BARUTL(1)
End DoDot:1
QUIT
+12 DO READTST
+13 DO CLOSE^%ZISH("835FILE"_$JOB)
+14 HANG 5
+15 DO OPEN^%ZISH("835FILE"_$JOB,BARPATH,BARFILE,"R")
+16 IF BARFTYP="STREAM"
FOR
DO STREAM
IF +BARDONE
QUIT
+17 IF BARFTYP'="STREAM"
FOR
DO CRLF
IF +BARDONE
QUIT
+18 DO CLOSE^%ZISH("835FILE"_$JOB)
+19 QUIT
+20 ; ********************************************************************
+21 ;
READTST ;
+1 ; Test file type
+2 USE IO
+3 ;Direct read of flat file
READ BARTXT#200:DTIME
+4 IF $LENGTH(BARTXT)>120
SET BARFTYP="STREAM"
QUIT
+5 SET BARFTYP="CR/LF"
+6 QUIT
+7 ; ********************************************************************
+8 ;
STREAM ;
+1 USE IO
+2 ;Direct read of flat file
READ BARTXT#250:DTIME
+3 IF $$STATUS^%ZISH
Begin DoDot:1
+4 SET BARCNT=BARCNT+1
+5 SET ^TMP($JOB,"ERA",BARCNT)=BARTXT
+6 SET BARTXT=""
End DoDot:1
+7 IF '+$LENGTH(BARTXT)
SET BARDONE=1
QUIT
+8 SET BARCNT=BARCNT+1
+9 SET ^TMP($JOB,"ERA",BARCNT)=BARTXT
+10 QUIT
+11 ; ********************************************************************
+12 ;
CRLF ;
+1 USE IO
+2 READ BARTXT:DTIME
+3 IF $$STATUS^%ZISH!'+$L(BARTXT)
SET BARDONE=1
QUIT
+4 SET BARCNT=BARCNT+1
+5 SET ^TMP($JOB,"ERA",BARCNT)=BARTXT
+6 QUIT
