ABMEF20 ; IHS/ASDST/DMJ - Electronic HCFA-1500 V3.01 ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;
; IHS/ASDS/DMJ - V2.4 P7 - 9/6/01 NOIS HQW-0701-100066
; This is a new routine related to Medicare Part B
;
; IHS/SD/SDR v2.5 p3 - 2/26/2003 - NDA-0402-180192
; Added new block 19 stuff
;
START ;
;START HERE
I '$D(ABMP("INS")) D
.S ABMP("INS")=$P(^ABMDTXST(DUZ(2),ABMP("XMIT"),0),"^",4)
.I 'ABMP("INS") D
..S DIC="^AUTNINS("
..S DIC(0)="AEMQ"
..D ^DIC
..Q:Y<0
..S ABMP("INS")=+Y
.S ABMP("ITYPE")=$P($G(^AUTNINS(ABMP("INS"),2)),U)
I 'ABMP("INS") D Q
.W !,"Insurer NOT identified.",!
.D EOP^ABMDUTL(1)
S ABMP("FTYPE")=$P($G(^ABMDPARM(DUZ(2),1,3)),"^",4)
S:ABMP("FTYPE")="" ABMP("FTYPE")="H"
D OPEN
I $G(POP) W !,"File could not be created/opened.",! Q
S DIE="^ABMDTXST(DUZ(2),"
S DA=ABMP("XMIT")
S DR=".14///"_ABMFN
D ^DIE
D LOOP
D END
Q
;
LOOP ;loop through bills
S ABMP("L#")=0
S ABMEF("BATCH#")=0
S ABMP("MP")=1
S ABMP("WRITE")=1
K ABMR,ABMRT
S ABMOPRV=0
S ABMAPRV=0
F S ABMAPRV=$O(^ABMDTXST(DUZ(2),ABMP("XMIT"),2,"APROV",ABMAPRV)) Q:'ABMAPRV D
.S ABMTXIEN=0 F S ABMTXIEN=$O(^ABMDTXST(DUZ(2),ABMP("XMIT"),2,"APROV",ABMAPRV,ABMTXIEN)) Q:'ABMTXIEN D CLAIM
Q
CLAIM ;one claim
S ABMP("BDFN")=+^ABMDTXST(DUZ(2),ABMP("XMIT"),2,ABMTXIEN,0)
Q:'$D(^ABMDBILL(DUZ(2),ABMP("BDFN"),0))
Q:$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),"^",4)="X"
S ABMBIL0=$G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0))
S ABMP("LDFN")=$P(ABMBIL0,"^",3)
S ABMP("VTYP")=$P(ABMBIL0,"^",7)
I 'ABMOPRV D
.D ^ABME3AA0
.U 0 W !,"Submission # ",ABMR(1,50),!
.U 0 W !,"Writing bills to file.",!
.S ABMEF("LINE")=ABMREC(1)
.D WRITE
I ABMAPRV'=ABMOPRV D BATCH
W "."
K ABMR
D ^ABMEH20
S ABMEF("LINE")=ABMREC(20)
D WRITE
K ABMR
D ^ABME3DA0
F I=1:1:3 D
.I $D(ABMREC(30,I)) D
..S ABMEF("LINE")=ABMREC(30,I)
..D WRITE
.I $D(ABMREC(31,I)) D
..S ABMEF("LINE")=ABMREC(31,I)
..D WRITE
K ABMR
D ^ABME3EA0
S ABMEF("LINE")=ABMREC(40)
D WRITE
K ABMR
D ^ABME3EA1
S ABMEF("LINE")=ABMREC(41)
D WRITE
K ABMR
D ^ABME3FA0
K ABMR
D ^ABME3XA0
S ABMEF("LINE")=ABMREC(90)
D WRITE
S DIE="^ABMDBILL(DUZ(2),"
S DA=ABMP("BDFN")
S DR=".04////B;.16////A;.17////"_ABMP("XMIT")
D ^DIE
Q
BATCH ;new batch
S ABMEF("BATCH#")=ABMEF("BATCH#")+1
I ABMOPRV D
.D ^ABMEH95
.S ABMEF("LINE")=ABMREC(95)
.D WRITE
D ^ABME3BA0
S ABMEF("LINE")=ABMREC(10)
D WRITE
D ^ABMEH15
S ABMEF("LINE")=ABMREC(15)
D WRITE
S ABMOPRV=ABMAPRV
Q
END ;end of file
K ABMR
D ^ABMEH95
S ABMEF("LINE")=ABMREC(95)
D WRITE
K ABMR
D ^ABMEH99
S ABMEF("LINE")=ABMREC(99)
D WRITE
D CLOSE
W !!,"Finished.",!!
K ABME,ABM,ABMEF,ABMREC,ABMR,ABMRV,ABMFN,ABMLF,ABMLNUM,ABMPATH
Q
;
OPEN ;
; OPEN FILE
I ABMP("FTYPE")="K" D
.S POP=0
.S DIC="^DIZ(8980,"
.S DIC(0)="AEMQL"
.S DIC("S")="I $P(^(0),""^"",5)=DUZ"
.D ^DIC
.K DIC
.I Y<0 S POP=1 Q
.S ABMP("FILE#")=+Y
.S ABMFN=$P(Y,"^",2)
.I $O(^DIZ(8980,ABMP("FILE#"),2,0)) D
..W !,*7,"Data already exists in this file!",!
..S DIR("A")="Delete"
..S DIR(0)="Y"
..S DIR("B")="NO"
..D ^DIR
..K DIR
..I Y=1 K ^DIZ(8980,ABMP("FILE#"),2)
..I Y=0 S POP=1
I ABMP("FTYPE")="H" 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 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
.D OPEN^%ZISH("EMCFILE",ABMPATH,ABMFN,"W")
.S:'POP ^ABMNINS("ALF",ABMP("INS"))=ABMFN
I ABMP("FTYPE")="M" D
.S ABMP("DOMAIN")=$P($G(^ABMDPARM(DUZ(2),1,3)),"^",9)
.I 'ABMP("DOMAIN") W !,"MM SEND TO DOMAIN NOT DEFINED.",! S POP=1 Q
.S ABMP("DOMAIN")=$P(^DIC(4.2,ABMP("DOMAIN"),0),U)
.S XMSUB="EMC FILE FROM "_$P($G(^AUTTLOC(DUZ(2),0)),"^",2)
.S XMDUZ=DUZ
.D XMZ^XMA2
.I XMZ<1 S POP=1 Q
.S ABMFN="MAIL MSG# "_XMZ
.W !!,"MAIL MSG# ",XMZ," CREATED.",!
Q
;
WRITE ;EP - write record to file
Q:'$G(ABMP("WRITE"))
I ABMP("FTYPE")="K" D
.S ABMP("L#")=ABMP("L#")+1
.S ^DIZ(8980,ABMP("FILE#"),2,ABMP("L#"),0)=ABMEF("LINE")
I ABMP("FTYPE")="H" D
.U IO
.W ABMEF("LINE"),$C(13,10)
.U IO(0)
I ABMP("FTYPE")="M" D
.S ABMP("L#")=ABMP("L#")+1
.S ^XMB(3.9,XMZ,2,ABMP("L#"),0)=ABMEF("LINE")
Q
;
CLOSE ;
;CLOSE FILE
I ABMP("FTYPE")="H" D ^%ZISC
I ABMP("FTYPE")="K" S ^DIZ(8980,ABMP("FILE#"),2,0)="^^"_I_"^"_I_"^"_DT
I ABMP("FTYPE")="M" D
.S ^XMB(3.9,XMZ,2,0)="^3.92A^"_ABMP("L#")_"^"_ABMP("L#")_"^"_DT
.S XMY(".5@"_ABMP("DOMAIN"))=""
.D ENT1^XMD
Q
ABMEF20 ; IHS/ASDST/DMJ - Electronic HCFA-1500 V3.01 ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;
+3 ; IHS/ASDS/DMJ - V2.4 P7 - 9/6/01 NOIS HQW-0701-100066
+4 ; This is a new routine related to Medicare Part B
+5 ;
+6 ; IHS/SD/SDR v2.5 p3 - 2/26/2003 - NDA-0402-180192
+7 ; Added new block 19 stuff
+8 ;
START ;
+1 ;START HERE
+2 IF '$DATA(ABMP("INS"))
Begin DoDot:1
+3 SET ABMP("INS")=$PIECE(^ABMDTXST(DUZ(2),ABMP("XMIT"),0),"^",4)
+4 IF 'ABMP("INS")
Begin DoDot:2
+5 SET DIC="^AUTNINS("
+6 SET DIC(0)="AEMQ"
+7 DO ^DIC
+8 IF Y<0
QUIT
+9 SET ABMP("INS")=+Y
End DoDot:2
+10 SET ABMP("ITYPE")=$PIECE($GET(^AUTNINS(ABMP("INS"),2)),U)
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 ABMP("FTYPE")=$PIECE($GET(^ABMDPARM(DUZ(2),1,3)),"^",4)
+15 IF ABMP("FTYPE")=""
SET ABMP("FTYPE")="H"
+16 DO OPEN
+17 IF $GET(POP)
WRITE !,"File could not be created/opened.",!
QUIT
+18 SET DIE="^ABMDTXST(DUZ(2),"
+19 SET DA=ABMP("XMIT")
+20 SET DR=".14///"_ABMFN
+21 DO ^DIE
+22 DO LOOP
+23 DO END
+24 QUIT
+25 ;
LOOP ;loop through bills
+1 SET ABMP("L#")=0
+2 SET ABMEF("BATCH#")=0
+3 SET ABMP("MP")=1
+4 SET ABMP("WRITE")=1
+5 KILL ABMR,ABMRT
+6 SET ABMOPRV=0
+7 SET ABMAPRV=0
+8 FOR
SET ABMAPRV=$ORDER(^ABMDTXST(DUZ(2),ABMP("XMIT"),2,"APROV",ABMAPRV))
IF 'ABMAPRV
QUIT
Begin DoDot:1
+9 SET ABMTXIEN=0
FOR
SET ABMTXIEN=$ORDER(^ABMDTXST(DUZ(2),ABMP("XMIT"),2,"APROV",ABMAPRV,ABMTXIEN))
IF 'ABMTXIEN
QUIT
DO CLAIM
End DoDot:1
+10 QUIT
CLAIM ;one claim
+1 SET ABMP("BDFN")=+^ABMDTXST(DUZ(2),ABMP("XMIT"),2,ABMTXIEN,0)
+2 IF '$DATA(^ABMDBILL(DUZ(2),ABMP("BDFN"),0))
QUIT
+3 IF $PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),"^",4)="X"
QUIT
+4 SET ABMBIL0=$GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),0))
+5 SET ABMP("LDFN")=$PIECE(ABMBIL0,"^",3)
+6 SET ABMP("VTYP")=$PIECE(ABMBIL0,"^",7)
+7 IF 'ABMOPRV
Begin DoDot:1
+8 DO ^ABME3AA0
+9 USE 0
WRITE !,"Submission # ",ABMR(1,50),!
+10 USE 0
WRITE !,"Writing bills to file.",!
+11 SET ABMEF("LINE")=ABMREC(1)
+12 DO WRITE
End DoDot:1
+13 IF ABMAPRV'=ABMOPRV
DO BATCH
+14 WRITE "."
+15 KILL ABMR
+16 DO ^ABMEH20
+17 SET ABMEF("LINE")=ABMREC(20)
+18 DO WRITE
+19 KILL ABMR
+20 DO ^ABME3DA0
+21 FOR I=1:1:3
Begin DoDot:1
+22 IF $DATA(ABMREC(30,I))
Begin DoDot:2
+23 SET ABMEF("LINE")=ABMREC(30,I)
+24 DO WRITE
End DoDot:2
+25 IF $DATA(ABMREC(31,I))
Begin DoDot:2
+26 SET ABMEF("LINE")=ABMREC(31,I)
+27 DO WRITE
End DoDot:2
End DoDot:1
+28 KILL ABMR
+29 DO ^ABME3EA0
+30 SET ABMEF("LINE")=ABMREC(40)
+31 DO WRITE
+32 KILL ABMR
+33 DO ^ABME3EA1
+34 SET ABMEF("LINE")=ABMREC(41)
+35 DO WRITE
+36 KILL ABMR
+37 DO ^ABME3FA0
+38 KILL ABMR
+39 DO ^ABME3XA0
+40 SET ABMEF("LINE")=ABMREC(90)
+41 DO WRITE
+42 SET DIE="^ABMDBILL(DUZ(2),"
+43 SET DA=ABMP("BDFN")
+44 SET DR=".04////B;.16////A;.17////"_ABMP("XMIT")
+45 DO ^DIE
+46 QUIT
BATCH ;new batch
+1 SET ABMEF("BATCH#")=ABMEF("BATCH#")+1
+2 IF ABMOPRV
Begin DoDot:1
+3 DO ^ABMEH95
+4 SET ABMEF("LINE")=ABMREC(95)
+5 DO WRITE
End DoDot:1
+6 DO ^ABME3BA0
+7 SET ABMEF("LINE")=ABMREC(10)
+8 DO WRITE
+9 DO ^ABMEH15
+10 SET ABMEF("LINE")=ABMREC(15)
+11 DO WRITE
+12 SET ABMOPRV=ABMAPRV
+13 QUIT
END ;end of file
+1 KILL ABMR
+2 DO ^ABMEH95
+3 SET ABMEF("LINE")=ABMREC(95)
+4 DO WRITE
+5 KILL ABMR
+6 DO ^ABMEH99
+7 SET ABMEF("LINE")=ABMREC(99)
+8 DO WRITE
+9 DO CLOSE
+10 WRITE !!,"Finished.",!!
+11 KILL ABME,ABM,ABMEF,ABMREC,ABMR,ABMRV,ABMFN,ABMLF,ABMLNUM,ABMPATH
+12 QUIT
+13 ;
OPEN ;
+1 ; OPEN FILE
+2 IF ABMP("FTYPE")="K"
Begin DoDot:1
+3 SET POP=0
+4 SET DIC="^DIZ(8980,"
+5 SET DIC(0)="AEMQL"
+6 SET DIC("S")="I $P(^(0),""^"",5)=DUZ"
+7 DO ^DIC
+8 KILL DIC
+9 IF Y<0
SET POP=1
QUIT
+10 SET ABMP("FILE#")=+Y
+11 SET ABMFN=$PIECE(Y,"^",2)
+12 IF $ORDER(^DIZ(8980,ABMP("FILE#"),2,0))
Begin DoDot:2
+13 WRITE !,*7,"Data already exists in this file!",!
+14 SET DIR("A")="Delete"
+15 SET DIR(0)="Y"
+16 SET DIR("B")="NO"
+17 DO ^DIR
+18 KILL DIR
+19 IF Y=1
KILL ^DIZ(8980,ABMP("FILE#"),2)
+20 IF Y=0
SET POP=1
End DoDot:2
End DoDot:1
+21 IF ABMP("FTYPE")="H"
Begin DoDot:1
+22 SET DIR(0)="9002274.5,.47"
+23 SET DIR("A")="Enter Path"
+24 SET DIR("B")=$PIECE($GET(^ABMDPARM(DUZ(2),1,4)),"^",7)
+25 DO ^DIR
KILL DIR
+26 IF Y["^"
SET POP=1
QUIT
+27 SET ABMPATH=Y
+28 SET ABMRCID=$PIECE(^AUTNINS(ABMP("INS"),0),"^",8)
+29 IF $LENGTH(ABMRCID)<5
Begin DoDot:2
+30 SET ABMRCID=$EXTRACT("00000",1,5-$LENGTH(ABMRCID))_ABMRCID
End DoDot:2
+31 SET ABMJDT=$$JDT^XBFUNC(DT)
+32 SET ABMLF=$GET(^ABMNINS("ALF",ABMP("INS")))
+33 IF $PIECE(ABMLF,".",2)'=ABMJDT
SET ABMLF=""
+34 SET ABMLNUM=+$EXTRACT($PIECE(ABMLF,".",1),7,8)
+35 SET ABMLNUM=ABMLNUM+1
+36 IF ABMLNUM<10
SET ABMLNUM="0"_ABMLNUM
+37 SET ABMFN="E"_ABMRCID_ABMLNUM_"."_ABMJDT
+38 SET DIR(0)="F"
SET DIR("A")="Enter File Name: "
SET DIR("B")=ABMFN
+39 DO ^DIR
KILL DIR
+40 IF Y["^"
SET POP=1
QUIT
+41 SET ABMFN=Y
+42 DO OPEN^%ZISH("EMCFILE",ABMPATH,ABMFN,"W")
+43 IF 'POP
SET ^ABMNINS("ALF",ABMP("INS"))=ABMFN
End DoDot:1
+44 IF ABMP("FTYPE")="M"
Begin DoDot:1
+45 SET ABMP("DOMAIN")=$PIECE($GET(^ABMDPARM(DUZ(2),1,3)),"^",9)
+46 IF 'ABMP("DOMAIN")
WRITE !,"MM SEND TO DOMAIN NOT DEFINED.",!
SET POP=1
QUIT
+47 SET ABMP("DOMAIN")=$PIECE(^DIC(4.2,ABMP("DOMAIN"),0),U)
+48 SET XMSUB="EMC FILE FROM "_$PIECE($GET(^AUTTLOC(DUZ(2),0)),"^",2)
+49 SET XMDUZ=DUZ
+50 DO XMZ^XMA2
+51 IF XMZ<1
SET POP=1
QUIT
+52 SET ABMFN="MAIL MSG# "_XMZ
+53 WRITE !!,"MAIL MSG# ",XMZ," CREATED.",!
End DoDot:1
+54 QUIT
+55 ;
WRITE ;EP - write record to file
+1 IF '$GET(ABMP("WRITE"))
QUIT
+2 IF ABMP("FTYPE")="K"
Begin DoDot:1
+3 SET ABMP("L#")=ABMP("L#")+1
+4 SET ^DIZ(8980,ABMP("FILE#"),2,ABMP("L#"),0)=ABMEF("LINE")
End DoDot:1
+5 IF ABMP("FTYPE")="H"
Begin DoDot:1
+6 USE IO
+7 WRITE ABMEF("LINE"),$CHAR(13,10)
+8 USE IO(0)
End DoDot:1
+9 IF ABMP("FTYPE")="M"
Begin DoDot:1
+10 SET ABMP("L#")=ABMP("L#")+1
+11 SET ^XMB(3.9,XMZ,2,ABMP("L#"),0)=ABMEF("LINE")
End DoDot:1
+12 QUIT
+13 ;
CLOSE ;
+1 ;CLOSE FILE
+2 IF ABMP("FTYPE")="H"
DO ^%ZISC
+3 IF ABMP("FTYPE")="K"
SET ^DIZ(8980,ABMP("FILE#"),2,0)="^^"_I_"^"_I_"^"_DT
+4 IF ABMP("FTYPE")="M"
Begin DoDot:1
+5 SET ^XMB(3.9,XMZ,2,0)="^3.92A^"_ABMP("L#")_"^"_ABMP("L#")_"^"_DT
+6 SET XMY(".5@"_ABMP("DOMAIN"))=""
+7 DO ENT1^XMD
End DoDot:1
+8 QUIT
