ABMEF16 ; IHS/ASDST/DMJ - Electronic UB-92 Envoy/NEIC Version ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;Original;DMJ;07/08/96 4:53 PM
;
; IHS/ASDS/LSL - 05/09/00 - V2.4 Patch 1 - NOIS NCA-0500-180017
; Modified to only allow 1 to 15 characters when user enters
; EMC file name.
;
; IHS/ASDS/DMJ - 03/01/01 - V2.4 P5 - NOIS HQW-0301-100010
; Modified to accommodate new Envoy electronic format
;
; IHS/ASDS/DMJ - 04/04/01 - V2.4 P5 - NOIS HQW-0401-100014
; Modified routine to call ABMEE61, formatting of record 61-Envoy
; 6/11/01 - Also modified routine to correct errors reported
; by Envoy
;
; IHS/FCS/DRS - 09/17/01 - V2.4 P9
; Part 12a $$ENVOY and $$ENVOY92 test for format type
; used in code shared among all formats in places where
; we need to do something special just for Envoy's requirements
;
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)
I $$ENVY^ABMERUTL(ABMP("INS"),"H")="" D Q
.W !!,*7,"Envoy Payer ID NOT on File."
.W !,"Use Insurer Edit to enter Envoy Hospital Payer ID.",!
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
K ABMR,ABMRT
U 0 W !,"Writing bills to file.",!
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 ABMP("BTYP")'=ABMP("OBTYP")!(ABMP("LDFN")'=ABMP("OLDFN")) D
..S ABMEF("BATCH#")=ABMEF("BATCH#")+1
..I ABMP("OBTYP") D
...D ^ABMER95
...S ABMEF("LINE")=ABMREC(95)
...D WRITE
..I ABMEF("BATCH#")=1 D
...D ^ABMEE01
...S ABMEF("LINE")=ABMREC(1)
...D WRITE
...U 0 W !,"BATCH #",ABMR(1,170),!
..D ^ABMER10
..S ABMEF("LINE")=ABMREC(10)
..D WRITE
..S ABMP("OBTYP")=ABMP("BTYP")
..S ABMP("OLDFN")=ABMP("LDFN")
.W "."
.K ABMR
.D ^ABME520
.S ABMEF("LINE")=ABMREC(20)
.D WRITE
.K ABMR
.D ^ABMER30
.F I=1:1:3 D
..Q:'$D(ABMREC(30,I))
..S ABMEF("LINE")=ABMREC(30,I)
..D WRITE
..Q:'$D(ABMREC(31,I))
..S ABMEF("LINE")=ABMREC(31,I)
..D WRITE
.K ABMR
.D ^ABME540
.F I=1:1:3 D
..Q:'$D(ABMREC(40,I))
..S ABMEF("LINE")=ABMREC(40,I)
..D WRITE
.I $D(^ABMDBILL(DUZ(2),ABMP("BDFN"),53))!($D(^ABMDBILL(DUZ(2),ABMP("BDFN"),55))) D
..D ^ABMER41
..F I=1:1:3 D
...Q:'$D(ABMREC(41,I))
...S ABMEF("LINE")=ABMREC(41,I)
...D WRITE
.D ^ABMER46
.S ABMEF("LINE")=ABMREC(46)
.D WRITE
.; If inpatient
.I $E(ABMP("BTYP"),1,2)=11 D
..K ABMR
..D ^ABMER50
..S I=0
..F S I=$O(ABMREC(50,I)) Q:'I D
...S ABMEF("LINE")=ABMREC(50,I)
...D WRITE
..Q:+$G(ABMR(50,40))=100
..K ABMR
..D ^ABMER60
..S I=0
..F S I=$O(ABMREC(60,I)) Q:'I D
...S ABMEF("LINE")=ABMREC(60,I)
...D WRITE
.I $E(ABMP("BTYP"),1,2)'=11 D
..K ABMR
..D ^ABMEE61
..S I=0
..F S I=$O(ABMREC(61,I)) Q:'I D
...S ABMEF("LINE")=ABMREC(61,I)
...D WRITE
.K ABMR
.D ^ABME570
.S ABMEF("LINE")=ABMREC(70)
.D WRITE
.K ABMR
.D ^ABMER80
.F I=1:1:3 D
..I $D(ABMREC(80,I)) D
...S ABMEF("LINE")=ABMREC(80,I)
...D WRITE
.K ABMR
.D ^ABMER90
.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 ^ABMER95
S ABMEF("LINE")=ABMREC(95)
D WRITE
K ABMR
D ^ABMER99
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,.51"
.S DIR("A")="Enter Path"
.S DIR("B")=$P($G(^ABMDPARM(DUZ(2),1,5)),U)
.D ^DIR K DIR
.I Y["^" S POP=1 Q
.S ABMPATH=Y
.S ABMRCID=$$ENVY^ABMERUTL(ABMP("INS"),"H")
.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="U"_ABMRCID_ABMLNUM_"."_ABMJDT
.S DIR(0)="F^1:15"
.S DIR("A")="Enter File Name: "
.S 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 ;
;WRITE RECORD TO FILE
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
FMTNAME() Q $$GET1^DIQ(9002274.6,ABMP("XMIT")_",","EXPORT MODE")
ENVOY92() ; EP - Is this the Envoy UB-92 format?
; 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["UB"&(X["92")&(X["ENVOY")
ENVOY() ; EP - Is the an Envoy format?
; A call to this is needed when making changes to code used by
; other formats, such as ABMEH61
Q $$FMTNAME["ENVOY"
ABMEF16 ; IHS/ASDST/DMJ - Electronic UB-92 Envoy/NEIC Version ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;Original;DMJ;07/08/96 4:53 PM
+3 ;
+4 ; IHS/ASDS/LSL - 05/09/00 - V2.4 Patch 1 - NOIS NCA-0500-180017
+5 ; Modified to only allow 1 to 15 characters when user enters
+6 ; EMC file name.
+7 ;
+8 ; IHS/ASDS/DMJ - 03/01/01 - V2.4 P5 - NOIS HQW-0301-100010
+9 ; Modified to accommodate new Envoy electronic format
+10 ;
+11 ; IHS/ASDS/DMJ - 04/04/01 - V2.4 P5 - NOIS HQW-0401-100014
+12 ; Modified routine to call ABMEE61, formatting of record 61-Envoy
+13 ; 6/11/01 - Also modified routine to correct errors reported
+14 ; by Envoy
+15 ;
+16 ; IHS/FCS/DRS - 09/17/01 - V2.4 P9
+17 ; Part 12a $$ENVOY and $$ENVOY92 test for format type
+18 ; used in code shared among all formats in places where
+19 ; we need to do something special just for Envoy's requirements
+20 ;
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 IF $$ENVY^ABMERUTL(ABMP("INS"),"H")=""
Begin DoDot:1
+15 WRITE !!,*7,"Envoy Payer ID NOT on File."
+16 WRITE !,"Use Insurer Edit to enter Envoy Hospital Payer ID.",!
End DoDot:1
QUIT
+17 SET ABMP("FTYPE")=$PIECE($GET(^ABMDPARM(DUZ(2),1,3)),"^",4)
+18 IF ABMP("FTYPE")=""
SET ABMP("FTYPE")="H"
+19 DO OPEN
+20 IF $GET(POP)
WRITE !,"File could not be created/opened.",!
QUIT
+21 SET DIE="^ABMDTXST(DUZ(2),"
+22 SET DA=ABMP("XMIT")
+23 SET DR=".14///"_ABMFN
+24 DO ^DIE
+25 ;
LOOP ;
+1 ; LOOP THROUGH BILLS
+2 SET ABMP("L#")=0
+3 SET ABMEF("BATCH#")=0
+4 SET ABMP("MP")=1
+5 KILL ABMR,ABMRT
+6 USE 0
WRITE !,"Writing bills to file.",!
+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 ABMP("BTYP")'=ABMP("OBTYP")!(ABMP("LDFN")'=ABMP("OLDFN"))
Begin DoDot:2
+19 SET ABMEF("BATCH#")=ABMEF("BATCH#")+1
+20 IF ABMP("OBTYP")
Begin DoDot:3
+21 DO ^ABMER95
+22 SET ABMEF("LINE")=ABMREC(95)
+23 DO WRITE
End DoDot:3
+24 IF ABMEF("BATCH#")=1
Begin DoDot:3
+25 DO ^ABMEE01
+26 SET ABMEF("LINE")=ABMREC(1)
+27 DO WRITE
+28 USE 0
WRITE !,"BATCH #",ABMR(1,170),!
End DoDot:3
+29 DO ^ABMER10
+30 SET ABMEF("LINE")=ABMREC(10)
+31 DO WRITE
+32 SET ABMP("OBTYP")=ABMP("BTYP")
+33 SET ABMP("OLDFN")=ABMP("LDFN")
End DoDot:2
+34 WRITE "."
+35 KILL ABMR
+36 DO ^ABME520
+37 SET ABMEF("LINE")=ABMREC(20)
+38 DO WRITE
+39 KILL ABMR
+40 DO ^ABMER30
+41 FOR I=1:1:3
Begin DoDot:2
+42 IF '$DATA(ABMREC(30,I))
QUIT
+43 SET ABMEF("LINE")=ABMREC(30,I)
+44 DO WRITE
+45 IF '$DATA(ABMREC(31,I))
QUIT
+46 SET ABMEF("LINE")=ABMREC(31,I)
+47 DO WRITE
End DoDot:2
+48 KILL ABMR
+49 DO ^ABME540
+50 FOR I=1:1:3
Begin DoDot:2
+51 IF '$DATA(ABMREC(40,I))
QUIT
+52 SET ABMEF("LINE")=ABMREC(40,I)
+53 DO WRITE
End DoDot:2
+54 IF $DATA(^ABMDBILL(DUZ(2),ABMP("BDFN"),53))!($DATA(^ABMDBILL(DUZ(2),ABMP("BDFN"),55)))
Begin DoDot:2
+55 DO ^ABMER41
+56 FOR I=1:1:3
Begin DoDot:3
+57 IF '$DATA(ABMREC(41,I))
QUIT
+58 SET ABMEF("LINE")=ABMREC(41,I)
+59 DO WRITE
End DoDot:3
End DoDot:2
+60 DO ^ABMER46
+61 SET ABMEF("LINE")=ABMREC(46)
+62 DO WRITE
+63 ; If inpatient
+64 IF $EXTRACT(ABMP("BTYP"),1,2)=11
Begin DoDot:2
+65 KILL ABMR
+66 DO ^ABMER50
+67 SET I=0
+68 FOR
SET I=$ORDER(ABMREC(50,I))
IF 'I
QUIT
Begin DoDot:3
+69 SET ABMEF("LINE")=ABMREC(50,I)
+70 DO WRITE
End DoDot:3
+71 IF +$GET(ABMR(50,40))=100
QUIT
+72 KILL ABMR
+73 DO ^ABMER60
+74 SET I=0
+75 FOR
SET I=$ORDER(ABMREC(60,I))
IF 'I
QUIT
Begin DoDot:3
+76 SET ABMEF("LINE")=ABMREC(60,I)
+77 DO WRITE
End DoDot:3
End DoDot:2
+78 IF $EXTRACT(ABMP("BTYP"),1,2)'=11
Begin DoDot:2
+79 KILL ABMR
+80 DO ^ABMEE61
+81 SET I=0
+82 FOR
SET I=$ORDER(ABMREC(61,I))
IF 'I
QUIT
Begin DoDot:3
+83 SET ABMEF("LINE")=ABMREC(61,I)
+84 DO WRITE
End DoDot:3
End DoDot:2
+85 KILL ABMR
+86 DO ^ABME570
+87 SET ABMEF("LINE")=ABMREC(70)
+88 DO WRITE
+89 KILL ABMR
+90 DO ^ABMER80
+91 FOR I=1:1:3
Begin DoDot:2
+92 IF $DATA(ABMREC(80,I))
Begin DoDot:3
+93 SET ABMEF("LINE")=ABMREC(80,I)
+94 DO WRITE
End DoDot:3
End DoDot:2
+95 KILL ABMR
+96 DO ^ABMER90
+97 SET ABMEF("LINE")=ABMREC(90)
+98 DO WRITE
+99 SET DIE="^ABMDBILL(DUZ(2),"
+100 SET DA=ABMP("BDFN")
+101 SET DR=".04////B;.16////A;.17////"_ABMP("XMIT")
+102 DO ^DIE
End DoDot:1
+103 KILL ABMR
+104 DO ^ABMER95
+105 SET ABMEF("LINE")=ABMREC(95)
+106 DO WRITE
+107 KILL ABMR
+108 DO ^ABMER99
+109 SET ABMEF("LINE")=ABMREC(99)
+110 DO WRITE
+111 DO CLOSE
+112 WRITE !!,"Finished.",!!
+113 KILL ABME,ABM,ABMEF,ABMREC,ABMR,ABMRV,ABMFN,ABMLF,ABMLNUM,ABMPATH
+114 QUIT
+115 ;
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,.51"
+23 SET DIR("A")="Enter Path"
+24 SET DIR("B")=$PIECE($GET(^ABMDPARM(DUZ(2),1,5)),U)
+25 DO ^DIR
KILL DIR
+26 IF Y["^"
SET POP=1
QUIT
+27 SET ABMPATH=Y
+28 SET ABMRCID=$$ENVY^ABMERUTL(ABMP("INS"),"H")
+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="U"_ABMRCID_ABMLNUM_"."_ABMJDT
+38 SET DIR(0)="F^1:15"
+39 SET DIR("A")="Enter File Name: "
+40 SET DIR("B")=ABMFN
+41 DO ^DIR
KILL DIR
+42 IF Y["^"
SET POP=1
QUIT
+43 SET ABMFN=Y
+44 DO OPEN^%ZISH("EMCFILE",ABMPATH,ABMFN,"W")
+45 IF 'POP
SET ^ABMNINS("ALF",ABMP("INS"))=ABMFN
End DoDot:1
+46 IF ABMP("FTYPE")="M"
Begin DoDot:1
+47 SET ABMP("DOMAIN")=$PIECE($GET(^ABMDPARM(DUZ(2),1,3)),"^",9)
+48 IF 'ABMP("DOMAIN")
WRITE !,"MM SEND TO DOMAIN NOT DEFINED.",!
SET POP=1
QUIT
+49 SET ABMP("DOMAIN")=$PIECE(^DIC(4.2,ABMP("DOMAIN"),0),U)
+50 SET XMSUB="EMC FILE FROM "_$PIECE($GET(^AUTTLOC(DUZ(2),0)),"^",2)
+51 SET XMDUZ=DUZ
+52 DO XMZ^XMA2
+53 IF XMZ<1
SET POP=1
QUIT
+54 SET ABMFN="MAIL MSG# "_XMZ
+55 WRITE !!,"MAIL MSG# ",XMZ," CREATED.",!
End DoDot:1
+56 QUIT
+57 ;
WRITE ;
+1 ;WRITE RECORD TO FILE
+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
FMTNAME() QUIT $$GET1^DIQ(9002274.6,ABMP("XMIT")_",","EXPORT MODE")
ENVOY92() ; EP - Is this the Envoy UB-92 format?
+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["UB"&(X["92")&(X["ENVOY")
ENVOY() ; EP - Is the an Envoy format?
+1 ; A call to this is needed when making changes to code used by
+2 ; other formats, such as ABMEH61
+3 QUIT $$FMTNAME["ENVOY"
