Routine: ABMEF19

ABMEF19 ; IHS/ASDST/DMJ - Electronic HCFA-1500 V2.0 Envoy Version ;

 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 ; IHS/ASDS/DMJ - 03/01/01 - V2.4 P5 - NOIS HQW-0301-100010

 ;    New routine to address new Envoy electronic format

 ; IHS/ASDS/DMJ - 04/04/01 - V2.4 P5 - NOIS-HQW-0401-100014

 ;    Changed it so "!" is done as $C(13,10).  There was a problem

 ;    because "!" is interpreted different than $C(13,10).

 ; IHS/FCS/DRS - 09/17/2001 - ABM*2.4*9

 ;   Part 2b $$ENVOY, $$ENVOY15 calls

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 !!,*7,"Insurer NOT identified.",!

 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

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

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 ^ABMEAA0

 .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 ^ABMEH30

 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

 .I $D(ABMREC(32,I)) D

 ..S ABMEF("LINE")=ABMREC(32,I)

 ..D WRITE

 K ABMR

 D ^ABMEH40

 S ABMEF("LINE")=ABMREC(40)

 D WRITE

 K ABMR

 D ^ABMEH61

 K ABMR

 D ^ABMEH90

 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

BATCH ;new batch

 S ABMEF("BATCH#")=ABMEF("BATCH#")+1

 I ABMOPRV D

 .D ^ABMEH95

 .S ABMEF("LINE")=ABMREC(95)

 .D WRITE

 D ^ABMEBA0

 S ABMEF("LINE")=ABMREC(10)

 D WRITE

 D ^ABMEH15

 S ABMEF("LINE")=ABMREC(15)

 D WRITE

 S ABMOPRV=ABMAPRV

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

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,.52"

 .S DIR("A")="Enter Path"

 .S DIR("B")=$P($G(^ABMDPARM(DUZ(2),1,5)),"^",2)

 .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="H"_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.",!

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")

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

 ; Patch 9 Part 2b  new  08/xx/2001  IHS/FCS/DRS

FMTNAME() Q $$GET1^DIQ(9002274.6,ABMP("XMIT")_",","EXPORT MODE")

 ; begin ABM*2.4*9 Part 2b

ENVOY15() ; EP - Is this the Envoy 1500 format? ; ABM*2.4*9 IHS/FCS/DRS 09/21/01 ;

 ; A call to this is needed when making changes to code used by

 ; other formats, such as ABMEH20

 N X S X=$$FMTNAME

 Q X["15"&(X["ENVOY")

ENVOY() ; EP - Is the an Envoy format? ; ABM*2.4*9 IHS/FCS/DRS 09/21/01 ;

 ; A call to this is needed when making changes to code used by

 ; other formats, such as ABMEH61

 Q $$FMTNAME["ENVOY"

ABMEF19   ; IHS/ASDST/DMJ - Electronic HCFA-1500 V2.0 Envoy Version ;

 +1       ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 +2       ;

 +3       ; IHS/ASDS/DMJ - 03/01/01 - V2.4 P5 - NOIS HQW-0301-100010

 +4       ;    New routine to address new Envoy electronic format

 +5       ;

 +6       ; IHS/ASDS/DMJ - 04/04/01 - V2.4 P5 - NOIS-HQW-0401-100014

 +7       ;    Changed it so "!" is done as $C(13,10).  There was a problem

 +8       ;    because "!" is interpreted different than $C(13,10).

 +9       ;

 +10      ; IHS/FCS/DRS - 09/17/2001 - ABM*2.4*9

 +11      ;   Part 2b $$ENVOY, $$ENVOY15 calls

 +12      ;

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 !!,*7,"Insurer NOT identified.",!

               End DoDot:1

               QUIT

 +13       SET ABMP("FTYPE")=$PIECE($GET(^ABMDPARM(DUZ(2),1,3)),"^",4)

 +14       IF ABMP("FTYPE")=""

               SET ABMP("FTYPE")="H"

 +15       DO OPEN

 +16       IF $GET(POP)

               WRITE !,"File could not be created/opened.",!

               QUIT

 +17       SET DIE="^ABMDTXST(DUZ(2),"

 +18       SET DA=ABMP("XMIT")

 +19       SET DR=".14///"_ABMFN

 +20       DO ^DIE

 +21       DO LOOP

 +22       DO END

 +23       QUIT

 +24      ;

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 ^ABMEAA0

 +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 ^ABMEH30

 +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

 +28               IF $DATA(ABMREC(32,I))

                       Begin DoDot:2

 +29                       SET ABMEF("LINE")=ABMREC(32,I)

 +30                       DO WRITE

                       End DoDot:2

               End DoDot:1

 +31       KILL ABMR

 +32       DO ^ABMEH40

 +33       SET ABMEF("LINE")=ABMREC(40)

 +34       DO WRITE

 +35       KILL ABMR

 +36       DO ^ABMEH61

 +37       KILL ABMR

 +38       DO ^ABMEH90

 +39       SET ABMEF("LINE")=ABMREC(90)

 +40       DO WRITE

 +41       SET DIE="^ABMDBILL(DUZ(2),"

 +42       SET DA=ABMP("BDFN")

 +43       SET DR=".04////B;.16////A;.17////"_ABMP("XMIT")

 +44       DO ^DIE

 +45       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 ^ABMEBA0

 +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,.52"

 +23               SET DIR("A")="Enter Path"

 +24               SET DIR("B")=$PIECE($GET(^ABMDPARM(DUZ(2),1,5)),"^",2)

 +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="H"_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

 +9       ; Patch 9 Part 2b  new  08/xx/2001  IHS/FCS/DRS

FMTNAME()  QUIT $$GET1^DIQ(9002274.6,ABMP("XMIT")_",","EXPORT MODE")

 +1       ; begin ABM*2.4*9 Part 2b

ENVOY15() ; EP - Is this the Envoy 1500 format? ; ABM*2.4*9 IHS/FCS/DRS 09/21/01 ;

 +1       ; A call to this is needed when making changes to code used by

 +2       ; other formats, such as ABMEH20

 +3        NEW X

           SET X=$$FMTNAME

 +4        QUIT X["15"&(X["ENVOY")

ENVOY()   ; EP - Is the an Envoy format? ; ABM*2.4*9 IHS/FCS/DRS 09/21/01 ;

 +1       ; A call to this is needed when making changes to code used by

 +2       ; other formats, such as ABMEH61

 +3        QUIT $$FMTNAME["ENVOY"

ABMEF19.m