BAR50PA1 ; IHS/SD/LSL - VARIABLE PROCESSING ROUTINE ; 12/12/2007
;;1.8;IHS ACCOUNTS RECEIVABLE;**1,4,5,6,20,21,23,26**;OCT 26,2005;Build 17
;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^BAR50PA1. 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.
;
;IHS/SD/POT - 1.8*23 - HEAT106998 APR 2013 MAKE PAYEE ADDRESS NOT MANDATORY ($g())
;IHS/SD/SDR - 1.8*26 - HEAT195751 - When getting the date from the service line, changed it to check for 472 or 150. Can also
; be 151 but that's the service to date. Going to wait for someone to report it before trying to deal with a date range at
; this level.
; ********************************************************************
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
;IHS/SD/TPF BAR*1.8*21 8/24/2011 REPITITION SEPARATOR 5010 PAGE C-3
S RS=$E(X,83) S:RS="^" RS="U" S $E(X,83)=RS
;END
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^BAR50P09 ; Returns BARCKIEN
K BARBATCH,BARITEM,BARCHECK
Q
; ********************************************************************
;
VPRCNTCT ; EP
; Create Payer Contact multiple in A/R EDI Check File
Q:XREC(".03")'="2-130-PER"
Q:'+BARCKIEN ; Check not in A/R EDI Check File
Q:(VPRFCD="") ; 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)
;MODFIY SEG 2-30-PER TO HANDLE ALL CODE IN CONTACT INFORMATION SEGMENT
S VPRFCD=$P(VPRFCD," ")
F I=1:1:3 D
.S VAR1="VPRCNUM"_I
.S VAR2="VPRCQLF"_I
.;S DIC("DR")=".01////^S VPRCNUM"
.;S DIC("DR")=".01////^S X=@VAR1"
.;S DIC("DR")=DIC("DR")_";.02////^S X=VPRCQLF"
.S DIC("DR")=".02////^S X=@VAR2"
.S DIC("DR")=DIC("DR")_";.03////^S X=VPRCNAM1"
.S DIC("DR")=DIC("DR")_";.04////^S X=VPRFCD" ;CONTACT FUNCTION CODE IHS/SD/TPF 9/6/2011 BAR*1.8*21 5010 PAGE 2-3
.S X=@VAR1
.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"
S DR=DR_";.27////^S X=VPRCOUNT" ;IHS/SD/TPF BAR*1.8*21 8/30/2011 5010 SPECS PAGE 2
S DR=DR_";.28////^S X=VPRCTSUB" ;IHS/SD/TPF BAR*1.8*21 8/30/2011 5010 SPECS PAGE 2
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
E I VICQ="XV" S DR=DR_";101////^S X=VIC" ;IF "XV" THEN CMS PLAN ID ;IHS/SD/TPF 9/6/2011 BAR*1.8*21 5010 PAGE 3
D ^DIE
Q
;BAR*1.8*21 PROCESS PAYEE ADDRESS
PAYEEADD ;EP - SAVE PAYEE ADDRESS
K DIC,DIE,X,Y,DR
Q:'+BARCKIEN
S DA=BARCKIEN
S VPEEADR1=$G(VPEEADR1) ;P.OTT
S VPEEADR2=$G(VPEEADR2) ;P.OTT
S DIE=$$DIC^XBDIQ1(90056.22)
S DR="1201////^S X=VPEEADR1"
S DR=DR_";1202////^S X=VPEEADR2"
S DR=DR_";1203////^S X=VPEECITY"
S DR=DR_";1204////^S X=VPEESTAT"
S DR=DR_";1205////^S X=VPEEZIP"
S DR=DR_";1206////^S X=VPECOUNT"
S DR=DR_";1207////^S X=VPEESUB"
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 CLAIM FROM and TO DATE
;W !,$P(^BAREDI("1T",TRDA,10,SEGDA,0),U)
;I $P(^BAREDI("1T",TRDA,10,SEGDA,0),U)="3-050.A-DTM" D
I $P(^BAREDI("1T",TRDA,10,SEGDA,0),U)["3-050" D
.K DIE,DR,DA
.S DIE=$$DIC^XBDIQ1(90056.0205)
.S DA=CLMDA
.S DA(1)=IMPDA
.S VCLMQLF=$P($G(VCLMQLF)," ")
.;W !,"VCLMQLF: ",$G(VCLMQLF)
.I $P(XREC(1.01),E,2)=232 D
..S VCLMFR=VCLMDT
..S IMGDA=$G(IMGDA)+1
..S ^BAREDI("I",DUZ(2),IMPDA,40,IMGDA,0)="VCLMFR "_VCLMFR
..S DR=".08///^S X=VCLMFR"
..D ^DIE
.I $P(XREC(1.01),E,2)=233 D
..S VCLMTO=VCLMDT
..S IMGDA=$G(IMGDA)+1
..S ^BAREDI("I",DUZ(2),IMPDA,40,IMGDA,0)="VCLMTO "_VCLMTO
..S DR=".09///^S X=VCLMTO"
..D ^DIE
..;BEGIN IHS/SD/TPF BAR*1.8*21 NEW DTM SEGMENTS PAGE 11 SPACES
.I $P(XREC(1.01),E,2)="036" D
..S VCLMEXP=VCLMDT
..S IMGDA=$G(IMGDA)+1
..S ^BAREDI("I",DUZ(2),IMPDA,40,IMGDA,0)="VCLMEXP "_VCLMEXP
..S DR="901///^S X=VCLMEXP"
..D ^DIE
.I $P(XREC(1.01),E,2)="050" D
..S VCLMREC=VCLMDT
..S IMGDA=$G(IMGDA)+1
..S ^BAREDI("I",DUZ(2),IMPDA,40,IMGDA,0)="VCLMREC "_VCLMREC
..S DR="902///^S X=VCLMREC"
..D ^DIE
;END IHS/SD/TPF BAR*1.8*21
; 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 ;bar*1.8*26 IHS/SD/SDR HEAT195751
.I "^150^472^"[("^"_$P(XREC(1.01),E,2)_"^") D ;bar*1.8*26 IHS/SD/SDR HEAT195751
..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
;
;
K VCLMDT,VCLMQLF
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
BAR50PA1 ; IHS/SD/LSL - VARIABLE PROCESSING ROUTINE ; 12/12/2007
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**1,4,5,6,20,21,23,26**;OCT 26,2005;Build 17
+2 ;IHS/ASDS/LSL - 06/19/2001 - V1.5 Patch 1 - NOIS HQW-0201-100027 - FM 22 issue. Modified to include E in DIC(0)
+3 ;IHS/SD/LSL - 08/22/2002 - V1.7 Patch 4 - HIPAA - Added REFID line tag to set VVERNUM and VPATHRN
+4 ;IHS/SD/LSL - 11/17/03 - V1.7 Patch 4 - HIPAA - Allow POS bills to look at DOS at the Service Level. POS
+5 ; bills can be identified from the RA in CLP01 where the first character is always a 0 (zero) as set in ABSPOSBB.
+6 ;IHS/SD/LSL - 02/10/04 - V1.7 Patch 5 - Remark Codes - Add RMKCD linetag that takes ERA Remark Code values and
+7 ; populates REMARK CODE multiple of CLAIM multiple in A/R EDI IMPORT File
+8 ;IHS/SD/LSL - 02/24/04 - V1.7 Patch 5 - IM12723 - Resolve <SBSCR>IDENT+18^BAR50PA1. Occurs when loading streamed
+9 ; files that contain EOF.
+10 ; IHS/SD/LSL - 03/04/04 - V1.7 Patch 5 - NCPDP - Add LQ linetag that takes code from LQ02 and populates REMARK
+11 ; CODE or NCPDP REJ/PAY multiple of CLAIM multiple in A/R EDI IMPORT file accordingly.
+12 ; IHS/SD/LSL - 03/17/04 - V1.7 Patch 5 - Allow DOS from SVC loop if no claim start date sent.
+13 ;
+14 ;IHS/SD/POT - 1.8*23 - HEAT106998 APR 2013 MAKE PAYEE ADDRESS NOT MANDATORY ($g())
+15 ;IHS/SD/SDR - 1.8*26 - HEAT195751 - When getting the date from the service line, changed it to check for 472 or 150. Can also
+16 ; be 151 but that's the service to date. Going to wait for someone to report it before trying to deal with a date range at
+17 ; this level.
+18 ; ********************************************************************
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 ;IHS/SD/TPF BAR*1.8*21 8/24/2011 REPITITION SEPARATOR 5010 PAGE C-3
+20 SET RS=$EXTRACT(X,83)
IF RS="^"
SET RS="U"
SET $EXTRACT(X,83)=RS
+21 ;END
+22 QUIT
+23 ; ********************************************************************
+24 ;
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^BAR50P09
+7 KILL BARBATCH,BARITEM,BARCHECK
+8 QUIT
+9 ; ********************************************************************
+10 ;
VPRCNTCT ; EP
+1 ; Create Payer Contact multiple in A/R EDI Check File
+2 IF XREC(".03")'="2-130-PER"
QUIT
+3 ; Check not in A/R EDI Check File
IF '+BARCKIEN
QUIT
+4 ; No payer contact information
IF (VPRFCD="")
QUIT
+5 KILL DIC,DR,DA,X,Y
+6 SET DA(1)=BARCKIEN
+7 SET DLAYGO=90056
+8 SET DIC=$$DIC^XBDIQ1(90056.2203)
+9 SET DIC(0)="XZL"
+10 SET DIC("P")=$PIECE(^DD(90056.22,.3,0),U,2)
+11 ;MODFIY SEG 2-30-PER TO HANDLE ALL CODE IN CONTACT INFORMATION SEGMENT
+12 SET VPRFCD=$PIECE(VPRFCD," ")
+13 FOR I=1:1:3
Begin DoDot:1
+14 SET VAR1="VPRCNUM"_I
+15 SET VAR2="VPRCQLF"_I
+16 ;S DIC("DR")=".01////^S VPRCNUM"
+17 ;S DIC("DR")=".01////^S X=@VAR1"
+18 ;S DIC("DR")=DIC("DR")_";.02////^S X=VPRCQLF"
+19 SET DIC("DR")=".02////^S X=@VAR2"
+20 SET DIC("DR")=DIC("DR")_";.03////^S X=VPRCNAM1"
+21 ;CONTACT FUNCTION CODE IHS/SD/TPF 9/6/2011 BAR*1.8*21 5010 PAGE 2-3
SET DIC("DR")=DIC("DR")_";.04////^S X=VPRFCD"
+22 SET X=@VAR1
+23 KILL DD,DO
DO FILE^DICN
End DoDot:1
+24 QUIT
+25 ; ********************************************************************
+26 ;
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 ;IHS/SD/TPF BAR*1.8*21 8/30/2011 5010 SPECS PAGE 2
SET DR=DR_";.27////^S X=VPRCOUNT"
+14 ;IHS/SD/TPF BAR*1.8*21 8/30/2011 5010 SPECS PAGE 2
SET DR=DR_";.28////^S X=VPRCTSUB"
+15 DO ^DIE
+16 QUIT
+17 ;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 ;IF "XV" THEN CMS PLAN ID ;IHS/SD/TPF 9/6/2011 BAR*1.8*21 5010 PAGE 3
IF '$TEST
IF VICQ="XV"
SET DR=DR_";101////^S X=VIC"
+11 DO ^DIE
+12 QUIT
+13 ;BAR*1.8*21 PROCESS PAYEE ADDRESS
PAYEEADD ;EP - SAVE PAYEE ADDRESS
+1 KILL DIC,DIE,X,Y,DR
+2 IF '+BARCKIEN
QUIT
+3 SET DA=BARCKIEN
+4 ;P.OTT
SET VPEEADR1=$GET(VPEEADR1)
+5 ;P.OTT
SET VPEEADR2=$GET(VPEEADR2)
+6 SET DIE=$$DIC^XBDIQ1(90056.22)
+7 SET DR="1201////^S X=VPEEADR1"
+8 SET DR=DR_";1202////^S X=VPEEADR2"
+9 SET DR=DR_";1203////^S X=VPEECITY"
+10 SET DR=DR_";1204////^S X=VPEESTAT"
+11 SET DR=DR_";1205////^S X=VPEEZIP"
+12 SET DR=DR_";1206////^S X=VPECOUNT"
+13 SET DR=DR_";1207////^S X=VPEESUB"
+14 DO ^DIE
+15 ;BAR*1.8*1 3/20/2007 SRS PATCH 1 ADDENDUM
QUIT
+16 ;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 CLAIM FROM and TO DATE
+2 ;W !,$P(^BAREDI("1T",TRDA,10,SEGDA,0),U)
+3 ;I $P(^BAREDI("1T",TRDA,10,SEGDA,0),U)="3-050.A-DTM" D
+4 IF $PIECE(^BAREDI("1T",TRDA,10,SEGDA,0),U)["3-050"
Begin DoDot:1
+5 KILL DIE,DR,DA
+6 SET DIE=$$DIC^XBDIQ1(90056.0205)
+7 SET DA=CLMDA
+8 SET DA(1)=IMPDA
+9 SET VCLMQLF=$PIECE($GET(VCLMQLF)," ")
+10 ;W !,"VCLMQLF: ",$G(VCLMQLF)
+11 IF $PIECE(XREC(1.01),E,2)=232
Begin DoDot:2
+12 SET VCLMFR=VCLMDT
+13 SET IMGDA=$GET(IMGDA)+1
+14 SET ^BAREDI("I",DUZ(2),IMPDA,40,IMGDA,0)="VCLMFR "_VCLMFR
+15 SET DR=".08///^S X=VCLMFR"
+16 DO ^DIE
End DoDot:2
+17 IF $PIECE(XREC(1.01),E,2)=233
Begin DoDot:2
+18 SET VCLMTO=VCLMDT
+19 SET IMGDA=$GET(IMGDA)+1
+20 SET ^BAREDI("I",DUZ(2),IMPDA,40,IMGDA,0)="VCLMTO "_VCLMTO
+21 SET DR=".09///^S X=VCLMTO"
+22 DO ^DIE
+23 ;BEGIN IHS/SD/TPF BAR*1.8*21 NEW DTM SEGMENTS PAGE 11 SPACES
End DoDot:2
+24 IF $PIECE(XREC(1.01),E,2)="036"
Begin DoDot:2
+25 SET VCLMEXP=VCLMDT
+26 SET IMGDA=$GET(IMGDA)+1
+27 SET ^BAREDI("I",DUZ(2),IMPDA,40,IMGDA,0)="VCLMEXP "_VCLMEXP
+28 SET DR="901///^S X=VCLMEXP"
+29 DO ^DIE
End DoDot:2
+30 IF $PIECE(XREC(1.01),E,2)="050"
Begin DoDot:2
+31 SET VCLMREC=VCLMDT
+32 SET IMGDA=$GET(IMGDA)+1
+33 SET ^BAREDI("I",DUZ(2),IMPDA,40,IMGDA,0)="VCLMREC "_VCLMREC
+34 SET DR="902///^S X=VCLMREC"
+35 DO ^DIE
End DoDot:2
End DoDot:1
+36 ;END IHS/SD/TPF BAR*1.8*21
+37 ; If Pharmacy POS bill and no claim level DOS,
+38 ; look for Service level DOS
+39 IF $PIECE(^BAREDI("1T",TRDA,10,SEGDA,0),U)="3-080-DTM"
IF '$DATA(VCLDOSB)
Begin DoDot:1
+40 KILL DIE,DR,DA
+41 SET DIE=$$DIC^XBDIQ1(90056.0205)
+42 SET DA=CLMDA
+43 SET DA(1)=IMPDA
+44 ;I $P(XREC(1.01),E,2)=472 D ;bar*1.8*26 IHS/SD/SDR HEAT195751
+45 ;bar*1.8*26 IHS/SD/SDR HEAT195751
IF "^150^472^"[("^"_$PIECE(XREC(1.01),E,2)_"^")
Begin DoDot:2
+46 SET VCLMDOSB=VCLMDATE
+47 SET IMGDA=$GET(IMGDA)+1
+48 SET ^BAREDI("I",DUZ(2),IMPDA,40,IMGDA,0)="VCLMDOSB "_VCLMDOSB
+49 SET DR=".08///^S X=VCLMDOSB"
+50 DO ^DIE
End DoDot:2
End DoDot:1
+51 ;
+52 ;
+53 KILL VCLMDT,VCLMQLF
+54 QUIT
+55 ; ********************************************************************
+56 ;
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
