ABMEF21 ; IHS/ASDST/DMJ - Electronic 837 version 4010 Institutional ;
;;2.6;IHS Third Party Billing System;**2,3,8**;NOV 12, 2009
;
; IHS/SD/SDR - v2.5 p8 - IM15585 - code to check if patient changes, not just subscriber
; IHS/SD/SDR -abm*2.6*2 - 5PMS100005 - function call to populate EXPORT NUMBER RE-EXPORT multiple
;
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)
S ABMPITYP=ABMP("ITYPE")
;start old code abm*2.6*8
;D OPEN
;I $G(POP) W !,"File could not be created/opened.",! Q
;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 ^ABME8L11
;D END
;end old code start new code
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
;end new code
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
.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
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",$P($G(^ABMDTXST(DUZ(2),ABMPXMIT,1)),U,6)) ;abm*2.6*2 5PMS10005 ;abm*2.6*3 NOHEAT
D BILLSTAT^ABMDREEX(DUZ(2),ABMP("BDFN"),ABMPXMIT,"O",ABMGCN) ;abm*2.6*2 5PMS10005 ;abm*2.6*3 NOHEAT
D SET^ABMUTLP(ABMP("BDFN"))
I 'ABMOSBR D
.;U 0 W !,"Submission # ",$P($G(^ABMDTXST(DUZ(2),ABMPXMIT,1)),"^",6) ;abm*2.6*3 5PMS10005#2
.U 0 W !,"Submission # ",$P($G(^ABMDTXST(DUZ(2),ABMPXMIT,3,$O(^ABMDTXST(DUZ(2),ABMPXMIT,3,"B",ABMXMTDT,0)),0)),"^",2) ;abm*2.6*3 5PMS10005#2
.U 0 W !,"Writing bills to file.",!
.D ^ABME8L1
.D ^ABME8L2
S ABMNPDFN=$P(ABMB0,U,5)
D SBR
I ABMOSBR'=ABMASBR D
.D SBR
I ABMNPDFN'=ABMOPDFN D
.D PTCHG^ABME8L3
S ABMP("PNUM")=$$PNUM^ABMUTLP(ABMBILL)
D ^ABME8L5
D ^ABME8L6
D ^ABME8L7
D ^ABME8L8
D ^ABME8L10
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 ^ABME8L3
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
;start old code abm*2.6*8
;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
;end old code start new code
D ^XBFMK
I ($G(ABMER("CNT"))=1) D
.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 $G(Y)["^" S POP=1 Q
S ABMPATH=$S($G(Y)="":ABMPATH,1:Y)
;end new code
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
;start old code abm*2.6*8
;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")
;end old code start new code
S POP=0
I ($G(ABMER("CNT"))=1) D
.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
.D OPEN^%ZISH("EMCFILE",ABMPATH,ABMFN,"W")
;end new code
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
ABMEF21 ; IHS/ASDST/DMJ - Electronic 837 version 4010 Institutional ;
+1 ;;2.6;IHS Third Party Billing System;**2,3,8**;NOV 12, 2009
+2 ;
+3 ; IHS/SD/SDR - v2.5 p8 - IM15585 - code to check if patient changes, not just subscriber
+4 ; IHS/SD/SDR -abm*2.6*2 - 5PMS100005 - function call to populate EXPORT NUMBER RE-EXPORT multiple
+5 ;
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 SET ABMP("ITYPE")=$PIECE($GET(^AUTNINS(ABMP("INS"),2)),U)
+16 SET ABMPITYP=ABMP("ITYPE")
+17 ;start old code abm*2.6*8
+18 ;D OPEN
+19 ;I $G(POP) W !,"File could not be created/opened.",! Q
+20 ;S DIE="^ABMDTXST(DUZ(2),"
+21 ;S DA=ABMPXMIT
+22 ;S DR=".14///"_ABMFN
+23 ;D ^DIE
+24 ;D LOOP
+25 ;I '$G(ABMSTOT) D
+26 ;.W !,"No Bills in Batch.",!
+27 ;I $G(ABMSTOT) D
+28 ;.D ^ABME8L11
+29 ;D END
+30 ;end old code start new code
+31 IF ($GET(ABMER("CNT"))=1)
Begin DoDot:1
+32 DO OPEN
+33 IF $GET(POP)
WRITE !,"File could not be created/opened.",!
QUIT
End DoDot:1
IF $GET(POP)
QUIT
+34 ;abm*2.6*8
IF $GET(POP)
QUIT
+35 SET DIE="^ABMDTXST(DUZ(2),"
+36 SET DA=ABMPXMIT
+37 SET DR=".14///"_ABMFN
+38 DO ^DIE
+39 DO LOOP
+40 IF '$GET(ABMSTOT)
Begin DoDot:1
+41 WRITE !,"No Bills in Batch.",!
End DoDot:1
+42 IF $GET(ABMSTOT)
Begin DoDot:1
+43 DO ^ABME5L11
End DoDot:1
+44 IF (ABMER("CNT")=ABMER("LAST"))
DO END
+45 ;end new code
+46 QUIT
+47 ;
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 SET ABMBILL=0
+7 SET ABMOPDFN=0
+8 FOR
SET ABMBILL=$ORDER(^ABMDTXST(DUZ(2),ABMPXMIT,2,"ASBR",ABMASBR,ABMBILL))
IF 'ABMBILL
QUIT
Begin DoDot:2
+9 DO CLAIM
End DoDot:2
End DoDot:1
+10 QUIT
CLAIM ;one claim
+1 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 ;D BILLSTAT^ABMDREEX(DUZ(2),ABMP("BDFN"),ABMPXMIT,"O",$P($G(^ABMDTXST(DUZ(2),ABMPXMIT,1)),U,6)) ;abm*2.6*2 5PMS10005 ;abm*2.6*3 NOHEAT
+8 ;abm*2.6*2 5PMS10005 ;abm*2.6*3 NOHEAT
DO BILLSTAT^ABMDREEX(DUZ(2),ABMP("BDFN"),ABMPXMIT,"O",ABMGCN)
+9 DO SET^ABMUTLP(ABMP("BDFN"))
+10 IF 'ABMOSBR
Begin DoDot:1
+11 ;U 0 W !,"Submission # ",$P($G(^ABMDTXST(DUZ(2),ABMPXMIT,1)),"^",6) ;abm*2.6*3 5PMS10005#2
+12 ;abm*2.6*3 5PMS10005#2
USE 0
WRITE !,"Submission # ",$PIECE($GET(^ABMDTXST(DUZ(2),ABMPXMIT,3,$ORDER(^ABMDTXST(DUZ(2),ABMPXMIT,3,"B",ABMXMTDT,0)),0)),"^",2)
+13 USE 0
WRITE !,"Writing bills to file.",!
+14 DO ^ABME8L1
+15 DO ^ABME8L2
End DoDot:1
+16 SET ABMNPDFN=$PIECE(ABMB0,U,5)
+17 DO SBR
+18 IF ABMOSBR'=ABMASBR
Begin DoDot:1
+19 DO SBR
End DoDot:1
+20 IF ABMNPDFN'=ABMOPDFN
Begin DoDot:1
+21 DO PTCHG^ABME8L3
End DoDot:1
+22 SET ABMP("PNUM")=$$PNUM^ABMUTLP(ABMBILL)
+23 DO ^ABME8L5
+24 DO ^ABME8L6
+25 DO ^ABME8L7
+26 DO ^ABME8L8
+27 DO ^ABME8L10
+28 WRITE "."
+29 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 ^ABME8L3
+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 ;start old code abm*2.6*8
+3 ;S DIR(0)="9002274.5,.47"
+4 ;S DIR("A")="Enter Path"
+5 ;S DIR("B")=$P($G(^ABMDPARM(DUZ(2),1,4)),"^",7)
+6 ;D ^DIR K DIR
+7 ;I Y["^" S POP=1 Q
+8 ;S ABMPATH=Y
+9 ;end old code start new code
+10 DO ^XBFMK
+11 IF ($GET(ABMER("CNT"))=1)
Begin DoDot:1
+12 SET DIR(0)="9002274.5,.47"
+13 SET DIR("A")="Enter Path"
+14 SET DIR("B")=$PIECE($GET(^ABMDPARM(DUZ(2),1,4)),"^",7)
+15 DO ^DIR
KILL DIR
+16 IF $GET(Y)["^"
SET POP=1
QUIT
End DoDot:1
+17 SET ABMPATH=$SELECT($GET(Y)="":ABMPATH,1:Y)
+18 ;end new code
+19 SET ABMRCID=$PIECE(^AUTNINS(ABMP("INS"),0),"^",8)
+20 IF $LENGTH(ABMRCID)<5
Begin DoDot:1
+21 SET ABMRCID=$EXTRACT("00000",1,5-$LENGTH(ABMRCID))_ABMRCID
End DoDot:1
+22 SET ABMJDT=$$JDT^XBFUNC(DT)
+23 SET ABMLF=$GET(^ABMNINS("ALF",ABMP("INS")))
+24 IF $PIECE(ABMLF,".",2)'=ABMJDT
SET ABMLF=""
+25 SET ABMLNUM=+$EXTRACT($PIECE(ABMLF,".",1),7,8)
+26 SET ABMLNUM=ABMLNUM+1
+27 IF ABMLNUM<10
SET ABMLNUM="0"_ABMLNUM
+28 SET ABMFN="E"_ABMRCID_ABMLNUM_"."_ABMJDT
+29 ;start old code abm*2.6*8
+30 ;S DIR(0)="F",DIR("A")="Enter File Name: ",DIR("B")=ABMFN
+31 ;D ^DIR K DIR
+32 ;I Y["^" S POP=1 Q
+33 ;S ABMFN=Y
+34 ;S POP=0
+35 ;D OPEN^%ZISH("EMCFILE",ABMPATH,ABMFN,"W")
+36 ;end old code start new code
+37 SET POP=0
+38 IF ($GET(ABMER("CNT"))=1)
Begin DoDot:1
+39 SET DIR(0)="F"
SET DIR("A")="Enter File Name: "
SET DIR("B")=ABMFN
+40 DO ^DIR
KILL DIR
+41 IF Y["^"
SET POP=1
QUIT
+42 SET ABMFN=Y
+43 DO OPEN^%ZISH("EMCFILE",ABMPATH,ABMFN,"W")
End DoDot:1
+44 ;end new code
+45 IF 'POP
SET ^ABMNINS("ALF",ABMP("INS"))=ABMFN
+46 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
