ABMEF32 ; IHS/ASDST/DMJ - Electronic 837 version 5010 Professional ;
;;2.6;IHS 3P BILLING SYSTEM;**6,8,10,21**;NOV 12, 2009;Build 379
;IHS/SD/SDR - 2.6*21 - HEAT132394 - Made change to K ABMP; data was hanging around, causing UNKNOWN in
; SBR04 for Medicare and dropping CAS segments.
;
START ;
;START HERE
S ABMPXMIT=ABMP("XMIT")
I '$D(ABMP("INS")) D
.S ABMP("INS")=$P(^ABMDTXST(DUZ(2),ABMPXMIT,0),"^",4)
.I 'ABMP("INS") D
..S DIC="^AUTNINS("
..S DIC(0)="AEMQ"
..D ^DIC
..Q:Y<0
..S ABMP("INS")=+Y
I 'ABMP("INS") D Q
.W !,"Insurer NOT identified.",!
.D EOP^ABMDUTL(1)
S ABMPINS=ABMP("INS")
;S ABMP("ITYPE")=$P($G(^AUTNINS(ABMP("INS"),2)),U) ;abm*2.6*10 HEAT73780
S ABMP("ITYPE")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I") ;abm*2.6*10 HEAT73780
S ABMPITYP=ABMP("ITYPE")
I ($G(ABMER("CNT"))=1) D Q:$G(POP)
.D OPEN
.I $G(POP) W !,"File could not be created/opened.",! Q
Q:$G(POP) ;abm*2.6*8
S DIE="^ABMDTXST(DUZ(2),"
S DA=ABMPXMIT
S DR=".14///"_ABMFN
D ^DIE
D LOOP
I '$G(ABMSTOT) D
.W !,"No Bills in Batch.",!
I $G(ABMSTOT) D
.D ^ABME5L11
I (ABMER("CNT")=ABMER("LAST")) D END
Q
;
LOOP ;loop through bills
K ABMR,ABMRT,ABMREC
S ABMOSBR=0
S ABMASBR=0
S (ABMNPDFN,ABMOPDFN)=0
F S ABMASBR=$O(^ABMDTXST(DUZ(2),ABMPXMIT,2,"ASBR",ABMASBR)) Q:'ABMASBR D
.K ABMP
.S ABMBILL=0
.S ABMOPDFN=0
.F S ABMBILL=$O(^ABMDTXST(DUZ(2),ABMPXMIT,2,"ASBR",ABMASBR,ABMBILL)) Q:'ABMBILL D
..D CLAIM
Q
CLAIM ;one claim
K ABMP ;abm*2.6*21 IHS/SD/SDR HEAT132394
S ABMP("INS")=ABMPINS
S ABMP("ITYPE")=ABMPITYP
S ABMP("BDFN")=ABMBILL
Q:'$D(^ABMDBILL(DUZ(2),ABMP("BDFN"),0))
Q:$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),"^",4)="X"
D BILLSTAT^ABMDREEX(DUZ(2),ABMP("BDFN"),ABMPXMIT,"O",ABMGCN)
D SET^ABMUTLP(ABMP("BDFN"))
I 'ABMOSBR D
.I ABMER("CNT")=1 U 0 W !,"Submission # ",$P($G(^ABMDTXST(DUZ(2),ABMPXMIT,3,$O(^ABMDTXST(DUZ(2),ABMPXMIT,3,"B",ABMXMTDT,0)),0)),"^",2)
.I ABMER("CNT")=1 U 0 W !,"Writing bills to file.",!
.D ^ABME5L1
.D ^ABME5L2
S ABMNPDFN=$P(ABMB0,U,5)
D SBR
I ABMOSBR'=ABMASBR D
.D SBR
I ABMNPDFN'=ABMOPDFN D
.D PTCHG^ABME5L3
D ^ABME5L4
D ^ABME5L9
D ^ABME5L16
D ^ABME5L12
W "."
Q
SBR ;new subscriber
S ABMSFILE=$P(ABMASBR,"-",1)
S ABMSIEN=$P(ABMASBR,"-",2)
S ABMCHILD=0
N I
S I=0
F S I=$O(^ABMDTXST(DUZ(2),ABMPXMIT,2,"ASBR",ABMASBR,I)) Q:'I D
.Q:+^ABMDTXST(DUZ(2),ABMPXMIT,2,"ASBR",ABMASBR,I)=18
.Q:ABMBILL'=I
.S ABMCHILD=1
S ABMP("PNUM")=$$PNUM^ABMUTLP(ABMBILL)
D ^ABME5L3
S ABMOSBR=ABMASBR
S ABMOPDFN=ABMP("PDFN")
Q
END ;end of file
D ^%ZISC
W !!,"Finished.",!!
K ABME,ABM,ABMEF,ABMREC,ABMR,ABMRV,ABMFN,ABMLF,ABMLNUM,ABMPATH,ABMHL
Q
;
OPEN ;
; OPEN FILE
S DIR(0)="9002274.5,.47"
S DIR("A")="Enter Path"
S DIR("B")=$P($G(^ABMDPARM(DUZ(2),1,4)),"^",7)
D ^DIR K DIR
I Y["^" S POP=1 Q
S ABMPATH=Y
S ABMRCID=$P(^AUTNINS(ABMP("INS"),0),"^",8)
I $L(ABMRCID)<5 D
.S ABMRCID=$E("00000",1,5-$L(ABMRCID))_ABMRCID
S ABMJDT=$$JDT^XBFUNC(DT)
S ABMLF=$G(^ABMNINS("ALF",ABMP("INS")))
S:$P(ABMLF,".",2)'=ABMJDT ABMLF=""
S ABMLNUM=+$E($P(ABMLF,".",1),7,8)
S ABMLNUM=ABMLNUM+1
I ABMLNUM<10 S ABMLNUM="0"_ABMLNUM
S ABMFN="E"_ABMRCID_ABMLNUM_"."_ABMJDT
S DIR(0)="F",DIR("A")="Enter File Name: ",DIR("B")=ABMFN
D ^DIR K DIR
I Y["^" S POP=1 Q
S ABMFN=Y
S POP=0
D OPEN^%ZISH("EMCFILE",ABMPATH,ABMFN,"W")
S:'POP ^ABMNINS("ALF",ABMP("INS"))=ABMFN
Q
SEND ;EP - send file
S ABMFILE=ABMPATH_ABMFN
U IO(0)
W !,"Sending ",ABMFILE
S ABMSND=$$SENDTO1^%ZISH(ABMSPAR,ABMFILE)
I ABMSND W !,$P(ABMSND,"^",2)
Q
ABMEF32 ; IHS/ASDST/DMJ - Electronic 837 version 5010 Professional ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**6,8,10,21**;NOV 12, 2009;Build 379
+2 ;IHS/SD/SDR - 2.6*21 - HEAT132394 - Made change to K ABMP; data was hanging around, causing UNKNOWN in
+3 ; SBR04 for Medicare and dropping CAS segments.
+4 ;
START ;
+1 ;START HERE
+2 SET ABMPXMIT=ABMP("XMIT")
+3 IF '$DATA(ABMP("INS"))
Begin DoDot:1
+4 SET ABMP("INS")=$PIECE(^ABMDTXST(DUZ(2),ABMPXMIT,0),"^",4)
+5 IF 'ABMP("INS")
Begin DoDot:2
+6 SET DIC="^AUTNINS("
+7 SET DIC(0)="AEMQ"
+8 DO ^DIC
+9 IF Y<0
QUIT
+10 SET ABMP("INS")=+Y
End DoDot:2
End DoDot:1
+11 IF 'ABMP("INS")
Begin DoDot:1
+12 WRITE !,"Insurer NOT identified.",!
+13 DO EOP^ABMDUTL(1)
End DoDot:1
QUIT
+14 SET ABMPINS=ABMP("INS")
+15 ;S ABMP("ITYPE")=$P($G(^AUTNINS(ABMP("INS"),2)),U) ;abm*2.6*10 HEAT73780
+16 ;abm*2.6*10 HEAT73780
SET ABMP("ITYPE")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")
+17 SET ABMPITYP=ABMP("ITYPE")
+18 IF ($GET(ABMER("CNT"))=1)
Begin DoDot:1
+19 DO OPEN
+20 IF $GET(POP)
WRITE !,"File could not be created/opened.",!
QUIT
End DoDot:1
IF $GET(POP)
QUIT
+21 ;abm*2.6*8
IF $GET(POP)
QUIT
+22 SET DIE="^ABMDTXST(DUZ(2),"
+23 SET DA=ABMPXMIT
+24 SET DR=".14///"_ABMFN
+25 DO ^DIE
+26 DO LOOP
+27 IF '$GET(ABMSTOT)
Begin DoDot:1
+28 WRITE !,"No Bills in Batch.",!
End DoDot:1
+29 IF $GET(ABMSTOT)
Begin DoDot:1
+30 DO ^ABME5L11
End DoDot:1
+31 IF (ABMER("CNT")=ABMER("LAST"))
DO END
+32 QUIT
+33 ;
LOOP ;loop through bills
+1 KILL ABMR,ABMRT,ABMREC
+2 SET ABMOSBR=0
+3 SET ABMASBR=0
+4 SET (ABMNPDFN,ABMOPDFN)=0
+5 FOR
SET ABMASBR=$ORDER(^ABMDTXST(DUZ(2),ABMPXMIT,2,"ASBR",ABMASBR))
IF 'ABMASBR
QUIT
Begin DoDot:1
+6 KILL ABMP
+7 SET ABMBILL=0
+8 SET ABMOPDFN=0
+9 FOR
SET ABMBILL=$ORDER(^ABMDTXST(DUZ(2),ABMPXMIT,2,"ASBR",ABMASBR,ABMBILL))
IF 'ABMBILL
QUIT
Begin DoDot:2
+10 DO CLAIM
End DoDot:2
End DoDot:1
+11 QUIT
CLAIM ;one claim
+1 ;abm*2.6*21 IHS/SD/SDR HEAT132394
KILL ABMP
+2 SET ABMP("INS")=ABMPINS
+3 SET ABMP("ITYPE")=ABMPITYP
+4 SET ABMP("BDFN")=ABMBILL
+5 IF '$DATA(^ABMDBILL(DUZ(2),ABMP("BDFN"),0))
QUIT
+6 IF $PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),"^",4)="X"
QUIT
+7 DO BILLSTAT^ABMDREEX(DUZ(2),ABMP("BDFN"),ABMPXMIT,"O",ABMGCN)
+8 DO SET^ABMUTLP(ABMP("BDFN"))
+9 IF 'ABMOSBR
Begin DoDot:1
+10 IF ABMER("CNT")=1
USE 0
WRITE !,"Submission # ",$PIECE($GET(^ABMDTXST(DUZ(2),ABMPXMIT,3,$ORDER(^ABMDTXST(DUZ(2),ABMPXMIT,3,"B",ABMXMTDT,0)),0)),"^",2)
+11 IF ABMER("CNT")=1
USE 0
WRITE !,"Writing bills to file.",!
+12 DO ^ABME5L1
+13 DO ^ABME5L2
End DoDot:1
+14 SET ABMNPDFN=$PIECE(ABMB0,U,5)
+15 DO SBR
+16 IF ABMOSBR'=ABMASBR
Begin DoDot:1
+17 DO SBR
End DoDot:1
+18 IF ABMNPDFN'=ABMOPDFN
Begin DoDot:1
+19 DO PTCHG^ABME5L3
End DoDot:1
+20 DO ^ABME5L4
+21 DO ^ABME5L9
+22 DO ^ABME5L16
+23 DO ^ABME5L12
+24 WRITE "."
+25 QUIT
SBR ;new subscriber
+1 SET ABMSFILE=$PIECE(ABMASBR,"-",1)
+2 SET ABMSIEN=$PIECE(ABMASBR,"-",2)
+3 SET ABMCHILD=0
+4 NEW I
+5 SET I=0
+6 FOR
SET I=$ORDER(^ABMDTXST(DUZ(2),ABMPXMIT,2,"ASBR",ABMASBR,I))
IF 'I
QUIT
Begin DoDot:1
+7 IF +^ABMDTXST(DUZ(2),ABMPXMIT,2,"ASBR",ABMASBR,I)=18
QUIT
+8 IF ABMBILL'=I
QUIT
+9 SET ABMCHILD=1
End DoDot:1
+10 SET ABMP("PNUM")=$$PNUM^ABMUTLP(ABMBILL)
+11 DO ^ABME5L3
+12 SET ABMOSBR=ABMASBR
+13 SET ABMOPDFN=ABMP("PDFN")
+14 QUIT
END ;end of file
+1 DO ^%ZISC
+2 WRITE !!,"Finished.",!!
+3 KILL ABME,ABM,ABMEF,ABMREC,ABMR,ABMRV,ABMFN,ABMLF,ABMLNUM,ABMPATH,ABMHL
+4 QUIT
+5 ;
OPEN ;
+1 ; OPEN FILE
+2 SET DIR(0)="9002274.5,.47"
+3 SET DIR("A")="Enter Path"
+4 SET DIR("B")=$PIECE($GET(^ABMDPARM(DUZ(2),1,4)),"^",7)
+5 DO ^DIR
KILL DIR
+6 IF Y["^"
SET POP=1
QUIT
+7 SET ABMPATH=Y
+8 SET ABMRCID=$PIECE(^AUTNINS(ABMP("INS"),0),"^",8)
+9 IF $LENGTH(ABMRCID)<5
Begin DoDot:1
+10 SET ABMRCID=$EXTRACT("00000",1,5-$LENGTH(ABMRCID))_ABMRCID
End DoDot:1
+11 SET ABMJDT=$$JDT^XBFUNC(DT)
+12 SET ABMLF=$GET(^ABMNINS("ALF",ABMP("INS")))
+13 IF $PIECE(ABMLF,".",2)'=ABMJDT
SET ABMLF=""
+14 SET ABMLNUM=+$EXTRACT($PIECE(ABMLF,".",1),7,8)
+15 SET ABMLNUM=ABMLNUM+1
+16 IF ABMLNUM<10
SET ABMLNUM="0"_ABMLNUM
+17 SET ABMFN="E"_ABMRCID_ABMLNUM_"."_ABMJDT
+18 SET DIR(0)="F"
SET DIR("A")="Enter File Name: "
SET DIR("B")=ABMFN
+19 DO ^DIR
KILL DIR
+20 IF Y["^"
SET POP=1
QUIT
+21 SET ABMFN=Y
+22 SET POP=0
+23 DO OPEN^%ZISH("EMCFILE",ABMPATH,ABMFN,"W")
+24 IF 'POP
SET ^ABMNINS("ALF",ABMP("INS"))=ABMFN
+25 QUIT
SEND ;EP - send file
+1 SET ABMFILE=ABMPATH_ABMFN
+2 USE IO(0)
+3 WRITE !,"Sending ",ABMFILE
+4 SET ABMSND=$$SENDTO1^%ZISH(ABMSPAR,ABMFILE)
+5 IF ABMSND
WRITE !,$PIECE(ABMSND,"^",2)
+6 QUIT
