ABMDF35B ; IHS/SD/SDR - Set HCFA1500 (02/12) Print Array PART 2 ;
;;2.6;IHS 3P BILLING SYSTEM;**13,14,21**;NOV 12, 2009;Build 379
;IHS/SD/SDR - 2.6*14 - HEAT156735 - Populated box 19 with:
; 1. VA CONTRACT NUMBER (existing code)
; 2. claim attachments from page 9G (new code)
; 3. what it did before (existing code)
;IHS/SD/SDR - 2.6*21 - HEAT187159 - Added accident state in 10B
;
; *********************************************************************
BNODES S ABM("B5")=$G(^ABMDBILL(DUZ(2),ABMP("BDFN"),5)),ABM("B6")=$G(^(6)),ABM("B7")=$G(^(7)),ABM("B8")=$G(^(8)),ABM("B9")=$G(^(9)),ABM("B10")=$G(^(10))
I $P(ABM("B5"),U,12)]"" S $P(ABMF(33),U,5)=$P(ABM("B5"),U,12)
I $P($G(^DIC(40.7,ABMP("CLN"),0)),U)="AMBULANCE" S $P(ABMF(33),U,5)=$E($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,6),1,5)
I +$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),37,0))'=0 D
.I +$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U)'=0,($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),U,23)'="") S $P(ABMF(33),U,5)=$P($G(^ABMRLABS($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),U,23),0)),U,2)
.I +$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U)=0 S $P(ABMF(33),U,5)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),U,22) ;default in-house
;no labs but CLIA wanted on form
I +$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),37,0))=0 D
.I $P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),1)),U,6)="R" D
..S $P(ABMF(33),U,3)=$P($G(^ABMRLABS($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),U,23),0)),U,2)
.I $P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),1)),U,6)="I" D
..S $P(ABMF(33),U,3)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),U,22)
;
I ((ABMP("ITYPE")="V")!($$GET1^DIQ(9999999.18,ABMP("INS"),".01","E")["VMBP"))&($P($G(^ABMDPARM(ABMP("LDFN"),1,3)),U,12)'="") S $P(ABMF(33),U,5)=$P($G(^ABMDPARM(ABMP("LDFN"),1,3)),U,12) ;
EMPL I $P(ABM("B9"),U)]"" S $P(ABMF(13),U,2)="X"
E S $P(ABMF(13),U,3)="X" G ACCD
I $P(ABM("B9"),U,3)]"" S $P(ABMF(25),U,3)=$P(ABM("B9"),U,3)
I $P(ABM("B9"),U,4)]"" S $P(ABMF(25),U,4)=$P(ABM("B9"),U,4)
;
ACCD ;
;S $P(ABMF(15),U,$S('$P(ABM("B8"),U,3):5,"12"[$P(ABM("B8"),U,3):4,1:5))="X" ;abm*2.6*13 remove box 9B
S $P(ABMF(15),U,$S('$P(ABM("B8"),U,3):2,"12"[$P(ABM("B8"),U,3):1,1:2))="X" ;abm*2.6*13 remove box 9B
;S $P(ABMF(17),U,$S("12"[$P(ABM("B8"),U,3):3,1:2))="X" ;abm*2.6*13 remove box 9C
S $P(ABMF(17),U,$S("12"[$P(ABM("B8"),U,3):2,1:1))="X" ;abm*2.6*13 remove box 9C
I $P(ABM("B8"),U,16)'="" S $P(ABMF(15),U,3)=$P($G(^DIC(5,$P(ABM("B8"),U,16),0)),U,2) ;abm*2.6*21 IHS/SD/SDR HEAT187159
FSYM ; (box 14)
;S $P(ABMF(25),U)=$P(ABM("B8"),U,6) ;abm*2.6*13 box 14
;start new code abm*2.6*13 box 14
K ABMLMP,ABMONSET
S ABMTMP=0
F S ABMTMP=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),51,ABMTMP)) Q:'ABMTMP D
.S ABMOCD=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),51,ABMTMP,0)),U)
.I $$GET1^DIQ(9002274.03,ABMOCD,".02","I")="O" D
..I $$GET1^DIQ(9002274.03,ABMOCD,".01")=10 S ABMLMP=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),51,ABMTMP,0)),U,2)
..I $$GET1^DIQ(9002274.03,ABMOCD,".01")=11 S ABMONSET=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),51,ABMTMP,0)),U,2)
I +$G(ABMLMP)'=0 D
.S $P(ABMF(25),U)=$$SDT^ABMDUTL(ABMLMP)_" 484"
I $P($G(ABMF(25)),U)="",+$G(ABMONSET)'=0 D
.S $P(ABMF(25),U)=$$SDT^ABMDUTL(ABMONSET)_" 431"
;end new code box 14
SIML ;
;S $P(ABMF(25),U,2)=$P(ABM("B8"),U,9) ;abm*2.6*13 box 15
;start new abm*2.6*13 box 15
S ABMBOX15=""
I $P(ABM("B8"),U,23)'="" S ABMBOX15="454 "_$$SDT^ABMDUTL($P(ABM("B8"),U,23)) ;Initial Treatment
I ABMBOX15="",$P(ABM("B9"),U,11)'="" S ABMBOX15="304 "_$$SDT^ABMDUTL($P(ABM("B9"),U,11)) ;Latest Visit or Consultation/Date Last Seen
I ABMBOX15="",$P(ABM("B7"),U,27)'="" S ABMBOX15="453 "_$$SDT^ABMDUTL($P(ABM("B7"),U,27)) ;Acute Manifestation of a Chronic Condition
I ABMBOX15="",$P(ABM("B8"),U,2)'="" S ABMBOX15="439 "_$$SDT^ABMDUTL($P(ABM("B8"),U,2)) ;Accident
I ABMBOX15="",$P(ABM("B9"),U,13)'="" S ABMBOX15="455 "_$$SDT^ABMDUTL($P(ABM("B9"),U,13)) ;Last X-Ray
I ABMBOX15="",$P(ABM("B7"),U,14)'="" S ABMBOX15="471 "_$$SDT^ABMDUTL($P(ABM("B7"),U,14)) ;Prescription
I ABMBOX15="",$P(ABM("B7"),U,19)'="" S ABMBOX15="090 "_$$SDT^ABMDUTL($P(ABM("B7"),U,19)) ;Assumed Care Date
I ABMBOX15="",$P(ABM("B7"),U,21)'="" S ABMBOX15="091 "_$$SDT^ABMDUTL($P(ABM("B7"),U,21)) ;Relinquished Care Date
I ABMBOX15="",$P(ABM("B7"),U,22)'="" S ABMBOX15="444 "_$$SDT^ABMDUTL($P(ABM("B7"),U,22)) ;First Visit or Consultation
S $P(ABMF(25),U,2)=ABMBOX15
;end new box 15
BLK17 ;
S $P(ABMF(27),U)=$P(ABM("B8"),U,25)_$P(ABM("B8"),U,24) ;ord/ref/sup phys qual and name
S $P(ABMF(27),U,2)=$P(ABM("B8"),U,26) ;ord/ref/sup NPI
BLK19 ;
S ABMBLK19=$$SDT^ABMDUTL($P(ABM("B9"),U,11)) ;date last seen
S ABMBLK19=ABMBLK19_" "_$P(ABM("B9"),U,24) ;supervising prov UPIN
S ABMBLK19=ABMBLK19_" "_$P(ABM("B9"),U,12) ;supervising prov
;S ABMBLK19=ABMBLK19_" "_$$SDT^ABMDUTL($P(ABM("B9"),U,13)) ;last x-ray ;abm*2.6*13
S ABMBLK19=ABMBLK19_" "_$S($P(ABM("B9"),U,14)="Y":"HOMEBOUND",1:"")
S ABMBLK19=ABMBLK19_" "_$S($P(ABM("B9"),U,15)="Y":"HOSPICE EMP. PROV",1:"")
S ABMBLK19=ABMBLK19_" "_$P(ABM("B10"),U,1)
S $P(ABMF(29),U)=$E(ABMBLK19,1,48)
;start new code abm*2.6*14 HEAT156735
I $D(^ABMDBILL(DUZ(2),ABMP("BDFN"),71,0)) D
.S ABMI=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),71,0))
.S ABMBLK19="PWK"_$$GET1^DIQ(9002274.03,$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),71,ABMI,0)),U),".01","E")_$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),71,ABMI,0)),U,2)_$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),71,ABMI,0)),U,3)
.S $P(ABMF(29),U)=$E(ABMBLK19,1,48)
;end new code HEAT156735
I ((ABMP("ITYPE")="V")!($$GET1^DIQ(9999999.18,ABMP("INS"),".01","E")["VMBP"))&($P($G(^ABMDPARM(ABMP("LDFN"),1,3)),U,13)'="") S $P(ABMF(29),U)=$P($G(^ABMDPARM(ABMP("LDFN"),1,3)),U,13) ;abm*2.6*11 VMBP RQMT_108 ;abm*2.6*12 VMBP
K ABMBLK19
LAB I '$P(ABM("B8"),U) S $P(ABMF(29),U,3)="X"
E S $P(ABMF(29),U,2)="X",$P(ABMF(29),U,4)=$P(ABM("B8"),U)
I $P(ABM("B7"),U,4)="Y" S ABMF("23")="SIGNATURE ON FILE"_U_$P(ABM("B7"),U,11)
I $P(ABM("B7"),U,5)="Y" S $P(ABMF("23"),U,3)="SIGNATURE ON FILE"
;
I $P(ABMP("B0"),U,7)'=111,($P(ABMP("B0"),U,7)'=999),($P(ABMP("B0"),U,7)'=141) G XIT
;
; Hosp Info
ADMIT I $P(ABM("B6"),U,1)]"" S $P(ABMF(27),U,3)=$P(ABM("B6"),U,1)
DISCH I $P(ABM("B6"),U,3)]"" S $P(ABMF(27),U,4)=$P(ABM("B6"),U,3)
;
XIT K ABM,ABMV,ABMX
Q
ABMDF35B ; IHS/SD/SDR - Set HCFA1500 (02/12) Print Array PART 2 ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**13,14,21**;NOV 12, 2009;Build 379
+2 ;IHS/SD/SDR - 2.6*14 - HEAT156735 - Populated box 19 with:
+3 ; 1. VA CONTRACT NUMBER (existing code)
+4 ; 2. claim attachments from page 9G (new code)
+5 ; 3. what it did before (existing code)
+6 ;IHS/SD/SDR - 2.6*21 - HEAT187159 - Added accident state in 10B
+7 ;
+8 ; *********************************************************************
BNODES SET ABM("B5")=$GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),5))
SET ABM("B6")=$GET(^(6))
SET ABM("B7")=$GET(^(7))
SET ABM("B8")=$GET(^(8))
SET ABM("B9")=$GET(^(9))
SET ABM("B10")=$GET(^(10))
+1 IF $PIECE(ABM("B5"),U,12)]""
SET $PIECE(ABMF(33),U,5)=$PIECE(ABM("B5"),U,12)
+2 IF $PIECE($GET(^DIC(40.7,ABMP("CLN"),0)),U)="AMBULANCE"
SET $PIECE(ABMF(33),U,5)=$EXTRACT($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,6),1,5)
+3 IF +$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),37,0))'=0
Begin DoDot:1
+4 IF +$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U)'=0
IF ($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),U,23)'="")
SET $PIECE(ABMF(33),U,5)=$PIECE($GET(^ABMRLABS($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),U,23),0)),U,2)
+5 ;default in-house
IF +$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U)=0
SET $PIECE(ABMF(33),U,5)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),U,22)
End DoDot:1
+6 ;no labs but CLIA wanted on form
+7 IF +$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),37,0))=0
Begin DoDot:1
+8 IF $PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),1)),U,6)="R"
Begin DoDot:2
+9 SET $PIECE(ABMF(33),U,3)=$PIECE($GET(^ABMRLABS($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),U,23),0)),U,2)
End DoDot:2
+10 IF $PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),1)),U,6)="I"
Begin DoDot:2
+11 SET $PIECE(ABMF(33),U,3)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),U,22)
End DoDot:2
End DoDot:1
+12 ;
+13 ;
IF ((ABMP("ITYPE")="V")!($$GET1^DIQ(9999999.18,ABMP("INS"),".01","E")["VMBP"))&($PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,3)),U,12)'="")
SET $PIECE(ABMF(33),U,5)=$PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,3)),U,12)
EMPL IF $PIECE(ABM("B9"),U)]""
SET $PIECE(ABMF(13),U,2)="X"
+1 IF '$TEST
SET $PIECE(ABMF(13),U,3)="X"
GOTO ACCD
+2 IF $PIECE(ABM("B9"),U,3)]""
SET $PIECE(ABMF(25),U,3)=$PIECE(ABM("B9"),U,3)
+3 IF $PIECE(ABM("B9"),U,4)]""
SET $PIECE(ABMF(25),U,4)=$PIECE(ABM("B9"),U,4)
+4 ;
ACCD ;
+1 ;S $P(ABMF(15),U,$S('$P(ABM("B8"),U,3):5,"12"[$P(ABM("B8"),U,3):4,1:5))="X" ;abm*2.6*13 remove box 9B
+2 ;abm*2.6*13 remove box 9B
SET $PIECE(ABMF(15),U,$SELECT('$PIECE(ABM("B8"),U,3):2,"12"[$PIECE(ABM("B8"),U,3):1,1:2))="X"
+3 ;S $P(ABMF(17),U,$S("12"[$P(ABM("B8"),U,3):3,1:2))="X" ;abm*2.6*13 remove box 9C
+4 ;abm*2.6*13 remove box 9C
SET $PIECE(ABMF(17),U,$SELECT("12"[$PIECE(ABM("B8"),U,3):2,1:1))="X"
+5 ;abm*2.6*21 IHS/SD/SDR HEAT187159
IF $PIECE(ABM("B8"),U,16)'=""
SET $PIECE(ABMF(15),U,3)=$PIECE($GET(^DIC(5,$PIECE(ABM("B8"),U,16),0)),U,2)
FSYM ; (box 14)
+1 ;S $P(ABMF(25),U)=$P(ABM("B8"),U,6) ;abm*2.6*13 box 14
+2 ;start new code abm*2.6*13 box 14
+3 KILL ABMLMP,ABMONSET
+4 SET ABMTMP=0
+5 FOR
SET ABMTMP=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),51,ABMTMP))
IF 'ABMTMP
QUIT
Begin DoDot:1
+6 SET ABMOCD=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),51,ABMTMP,0)),U)
+7 IF $$GET1^DIQ(9002274.03,ABMOCD,".02","I")="O"
Begin DoDot:2
+8 IF $$GET1^DIQ(9002274.03,ABMOCD,".01")=10
SET ABMLMP=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),51,ABMTMP,0)),U,2)
+9 IF $$GET1^DIQ(9002274.03,ABMOCD,".01")=11
SET ABMONSET=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),51,ABMTMP,0)),U,2)
End DoDot:2
End DoDot:1
+10 IF +$GET(ABMLMP)'=0
Begin DoDot:1
+11 SET $PIECE(ABMF(25),U)=$$SDT^ABMDUTL(ABMLMP)_" 484"
End DoDot:1
+12 IF $PIECE($GET(ABMF(25)),U)=""
IF +$GET(ABMONSET)'=0
Begin DoDot:1
+13 SET $PIECE(ABMF(25),U)=$$SDT^ABMDUTL(ABMONSET)_" 431"
End DoDot:1
+14 ;end new code box 14
SIML ;
+1 ;S $P(ABMF(25),U,2)=$P(ABM("B8"),U,9) ;abm*2.6*13 box 15
+2 ;start new abm*2.6*13 box 15
+3 SET ABMBOX15=""
+4 ;Initial Treatment
IF $PIECE(ABM("B8"),U,23)'=""
SET ABMBOX15="454 "_$$SDT^ABMDUTL($PIECE(ABM("B8"),U,23))
+5 ;Latest Visit or Consultation/Date Last Seen
IF ABMBOX15=""
IF $PIECE(ABM("B9"),U,11)'=""
SET ABMBOX15="304 "_$$SDT^ABMDUTL($PIECE(ABM("B9"),U,11))
+6 ;Acute Manifestation of a Chronic Condition
IF ABMBOX15=""
IF $PIECE(ABM("B7"),U,27)'=""
SET ABMBOX15="453 "_$$SDT^ABMDUTL($PIECE(ABM("B7"),U,27))
+7 ;Accident
IF ABMBOX15=""
IF $PIECE(ABM("B8"),U,2)'=""
SET ABMBOX15="439 "_$$SDT^ABMDUTL($PIECE(ABM("B8"),U,2))
+8 ;Last X-Ray
IF ABMBOX15=""
IF $PIECE(ABM("B9"),U,13)'=""
SET ABMBOX15="455 "_$$SDT^ABMDUTL($PIECE(ABM("B9"),U,13))
+9 ;Prescription
IF ABMBOX15=""
IF $PIECE(ABM("B7"),U,14)'=""
SET ABMBOX15="471 "_$$SDT^ABMDUTL($PIECE(ABM("B7"),U,14))
+10 ;Assumed Care Date
IF ABMBOX15=""
IF $PIECE(ABM("B7"),U,19)'=""
SET ABMBOX15="090 "_$$SDT^ABMDUTL($PIECE(ABM("B7"),U,19))
+11 ;Relinquished Care Date
IF ABMBOX15=""
IF $PIECE(ABM("B7"),U,21)'=""
SET ABMBOX15="091 "_$$SDT^ABMDUTL($PIECE(ABM("B7"),U,21))
+12 ;First Visit or Consultation
IF ABMBOX15=""
IF $PIECE(ABM("B7"),U,22)'=""
SET ABMBOX15="444 "_$$SDT^ABMDUTL($PIECE(ABM("B7"),U,22))
+13 SET $PIECE(ABMF(25),U,2)=ABMBOX15
+14 ;end new box 15
BLK17 ;
+1 ;ord/ref/sup phys qual and name
SET $PIECE(ABMF(27),U)=$PIECE(ABM("B8"),U,25)_$PIECE(ABM("B8"),U,24)
+2 ;ord/ref/sup NPI
SET $PIECE(ABMF(27),U,2)=$PIECE(ABM("B8"),U,26)
BLK19 ;
+1 ;date last seen
SET ABMBLK19=$$SDT^ABMDUTL($PIECE(ABM("B9"),U,11))
+2 ;supervising prov UPIN
SET ABMBLK19=ABMBLK19_" "_$PIECE(ABM("B9"),U,24)
+3 ;supervising prov
SET ABMBLK19=ABMBLK19_" "_$PIECE(ABM("B9"),U,12)
+4 ;S ABMBLK19=ABMBLK19_" "_$$SDT^ABMDUTL($P(ABM("B9"),U,13)) ;last x-ray ;abm*2.6*13
+5 SET ABMBLK19=ABMBLK19_" "_$SELECT($PIECE(ABM("B9"),U,14)="Y":"HOMEBOUND",1:"")
+6 SET ABMBLK19=ABMBLK19_" "_$SELECT($PIECE(ABM("B9"),U,15)="Y":"HOSPICE EMP. PROV",1:"")
+7 SET ABMBLK19=ABMBLK19_" "_$PIECE(ABM("B10"),U,1)
+8 SET $PIECE(ABMF(29),U)=$EXTRACT(ABMBLK19,1,48)
+9 ;start new code abm*2.6*14 HEAT156735
+10 IF $DATA(^ABMDBILL(DUZ(2),ABMP("BDFN"),71,0))
Begin DoDot:1
+11 SET ABMI=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),71,0))
+12 SET ABMBLK19="PWK"_$$GET1^DIQ(9002274.03,$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),71,ABMI,0)),U),".01","E")_$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),71,ABMI,0)),U,2)_$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),71,ABMI,0)),U,3)
+13 SET $PIECE(ABMF(29),U)=$EXTRACT(ABMBLK19,1,48)
End DoDot:1
+14 ;end new code HEAT156735
+15 ;abm*2.6*11 VMBP RQMT_108 ;abm*2.6*12 VMBP
IF ((ABMP("ITYPE")="V")!($$GET1^DIQ(9999999.18,ABMP("INS"),".01","E")["VMBP"))&($PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,3)),U,13)'="")
SET $PIECE(ABMF(29),U)=$PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,3)),U,13)
+16 KILL ABMBLK19
LAB IF '$PIECE(ABM("B8"),U)
SET $PIECE(ABMF(29),U,3)="X"
+1 IF '$TEST
SET $PIECE(ABMF(29),U,2)="X"
SET $PIECE(ABMF(29),U,4)=$PIECE(ABM("B8"),U)
+2 IF $PIECE(ABM("B7"),U,4)="Y"
SET ABMF("23")="SIGNATURE ON FILE"_U_$PIECE(ABM("B7"),U,11)
+3 IF $PIECE(ABM("B7"),U,5)="Y"
SET $PIECE(ABMF("23"),U,3)="SIGNATURE ON FILE"
+4 ;
+5 IF $PIECE(ABMP("B0"),U,7)'=111
IF ($PIECE(ABMP("B0"),U,7)'=999)
IF ($PIECE(ABMP("B0"),U,7)'=141)
GOTO XIT
+6 ;
+7 ; Hosp Info
ADMIT IF $PIECE(ABM("B6"),U,1)]""
SET $PIECE(ABMF(27),U,3)=$PIECE(ABM("B6"),U,1)
DISCH IF $PIECE(ABM("B6"),U,3)]""
SET $PIECE(ABMF(27),U,4)=$PIECE(ABM("B6"),U,3)
+1 ;
XIT KILL ABM,ABMV,ABMX
+1 QUIT
