- ABMEF15 ; IHS/ASDST/DMJ - Electronic HCFA-1500 V2.0 ;
- ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
- ;Original;DMJ;07/08/96 4:53 PM
- ;
- ; IHS/ASDST/DMJ - 02/07/01 - V2.4 Patch4 NOIS NCA-0201-180004
- ; Modified to fix issue with submitter ID in electronic trans.
- ;
- ; IHS/ASDS/LSL - 7/27/01 - V2.4 P7 - NOIS NDA-0301-180017
- ; Modified to resolve <UNDEF>PCN+1^ABMERUTL for all electronic
- ; modes of export.
- ;
- 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
- ;
- LOOP ;
- ; LOOP THROUGH BILLS
- S ABMP("L#")=0
- S ABMEF("BATCH#")=0
- S ABMP("MP")=1
- S ABMP("WRITE")=1
- K ABMR,ABMRT
- S ABMP("OLDFN")=0
- S ABMP("OBTYP")=0
- S ABMP("ORD")=0
- F S ABMP("ORD")=$O(^ABMDTXST(DUZ(2),ABMP("XMIT"),2,ABMP("ORD"))) Q:'ABMP("ORD") D
- .S ABMP("BDFN")=+^ABMDTXST(DUZ(2),ABMP("XMIT"),2,ABMP("ORD"),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("BTYP")=$P(ABMBIL0,U,2)
- .S ABMP("LDFN")=$P(ABMBIL0,U,3)
- .S ABMP("VTYP")=$P(ABMBIL0,U,7)
- .I 'ABMEF("BATCH#") D
- ..D ^ABMEH01
- ..U 0 W !,"Submission # ",ABMR(1,50),!
- ..U 0 W !,"Writing bills to file.",!
- ..S ABMEF("LINE")=ABMREC(1)
- ..D WRITE
- .I ABMP("BTYP")'=ABMP("OBTYP")!(ABMP("LDFN")'=ABMP("OLDFN")) D
- ..I $$RCID^ABMERUTL(ABMP("INS"))=99999,$G(ABMEF("BATCH#")) Q
- ..S ABMEF("BATCH#")=ABMEF("BATCH#")+1
- ..I ABMP("OBTYP") D
- ...D ^ABMEH95
- ...S ABMEF("LINE")=ABMREC(95)
- ...D WRITE
- ..D ^ABMEH10
- ..S ABMEF("LINE")=ABMREC(10)
- ..D WRITE
- ..D ^ABMEH15
- ..S ABMEF("LINE")=ABMREC(15)
- ..D WRITE
- ..S ABMP("OBTYP")=ABMP("BTYP")
- ..S ABMP("OLDFN")=ABMP("LDFN")
- .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
- 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
- ABMEF15 ; IHS/ASDST/DMJ - Electronic HCFA-1500 V2.0 ;
- +1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
- +2 ;Original;DMJ;07/08/96 4:53 PM
- +3 ;
- +4 ; IHS/ASDST/DMJ - 02/07/01 - V2.4 Patch4 NOIS NCA-0201-180004
- +5 ; Modified to fix issue with submitter ID in electronic trans.
- +6 ;
- +7 ; IHS/ASDS/LSL - 7/27/01 - V2.4 P7 - NOIS NDA-0301-180017
- +8 ; Modified to resolve <UNDEF>PCN+1^ABMERUTL for all electronic
- +9 ; modes of export.
- +10 ;
- 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 ;
- LOOP ;
- +1 ; LOOP THROUGH BILLS
- +2 SET ABMP("L#")=0
- +3 SET ABMEF("BATCH#")=0
- +4 SET ABMP("MP")=1
- +5 SET ABMP("WRITE")=1
- +6 KILL ABMR,ABMRT
- +7 SET ABMP("OLDFN")=0
- +8 SET ABMP("OBTYP")=0
- +9 SET ABMP("ORD")=0
- +10 FOR
- SET ABMP("ORD")=$ORDER(^ABMDTXST(DUZ(2),ABMP("XMIT"),2,ABMP("ORD")))
- IF 'ABMP("ORD")
- QUIT
- Begin DoDot:1
- +11 SET ABMP("BDFN")=+^ABMDTXST(DUZ(2),ABMP("XMIT"),2,ABMP("ORD"),0)
- +12 IF '$DATA(^ABMDBILL(DUZ(2),ABMP("BDFN"),0))
- QUIT
- +13 IF $PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),"^",4)="X"
- QUIT
- +14 SET ABMBIL0=$GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),0))
- +15 SET ABMP("BTYP")=$PIECE(ABMBIL0,U,2)
- +16 SET ABMP("LDFN")=$PIECE(ABMBIL0,U,3)
- +17 SET ABMP("VTYP")=$PIECE(ABMBIL0,U,7)
- +18 IF 'ABMEF("BATCH#")
- Begin DoDot:2
- +19 DO ^ABMEH01
- +20 USE 0
- WRITE !,"Submission # ",ABMR(1,50),!
- +21 USE 0
- WRITE !,"Writing bills to file.",!
- +22 SET ABMEF("LINE")=ABMREC(1)
- +23 DO WRITE
- End DoDot:2
- +24 IF ABMP("BTYP")'=ABMP("OBTYP")!(ABMP("LDFN")'=ABMP("OLDFN"))
- Begin DoDot:2
- +25 IF $$RCID^ABMERUTL(ABMP("INS"))=99999
- IF $GET(ABMEF("BATCH#"))
- QUIT
- +26 SET ABMEF("BATCH#")=ABMEF("BATCH#")+1
- +27 IF ABMP("OBTYP")
- Begin DoDot:3
- +28 DO ^ABMEH95
- +29 SET ABMEF("LINE")=ABMREC(95)
- +30 DO WRITE
- End DoDot:3
- +31 DO ^ABMEH10
- +32 SET ABMEF("LINE")=ABMREC(10)
- +33 DO WRITE
- +34 DO ^ABMEH15
- +35 SET ABMEF("LINE")=ABMREC(15)
- +36 DO WRITE
- +37 SET ABMP("OBTYP")=ABMP("BTYP")
- +38 SET ABMP("OLDFN")=ABMP("LDFN")
- End DoDot:2
- +39 WRITE "."
- +40 KILL ABMR
- +41 DO ^ABMEH20
- +42 SET ABMEF("LINE")=ABMREC(20)
- +43 DO WRITE
- +44 KILL ABMR
- +45 DO ^ABMEH30
- +46 FOR I=1:1:3
- Begin DoDot:2
- +47 IF $DATA(ABMREC(30,I))
- Begin DoDot:3
- +48 SET ABMEF("LINE")=ABMREC(30,I)
- +49 DO WRITE
- End DoDot:3
- +50 IF $DATA(ABMREC(31,I))
- Begin DoDot:3
- +51 SET ABMEF("LINE")=ABMREC(31,I)
- +52 DO WRITE
- End DoDot:3
- +53 IF $DATA(ABMREC(32,I))
- Begin DoDot:3
- +54 SET ABMEF("LINE")=ABMREC(32,I)
- +55 DO WRITE
- End DoDot:3
- End DoDot:2
- +56 KILL ABMR
- +57 DO ^ABMEH40
- +58 SET ABMEF("LINE")=ABMREC(40)
- +59 DO WRITE
- +60 KILL ABMR
- +61 DO ^ABMEH61
- +62 KILL ABMR
- +63 DO ^ABMEH90
- +64 SET ABMEF("LINE")=ABMREC(90)
- +65 DO WRITE
- +66 SET DIE="^ABMDBILL(DUZ(2),"
- +67 SET DA=ABMP("BDFN")
- +68 SET DR=".04////B;.16////A;.17////"_ABMP("XMIT")
- +69 DO ^DIE
- End DoDot:1
- +70 KILL ABMR
- +71 DO ^ABMEH95
- +72 SET ABMEF("LINE")=ABMREC(95)
- +73 DO WRITE
- +74 KILL ABMR
- +75 DO ^ABMEH99
- +76 SET ABMEF("LINE")=ABMREC(99)
- +77 DO WRITE
- +78 DO CLOSE
- +79 WRITE !!,"Finished.",!!
- +80 KILL ABME,ABM,ABMEF,ABMREC,ABMR,ABMRV,ABMFN,ABMLF,ABMLNUM,ABMPATH
- +81 QUIT
- +82 ;
- 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