ABMEHGRV ; IHS/ASDST/DMJ - GET ANCILLARY SVCS REVENUE CODE INFO ;
;;2.6;IHS 3P BILLING SYSTEM;**6,7,11,13,21,22,23,27**;NOV 12, 2009;Build 486
;Original;DMJ;01/26/96 4:02 PM
; IHS/ASDS/DMJ - 09/06/00 - V2.4 Patch 3 (no NOIS)
;
;IHS/SD/SDR 2.5 p8 task 6 Added code for new ambulance multiple 47
;IHS/SD/SDR 2.5 p10 IM20395 Split out lines bundled by rev codes
;IHS/SD/SDR 2.5 p11 ambulance and pt stmt. Made change to getting ambulance line items. Found it wasn't
; working right when they were doing new pt stmt in patch 11.
;
;IHS/SD/SDR 2.6 CSV
;IHS/SD/SDR 2.6*6 line item control number
;IHS/SD/SDR 2.6*13 HEAT117086 removed code to put T1015 as top line; doesn't work here.
;IHS/SD/SDR 2.6*21 HEAT205579 code to put T1015 as top line in 837P file.
;IHS/SD/SDR 2.6*22 HEAT335246 Made it so if the insurer is setup to print the NDC it will do flat rate and itemized on a claim, with either the default CPT
; printing with the flat rate or the flat rate printing on the first line item.
;IHS/SD/SDR 2.6*23 HEAT247169 Added code to check subfile 43 if visit type is 997.
;IHS/SD/SDR 2.6*27 CR10326 Correction so coordinating dx will print when billing flat rate; moved line down and made it a single dot
;
START ;START HERE
K ABM,ABMRV
D P1
;D FLP
Q
;
P1 ;EP - SET UP ABMRV ARRAY
; 21 - Med/Surg
; 23 - Pharmacy
; 25 - Room and Board
; 27 - Medical Procedures
; 33 - Dental
; 35 - Radiology
; 37 - Laboratory
; 39 - Anesthesia
; 43 - Miscellaneous Services
; 45 - Supplies
; 47 - Ambulance
;
; if not flat rate .....
D FRATE^ABMDF11
;I '$D(ABMP("FLAT")) D ;abm*2.6*22 IHS/SD/SDR HEAT335246
I '$D(ABMP("FLAT"))!(($D(ABMP("FLAT")))&($P($G(^ABMNINS(DUZ(2),ABMP("INS"),0)),U,14)="Y")) D ;abm*2.6*22 IHS/SD/SDR HEAT335246
.N I
.F I=21,23,25,27,33,35,37,39,43,45,47 D
..; dont get pharmacy if RX bill status is unbillable
..I $P($G(^AUTNINS(ABMP("INS"),2)),"^",3)="U",I=23 Q
..;this will make only viewable pages in CE show on bill, not everything
..I ABMP("VTYP")=998,((I'=33)&(I'=43)) Q ;dental
..;I ABMP("VTYP")=997,(I'=23) Q ;pharmacy ;abm*2.6*23 IHS/SD/SDR HEAT247169
..I ABMP("VTYP")=997,((I'=23)&(I'=43)) Q ;pharmacy ;abm*2.6*23 IHS/SD/SDR HEAT247169
..I ABMP("VTYP")=996,(I'=37) Q ;lab
..I ABMP("VTYP")=995,(I'=35) Q ;rad
..I ABMP("CLIN")="A3",((I'=43)&(I'=47)) Q ;ambulance
..I ABMP("CLIN")'="A3",(I=47) Q
..K ABM
..D @(I_"^ABMEHGR2") ; get ancillary services revenue code info
;
;start new code abm*2.6*11 HEAT117086
;I ABMP("ITYPE")="D" D ;abm*2.6*13 HEAT135507
;start new abm*2.6*21 IHS/SD/SDR HEAT205579
I (($P($G(^AUTNINS(ABMP("INS"),0)),U)="ARBOR HEALTH PLAN")!($$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")="D"))&($D(ABMRV)) D
.S ABMIS=$O(ABMRV(0))
.S ABMJS=$O(ABMRV(ABMIS,0))
.S ABMKS=$O(ABMRV(ABMIS,ABMJS,0))
.S ABMI=0
.F S ABMI=$O(ABMRV(ABMI)) Q:'ABMI D
..S ABMJ=0
..F S ABMJ=$O(ABMRV(ABMI,ABMJ)) Q:'ABMJ D
...S ABMK=0
...F S ABMK=$O(ABMRV(ABMI,ABMJ,ABMK)) Q:'ABMK D
....I $P($G(ABMRV(ABMI,ABMJ,ABMK)),U,2)'="T1015" Q
....S ABMTMP("TMP")=$G(ABMRV(ABMIS,ABMJS,ABMKS))
....S ABMRV(ABMIS,ABMJS,ABMKS)=$G(ABMRV(ABMI,ABMJ,ABMK))
....S ABMRV(ABMI,ABMJ,ABMK)=$G(ABMTMP("TMP"))
K ABMI,ABMJ,ABMK,ABMTMP
;end new abm*2.6*21 IHS/SD/SDR HEAT205579
;end new code HEAT117086
;
I $P($G(^DIC(40.7,$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,10),0)),U,2)="A3" D
.S ABMODMOD=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,14)_$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,16)
.S I=0
.F S I=$O(ABMRV(I)) Q:'I D
..S J=""
..S J=$O(ABMRV(I,J)) Q:J="" D
...S K=0
...F S K=$O(ABMRV(I,J,K)) Q:K="" D
....I $P(ABMRV(I,J,K),U,3)="Q" S ABMQLFLG=1
.S I=0
.F S I=$O(ABMRV(I)) Q:'I D
..S J=""
..F S J=$O(ABMRV(I,J)) Q:J="" D
...S K=0
...F S K=$O(ABMRV(I,J,K)) Q:K="" D
....I $G(ABMQLFLG)=1,($P(ABMRV(I,J,K),U,3)'="QL") S $P(ABMRV(I,J,K),U,3)=""
....I $G(ABMQLFLG)'=1 S $P(ABMRV(I,J,K),U,3)=$S($P($G(ABMRV(I,J,K)),U,3)="":ABMODMOD,1:$P(ABMRV(I,J,K),U,3)_":"_ABMODMOD)
K ABMQLFLG
;
; if flat rate ....
I $D(ABMP("FLAT")) D
.I (($P($G(^ABMNINS(DUZ(2),ABMP("INS"),0)),U,14)="Y")&(+$P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),U,16)=0)) Q ;print the NDC and there's no default CPT ;abm*2.6*22 IHS/SD/SDR HEAT335246
.N I
.F I=1:1:3 S ABM(I)=$P(ABMP("FLAT"),"^",I)
.S ABMRV(1,1,1)=+ABM(2)_"^^^^"_ABM(3)_"^"_(ABM(1)*ABM(3))_"^^"_ABM(1)
.;S $P(ABMRV(1,1,1),U,12)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),2)),U,9) ;abm*2.6*6 line item control number ;abm*2.6*7 HEAT38591
.S $P(ABMRV(1,1,1),U,38)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),2)),U,9) ;abm*2.6*7 HEAT38591
.S ABMCPT=$P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),"^",16) I ABMCPT D
..S ABMCPT=$P($$CPT^ABMCVAPI(ABMCPT,ABMP("VDT")),U,2) ;CSV-c
..S $P(ABMRV(1,1,1),U,2)=ABMCPT
..;S $P(ABMRV(1,1,1),U,11)=1 ;abm*2.6*27 IHS/SD/SDR CR10326
..K ABMCDX
..Q:$G(ABMP("EXP"))'=11
..S $P(ABMRV(+ABM(2),"TOT"),U,2)=ABMCPT
.S $P(ABMRV(1,1,1),U,11)=1 ;coor dx - default to 1 ;abm*2.6*27 IHS/SD/SDR CR10326 - moved down from above to make a single dot
.S ABM(4)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),6)),U,6)
.I ABM(4),ABMP("VTYP")=111 S $P(ABMRV(1,1,1),U,7)=(ABM(4)*ABM(1))
.;start old code abm*2.6*11 HEAT105003
.;I ABMP("VTYP")=831 D
.;.K ABMRV(+ABM(2),0),ABM("831SET")
.;.N I
.;.F I=21,27,35 D @(I_"^ABMEHGR2")
.;.S I=0
.;.F S I=$O(ABMRV(I)) Q:'I D
.;..N J
.;..S J=0
.;..F S J=$O(ABMRV(I,J)) Q:'J D
.;...S K=0
.;...F S K=$O(ABMRV(I,J,K)) Q:K="" D
.;....S $P(ABMRV(I,J,K),U,6)=0
.;....S:'$G(ABM("831SET")) $P(ABMRV(I,J,K),U,6)=$P(ABMP("FLAT"),U),ABM("831SET")=1
.;end old code HEAT105003
K ABMCPT
Q
;
FLP ;FORMAT LOOP
F J=5,6,7 S ABM("TOT",J)=0
S I=0
F S I=$O(ABMRV(I)) Q:'I D
.D TOT
.F J=1:1:9 D FMT
.S ABMRV(I)=$TR(ABMRV(I),"^")
S ABMRV(9999)="0001^^^^"_ABM("TOT",5)_"^"_ABM("TOT",6)_"^"_ABM("TOT",7)
S ABMRV(9999,0)=ABMRV(9999)
S I=9999
F J=1:1:9 D FMT
S ABMRV(9999)=$TR(ABMRV(9999),"^")
K ABM
Q
;
FMT ;Format
S ABM(J)=$P(ABMRV(I),"^",J)
I J>4&(J<8) S ABM("TOT",J)=ABM("TOT",J)+ABM(J)
S ABM("FSTR")=$P("4NR^5^2^2^7NR^10NRJ2^10NRJ2^4^12","^",J)
S ABM(J)=$$FMT^ABMERUTL(ABM(J),ABM("FSTR"))
S $P(ABMRV(I),"^",J)=ABM(J)
Q
;
TOT ;TOTAL TO REVENUE CODE
S J=-1
F S J=$O(ABMRV(I,J)) Q:J="" D
.S $P(ABMRV(I),U)=I
.F K=2,3,4 S $P(ABMRV(I),"^",K)=""
.F K=5,6,7 S $P(ABMRV(I),"^",K)=$P(ABMRV(I),"^",K)+$P(ABMRV(I,J),"^",K)
Q
ABMEHGRV ; IHS/ASDST/DMJ - GET ANCILLARY SVCS REVENUE CODE INFO ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**6,7,11,13,21,22,23,27**;NOV 12, 2009;Build 486
+2 ;Original;DMJ;01/26/96 4:02 PM
+3 ; IHS/ASDS/DMJ - 09/06/00 - V2.4 Patch 3 (no NOIS)
+4 ;
+5 ;IHS/SD/SDR 2.5 p8 task 6 Added code for new ambulance multiple 47
+6 ;IHS/SD/SDR 2.5 p10 IM20395 Split out lines bundled by rev codes
+7 ;IHS/SD/SDR 2.5 p11 ambulance and pt stmt. Made change to getting ambulance line items. Found it wasn't
+8 ; working right when they were doing new pt stmt in patch 11.
+9 ;
+10 ;IHS/SD/SDR 2.6 CSV
+11 ;IHS/SD/SDR 2.6*6 line item control number
+12 ;IHS/SD/SDR 2.6*13 HEAT117086 removed code to put T1015 as top line; doesn't work here.
+13 ;IHS/SD/SDR 2.6*21 HEAT205579 code to put T1015 as top line in 837P file.
+14 ;IHS/SD/SDR 2.6*22 HEAT335246 Made it so if the insurer is setup to print the NDC it will do flat rate and itemized on a claim, with either the default CPT
+15 ; printing with the flat rate or the flat rate printing on the first line item.
+16 ;IHS/SD/SDR 2.6*23 HEAT247169 Added code to check subfile 43 if visit type is 997.
+17 ;IHS/SD/SDR 2.6*27 CR10326 Correction so coordinating dx will print when billing flat rate; moved line down and made it a single dot
+18 ;
START ;START HERE
+1 KILL ABM,ABMRV
+2 DO P1
+3 ;D FLP
+4 QUIT
+5 ;
P1 ;EP - SET UP ABMRV ARRAY
+1 ; 21 - Med/Surg
+2 ; 23 - Pharmacy
+3 ; 25 - Room and Board
+4 ; 27 - Medical Procedures
+5 ; 33 - Dental
+6 ; 35 - Radiology
+7 ; 37 - Laboratory
+8 ; 39 - Anesthesia
+9 ; 43 - Miscellaneous Services
+10 ; 45 - Supplies
+11 ; 47 - Ambulance
+12 ;
+13 ; if not flat rate .....
+14 DO FRATE^ABMDF11
+15 ;I '$D(ABMP("FLAT")) D ;abm*2.6*22 IHS/SD/SDR HEAT335246
+16 ;abm*2.6*22 IHS/SD/SDR HEAT335246
IF '$DATA(ABMP("FLAT"))!(($DATA(ABMP("FLAT")))&($PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),0)),U,14)="Y"))
Begin DoDot:1
+17 NEW I
+18 FOR I=21,23,25,27,33,35,37,39,43,45,47
Begin DoDot:2
+19 ; dont get pharmacy if RX bill status is unbillable
+20 IF $PIECE($GET(^AUTNINS(ABMP("INS"),2)),"^",3)="U"
IF I=23
QUIT
+21 ;this will make only viewable pages in CE show on bill, not everything
+22 ;dental
IF ABMP("VTYP")=998
IF ((I'=33)&(I'=43))
QUIT
+23 ;I ABMP("VTYP")=997,(I'=23) Q ;pharmacy ;abm*2.6*23 IHS/SD/SDR HEAT247169
+24 ;pharmacy ;abm*2.6*23 IHS/SD/SDR HEAT247169
IF ABMP("VTYP")=997
IF ((I'=23)&(I'=43))
QUIT
+25 ;lab
IF ABMP("VTYP")=996
IF (I'=37)
QUIT
+26 ;rad
IF ABMP("VTYP")=995
IF (I'=35)
QUIT
+27 ;ambulance
IF ABMP("CLIN")="A3"
IF ((I'=43)&(I'=47))
QUIT
+28 IF ABMP("CLIN")'="A3"
IF (I=47)
QUIT
+29 KILL ABM
+30 ; get ancillary services revenue code info
DO @(I_"^ABMEHGR2")
End DoDot:2
End DoDot:1
+31 ;
+32 ;start new code abm*2.6*11 HEAT117086
+33 ;I ABMP("ITYPE")="D" D ;abm*2.6*13 HEAT135507
+34 ;start new abm*2.6*21 IHS/SD/SDR HEAT205579
+35 IF (($PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)="ARBOR HEALTH PLAN")!($$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")="D"))&($DATA(ABMRV))
Begin DoDot:1
+36 SET ABMIS=$ORDER(ABMRV(0))
+37 SET ABMJS=$ORDER(ABMRV(ABMIS,0))
+38 SET ABMKS=$ORDER(ABMRV(ABMIS,ABMJS,0))
+39 SET ABMI=0
+40 FOR
SET ABMI=$ORDER(ABMRV(ABMI))
IF 'ABMI
QUIT
Begin DoDot:2
+41 SET ABMJ=0
+42 FOR
SET ABMJ=$ORDER(ABMRV(ABMI,ABMJ))
IF 'ABMJ
QUIT
Begin DoDot:3
+43 SET ABMK=0
+44 FOR
SET ABMK=$ORDER(ABMRV(ABMI,ABMJ,ABMK))
IF 'ABMK
QUIT
Begin DoDot:4
+45 IF $PIECE($GET(ABMRV(ABMI,ABMJ,ABMK)),U,2)'="T1015"
QUIT
+46 SET ABMTMP("TMP")=$GET(ABMRV(ABMIS,ABMJS,ABMKS))
+47 SET ABMRV(ABMIS,ABMJS,ABMKS)=$GET(ABMRV(ABMI,ABMJ,ABMK))
+48 SET ABMRV(ABMI,ABMJ,ABMK)=$GET(ABMTMP("TMP"))
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+49 KILL ABMI,ABMJ,ABMK,ABMTMP
+50 ;end new abm*2.6*21 IHS/SD/SDR HEAT205579
+51 ;end new code HEAT117086
+52 ;
+53 IF $PIECE($GET(^DIC(40.7,$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,10),0)),U,2)="A3"
Begin DoDot:1
+54 SET ABMODMOD=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,14)_$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,16)
+55 SET I=0
+56 FOR
SET I=$ORDER(ABMRV(I))
IF 'I
QUIT
Begin DoDot:2
+57 SET J=""
+58 SET J=$ORDER(ABMRV(I,J))
IF J=""
QUIT
Begin DoDot:3
+59 SET K=0
+60 FOR
SET K=$ORDER(ABMRV(I,J,K))
IF K=""
QUIT
Begin DoDot:4
+61 IF $PIECE(ABMRV(I,J,K),U,3)="Q"
SET ABMQLFLG=1
End DoDot:4
End DoDot:3
End DoDot:2
+62 SET I=0
+63 FOR
SET I=$ORDER(ABMRV(I))
IF 'I
QUIT
Begin DoDot:2
+64 SET J=""
+65 FOR
SET J=$ORDER(ABMRV(I,J))
IF J=""
QUIT
Begin DoDot:3
+66 SET K=0
+67 FOR
SET K=$ORDER(ABMRV(I,J,K))
IF K=""
QUIT
Begin DoDot:4
+68 IF $GET(ABMQLFLG)=1
IF ($PIECE(ABMRV(I,J,K),U,3)'="QL")
SET $PIECE(ABMRV(I,J,K),U,3)=""
+69 IF $GET(ABMQLFLG)'=1
SET $PIECE(ABMRV(I,J,K),U,3)=$SELECT($PIECE($GET(ABMRV(I,J,K)),U,3)="":ABMODMOD,1:$PIECE(ABMRV(I,J,K),U,3)_":"_ABMODMOD)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+70 KILL ABMQLFLG
+71 ;
+72 ; if flat rate ....
+73 IF $DATA(ABMP("FLAT"))
Begin DoDot:1
+74 ;print the NDC and there's no default CPT ;abm*2.6*22 IHS/SD/SDR HEAT335246
IF (($PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),0)),U,14)="Y")&(+$PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),U,16)=0))
QUIT
+75 NEW I
+76 FOR I=1:1:3
SET ABM(I)=$PIECE(ABMP("FLAT"),"^",I)
+77 SET ABMRV(1,1,1)=+ABM(2)_"^^^^"_ABM(3)_"^"_(ABM(1)*ABM(3))_"^^"_ABM(1)
+78 ;S $P(ABMRV(1,1,1),U,12)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),2)),U,9) ;abm*2.6*6 line item control number ;abm*2.6*7 HEAT38591
+79 ;abm*2.6*7 HEAT38591
SET $PIECE(ABMRV(1,1,1),U,38)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),2)),U,9)
+80 SET ABMCPT=$PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),"^",16)
IF ABMCPT
Begin DoDot:2
+81 ;CSV-c
SET ABMCPT=$PIECE($$CPT^ABMCVAPI(ABMCPT,ABMP("VDT")),U,2)
+82 SET $PIECE(ABMRV(1,1,1),U,2)=ABMCPT
+83 ;S $P(ABMRV(1,1,1),U,11)=1 ;abm*2.6*27 IHS/SD/SDR CR10326
+84 KILL ABMCDX
+85 IF $GET(ABMP("EXP"))'=11
QUIT
+86 SET $PIECE(ABMRV(+ABM(2),"TOT"),U,2)=ABMCPT
End DoDot:2
+87 ;coor dx - default to 1 ;abm*2.6*27 IHS/SD/SDR CR10326 - moved down from above to make a single dot
SET $PIECE(ABMRV(1,1,1),U,11)=1
+88 SET ABM(4)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),6)),U,6)
+89 IF ABM(4)
IF ABMP("VTYP")=111
SET $PIECE(ABMRV(1,1,1),U,7)=(ABM(4)*ABM(1))
+90 ;start old code abm*2.6*11 HEAT105003
+91 ;I ABMP("VTYP")=831 D
+92 ;.K ABMRV(+ABM(2),0),ABM("831SET")
+93 ;.N I
+94 ;.F I=21,27,35 D @(I_"^ABMEHGR2")
+95 ;.S I=0
+96 ;.F S I=$O(ABMRV(I)) Q:'I D
+97 ;..N J
+98 ;..S J=0
+99 ;..F S J=$O(ABMRV(I,J)) Q:'J D
+100 ;...S K=0
+101 ;...F S K=$O(ABMRV(I,J,K)) Q:K="" D
+102 ;....S $P(ABMRV(I,J,K),U,6)=0
+103 ;....S:'$G(ABM("831SET")) $P(ABMRV(I,J,K),U,6)=$P(ABMP("FLAT"),U),ABM("831SET")=1
+104 ;end old code HEAT105003
End DoDot:1
+105 KILL ABMCPT
+106 QUIT
+107 ;
FLP ;FORMAT LOOP
+1 FOR J=5,6,7
SET ABM("TOT",J)=0
+2 SET I=0
+3 FOR
SET I=$ORDER(ABMRV(I))
IF 'I
QUIT
Begin DoDot:1
+4 DO TOT
+5 FOR J=1:1:9
DO FMT
+6 SET ABMRV(I)=$TRANSLATE(ABMRV(I),"^")
End DoDot:1
+7 SET ABMRV(9999)="0001^^^^"_ABM("TOT",5)_"^"_ABM("TOT",6)_"^"_ABM("TOT",7)
+8 SET ABMRV(9999,0)=ABMRV(9999)
+9 SET I=9999
+10 FOR J=1:1:9
DO FMT
+11 SET ABMRV(9999)=$TRANSLATE(ABMRV(9999),"^")
+12 KILL ABM
+13 QUIT
+14 ;
FMT ;Format
+1 SET ABM(J)=$PIECE(ABMRV(I),"^",J)
+2 IF J>4&(J<8)
SET ABM("TOT",J)=ABM("TOT",J)+ABM(J)
+3 SET ABM("FSTR")=$PIECE("4NR^5^2^2^7NR^10NRJ2^10NRJ2^4^12","^",J)
+4 SET ABM(J)=$$FMT^ABMERUTL(ABM(J),ABM("FSTR"))
+5 SET $PIECE(ABMRV(I),"^",J)=ABM(J)
+6 QUIT
+7 ;
TOT ;TOTAL TO REVENUE CODE
+1 SET J=-1
+2 FOR
SET J=$ORDER(ABMRV(I,J))
IF J=""
QUIT
Begin DoDot:1
+3 SET $PIECE(ABMRV(I),U)=I
+4 FOR K=2,3,4
SET $PIECE(ABMRV(I),"^",K)=""
+5 FOR K=5,6,7
SET $PIECE(ABMRV(I),"^",K)=$PIECE(ABMRV(I),"^",K)+$PIECE(ABMRV(I,J),"^",K)
End DoDot:1
+6 QUIT
