ABMDE1X1 ; IHS/ASDST/DMJ - PAGE 1 - DATA CHECK CONT. ;
;;2.6;IHS 3P BILLING SYSTEM;**6,8,11**;NOV 12, 2009;Build 133
;
; IHS/ASDS/DMJ - 05/16/00 - V2.4 Patch 1 - NOIS HQW-0500-100040
; Modified Location code to check for satellite first. If no
; satellite (ABMP("LDFN")), then use parent (DUZ(2))
;
; IHS/SD/SDR - V2.5 p12 - UFMS - Added errors 227 and 228 to check for parent/satellite ASUFACs
; IHS/SD/SDR - abm*2.6*6 - Added error 235 for facility missing NPI
; *********************************************************************
;
REMPL ;EP - Entry Pont for setting X3 array Employer Info
;
; Export Var: ABMV("X3")=EMPLOYER;ADDR 1^ADDR 2^PHONE^STATUS
;
; where: EMPLOYER is the patient's employer
;
I $P(^AUPNPAT(ABMP("PDFN"),0),U,19)]"",$D(^AUTNEMPL($P(^(0),U,19),0)) D
.S ABMX("Y")=^AUTNEMPL($P(^AUPNPAT(ABMP("PDFN"),0),U,19),0)
.S ABMV("X3")=$P(ABMX("Y"),U)
E S ABME(71)="" Q
I $P(ABMX("Y"),U,2)]"",$P(ABMX("Y"),U,3)]"",$P(ABMX("Y"),U,4)]"",$P(ABMX("Y"),U,5)]""
I D
.S $P(ABMV("X3"),U,2)=$P(ABMX("Y"),U,2)
.S $P(ABMV("X3"),U,3)=$P(ABMX("Y"),U,3)_","
.I $D(^DIC(5,$P(ABMX("Y"),U,4),0)) S $P(ABMV("X3"),U,3)=$P(ABMV("X3"),U,3)_$P(^(0),U,2)_" "_$P(ABMX("Y"),U,5)
E S ABME(75)=""
S $P(ABMV("X3"),U,4)=$P(ABMX("Y"),U,6)
S ABMX("Y")=$P(^AUPNPAT(ABMP("PDFN"),0),U,21)
I ABMX("Y")="" S ABME(72)="" Q
S ABMX("Y0")=$P(^DD(9000001,.21,0),U,3)
S ABMX("Y0")=$P($P(ABMX("Y0"),ABMX("Y")_":",2),";",1)
S $P(ABMV("X3"),U,5)=ABMX("Y")_";"_ABMX("Y0")
Q
;
; *********************************************************************
LOC ;EP - Entry Pont for setting X3 array Location Info
;
; export var: ABMV(X1)=LDFN;FACILTY^ADDR 1^ADDR 2^ADDR 3^PHONE^TAX NO
;
; where: ADDR 1 - is only defined when payment is to be sent to
; another location (C/O)
; ADDR 2 - is always the street address
; ADDR 3 - is the city, state zip code
;
; Note: The address corresponds to the facility's address when the
; site is 638 or the Area Office's when it is not.
;
I ABMP("LDFN")="" Q
I '$D(^AUTTLOC(ABMP("LDFN"),0)) S ABME(108)="" Q
I '$P($G(^ABMDPARM(DUZ(2),1,2)),U,3) S ABME(7)=""
S ABMV("X1")=ABMP("LDFN")_";"
I $P($G(^ABMDPARM(ABMP("LDFN"),1,2)),"^",6)="" D
.S ABMV("X1")=ABMV("X1")_$S($P($G(^ABMDPARM(DUZ(2),1,2)),U,6)]"":$P(^(2),U,6),$D(^DIC(4,ABMP("LDFN"),0)):$P(^(0),U),1:$P(^AUTTLOC(ABMP("LDFN"),0),U,2))
I $P($G(^ABMDPARM(ABMP("LDFN"),1,2)),"^",6)'="" D
.S ABMV("X1")=ABMV("X1")_$P(^ABMDPARM(ABMP("LDFN"),1,2),"^",6)
I $D(^AUTTLOC(ABMP("LDFN"),11,0))'=1 S ABME(151)=""
S ABMX("AFFL")=""
S ABMX("I")=0
F S ABMX("I")=$O(^AUTTLOC(ABMP("LDFN"),11,ABMX("I"))) Q:'ABMX("I") D
.S ABMX("IDT")=$S($P(^AUTTLOC(ABMP("LDFN"),11,ABMX("I"),0),U,2)]"":$P(^(0),U,2),1:9999999)
.I ABMP("VDT")>$P(^AUTTLOC(ABMP("LDFN"),11,ABMX("I"),0),U)&(ABMP("VDT")<ABMX("IDT")) S ABMX("AFFL")=$P(^(0),U,3)
I ABMX("AFFL")="" D
.S ABME(151)=""
.S ABMX("AFFL")=1
;start new code abm*2.6*6 5010
I +$G(ABMP("EXP"))>20 D
.Q:(ABMP("INS"))="" ;abm*2.6*8 HEAT37612
.S ABMLNPI=$S($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,8)'="":$P(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1),U,8),$P($G(^ABMDPARM(ABMP("LDFN"),1,2)),U,12)'="":$P(^ABMDPARM(ABMP("LDFN"),1,2),U,12),1:ABMP("LDFN"))
.I $P($$NPI^XUSNPI("Organization_ID",ABMLNPI),U)<1 S ABME(235)=""
;end new code abm*2.6*6 5010
I +$P($G(^ABMDPARM(DUZ(2),1,2)),U,3) D G SITE
.S ABMX("LOC")=$P(^ABMDPARM(DUZ(2),1,2),U,3)
I ABMX("AFFL")=1,$P(^AUTTLOC(ABMP("LDFN"),0),U,4)]"",$D(^AUTTAREA($P(^(0),U,4),0)),$P(^(0),U,2)]"" S ABMX("LOC")=$O(^AUTTLOC("C",$P(^(0),U,2)_"0000","")) I ABMX("LOC")]""
E S ABMX("LOC")=ABMP("LDFN")
;
SITE ;
S ABM("SA")=$S(ABMX("LOC")=ABMP("LDFN"):1,1:0)
I 'ABM("SA") D
. S $P(ABMV("X1"),U,2)=$S($P($G(^ABMDPARM(DUZ(2),1,2)),U,6)]"":$P(^(2),U,6),1:"C/O "_$S($D(^DIC(4,ABMX("LOC"),0)):$E($P(^(0),U),1,26),1:$P(^AUTTLOC(ABMX("LOC"),0),U,2)))
;start old code abm*2.6*11 HEAT66367
;I $D(^AUTTLOC(ABMX("LOC"),0)) D
;.S ABMNOTOK=1
;.Q:'($P(^AUTTLOC(ABMX("LOC"),0),U,12)]"")
;.Q:'($P(^AUTTLOC(ABMX("LOC"),0),U,13)]"")
;.Q:'($P(^AUTTLOC(ABMX("LOC"),0),U,14)]"")
;.Q:'($P(^AUTTLOC(ABMX("LOC"),0),U,15)]"")
;.K ABMNOTOK
;.S $P(ABMV("X1"),U,3)=$P(^AUTTLOC(ABMX("LOC"),0),U,12)
;.S $P(ABMV("X1"),U,4)=$P(^AUTTLOC(ABMX("LOC"),0),U,13)_", "
;I $G(ABMNOTOK),$D(ABMX("AFFL")) D G TAX
;.S:ABM("SA") ABME(109)=""
;.S:'ABM("SA") ABME(152)=""
;.K ABMNOTOK
;S ABMX("STATE")=$P(^AUTTLOC(ABMX("LOC"),0),"^",14)
;S ABMX("STATE")=$P($G(^DIC(5,+ABMX("STATE"),0)),"^",2)
;I ABMX("STATE")'="" D
;.S $P(ABMV("X1"),U,4)=$P(ABMV("X1"),U,4)_ABMX("STATE")_" "_$P(^AUTTLOC(ABMX("LOC"),0),U,15)
;.S $P(ABMV("X1"),U,5)=$P(^AUTTLOC(ABMX("LOC"),0),U,11)
;end old code start new code HEAT66367
S ABMNOTOK=1
I $G(ABMP("INS"))="" Q ;abm*2.6*11 IHS/SD/AML 6/27/2013
I $P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,19)'="P" D
.Q:'$D(^AUTTLOC(ABMX("LOC")))
.Q:'($P(^AUTTLOC(ABMX("LOC"),0),U,12)]"")
.Q:'($P(^AUTTLOC(ABMX("LOC"),0),U,13)]"")
.Q:'($P(^AUTTLOC(ABMX("LOC"),0),U,14)]"")
.Q:'($P(^AUTTLOC(ABMX("LOC"),0),U,15)]"")
.K ABMNOTOK
.S $P(ABMV("X1"),U,3)=$P(^AUTTLOC(ABMX("LOC"),0),U,12)
.S $P(ABMV("X1"),U,4)=$P(^AUTTLOC(ABMX("LOC"),0),U,13)_", "
.S ABMX("STATE")=$P(^AUTTLOC(ABMX("LOC"),0),"^",14)
.S ABMX("ZIP")=$P(^AUTTLOC(ABMX("LOC"),0),U,15)
;
I $P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,19)="P" D
.Q:'$D(^DIC(4,ABMX("LOC")))
.Q:'($P($G(^DIC(4,ABMX("LOC"),1)),U)]"")
.Q:'($P($G(^DIC(4,ABMX("LOC"),0)),U,2)]"")
.Q:'($P($G(^DIC(4,ABMX("LOC"),1)),U,3)]"")
.Q:'($P($G(^DIC(4,ABMX("LOC"),1)),U,4)]"")
.K ABMNOTOK
.S $P(ABMV("X1"),U,3)=$P($G(^DIC(4,ABMX("LOC"),1)),U)
.S $P(ABMV("X1"),U,4)=$P($G(^DIC(4,ABMX("LOC"),1)),U,3)_", "
.S ABMX("STATE")=$P($G(^DIC(4,ABMX("LOC"),0)),"^",2)
.S ABMX("ZIP")=$P($G(^DIC(4,ABMX("LOC"),1)),U,4)
;
I $G(ABMNOTOK),$D(ABMX("AFFL")) D G TAX
.S:ABM("SA") ABME(109)=""
.S:'ABM("SA") ABME(152)=""
.K ABMNOTOK
S ABMX("STATE")=$P($G(^DIC(5,+ABMX("STATE"),0)),"^",2)
I ABMX("STATE")'="" D
.S $P(ABMV("X1"),U,4)=$P(ABMV("X1"),U,4)_ABMX("STATE")_" "_ABMX("ZIP")
.S $P(ABMV("X1"),U,5)=$P(^AUTTLOC(ABMX("LOC"),0),U,11)
;end new code HEAT66367
E D
.S:ABM("SA") ABME(109)=""
.S:'ABM("SA") ABME(152)=""
I $P($G(^ABMDPARM(DUZ(2),1,4)),U,14)=1 D ;export
.S:$G(ABMPAR)="" ABMPAR=$$FINDLOC^ABMUCUTL
.S ABMPASUF=$$ASUFAC^ABMUCUTL(ABMPAR,ABMP("VDT"))
.I ABMPASUF="" S ABME(227)=""
.I ABMX("LOC")'=ABMP("LDFN") D
..S ABMUAOF=$P($G(^ABMDPARM(ABMP("LDFN"),1,4)),U,17) ;use ASUFAC of
..S ABMSASUF=$$ASUFAC^ABMUCUTL($S(+$G(ABMUAOF)'=0:ABMUAOF,1:ABMP("LDFN")),ABMP("VDT"))
..I ABMSASUF="" S ABME(228)=""
.K ABMPASUF,ABMSASUF
;
TAX ;
S $P(ABMV("X1"),U,6)=$P(^AUTTLOC(ABMP("LDFN"),0),U,18)
I $P(ABMV("X1"),U,6)="" S ABME(6)=$P(^AUTTLOC(ABMP("LDFN"),0),U,2)
Q
ABMDE1X1 ; IHS/ASDST/DMJ - PAGE 1 - DATA CHECK CONT. ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**6,8,11**;NOV 12, 2009;Build 133
+2 ;
+3 ; IHS/ASDS/DMJ - 05/16/00 - V2.4 Patch 1 - NOIS HQW-0500-100040
+4 ; Modified Location code to check for satellite first. If no
+5 ; satellite (ABMP("LDFN")), then use parent (DUZ(2))
+6 ;
+7 ; IHS/SD/SDR - V2.5 p12 - UFMS - Added errors 227 and 228 to check for parent/satellite ASUFACs
+8 ; IHS/SD/SDR - abm*2.6*6 - Added error 235 for facility missing NPI
+9 ; *********************************************************************
+10 ;
REMPL ;EP - Entry Pont for setting X3 array Employer Info
+1 ;
+2 ; Export Var: ABMV("X3")=EMPLOYER;ADDR 1^ADDR 2^PHONE^STATUS
+3 ;
+4 ; where: EMPLOYER is the patient's employer
+5 ;
+6 IF $PIECE(^AUPNPAT(ABMP("PDFN"),0),U,19)]""
IF $DATA(^AUTNEMPL($PIECE(^(0),U,19),0))
Begin DoDot:1
+7 SET ABMX("Y")=^AUTNEMPL($PIECE(^AUPNPAT(ABMP("PDFN"),0),U,19),0)
+8 SET ABMV("X3")=$PIECE(ABMX("Y"),U)
End DoDot:1
+9 IF '$TEST
SET ABME(71)=""
QUIT
+10 IF $PIECE(ABMX("Y"),U,2)]""
IF $PIECE(ABMX("Y"),U,3)]""
IF $PIECE(ABMX("Y"),U,4)]""
IF $PIECE(ABMX("Y"),U,5)]""
+11 IF $TEST
Begin DoDot:1
+12 SET $PIECE(ABMV("X3"),U,2)=$PIECE(ABMX("Y"),U,2)
+13 SET $PIECE(ABMV("X3"),U,3)=$PIECE(ABMX("Y"),U,3)_","
+14 IF $DATA(^DIC(5,$PIECE(ABMX("Y"),U,4),0))
SET $PIECE(ABMV("X3"),U,3)=$PIECE(ABMV("X3"),U,3)_$PIECE(^(0),U,2)_" "_$PIECE(ABMX("Y"),U,5)
End DoDot:1
+15 IF '$TEST
SET ABME(75)=""
+16 SET $PIECE(ABMV("X3"),U,4)=$PIECE(ABMX("Y"),U,6)
+17 SET ABMX("Y")=$PIECE(^AUPNPAT(ABMP("PDFN"),0),U,21)
+18 IF ABMX("Y")=""
SET ABME(72)=""
QUIT
+19 SET ABMX("Y0")=$PIECE(^DD(9000001,.21,0),U,3)
+20 SET ABMX("Y0")=$PIECE($PIECE(ABMX("Y0"),ABMX("Y")_":",2),";",1)
+21 SET $PIECE(ABMV("X3"),U,5)=ABMX("Y")_";"_ABMX("Y0")
+22 QUIT
+23 ;
+24 ; *********************************************************************
LOC ;EP - Entry Pont for setting X3 array Location Info
+1 ;
+2 ; export var: ABMV(X1)=LDFN;FACILTY^ADDR 1^ADDR 2^ADDR 3^PHONE^TAX NO
+3 ;
+4 ; where: ADDR 1 - is only defined when payment is to be sent to
+5 ; another location (C/O)
+6 ; ADDR 2 - is always the street address
+7 ; ADDR 3 - is the city, state zip code
+8 ;
+9 ; Note: The address corresponds to the facility's address when the
+10 ; site is 638 or the Area Office's when it is not.
+11 ;
+12 IF ABMP("LDFN")=""
QUIT
+13 IF '$DATA(^AUTTLOC(ABMP("LDFN"),0))
SET ABME(108)=""
QUIT
+14 IF '$PIECE($GET(^ABMDPARM(DUZ(2),1,2)),U,3)
SET ABME(7)=""
+15 SET ABMV("X1")=ABMP("LDFN")_";"
+16 IF $PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,2)),"^",6)=""
Begin DoDot:1
+17 SET ABMV("X1")=ABMV("X1")_$SELECT($PIECE($GET(^ABMDPARM(DUZ(2),1,2)),U,6)]"":$PIECE(^(2),U,6),$DATA(^DIC(4,ABMP("LDFN"),0)):$PIECE(^(0),U),1:$PIECE(^AUTTLOC(ABMP("LDFN"),0),U,2))
End DoDot:1
+18 IF $PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,2)),"^",6)'=""
Begin DoDot:1
+19 SET ABMV("X1")=ABMV("X1")_$PIECE(^ABMDPARM(ABMP("LDFN"),1,2),"^",6)
End DoDot:1
+20 IF $DATA(^AUTTLOC(ABMP("LDFN"),11,0))'=1
SET ABME(151)=""
+21 SET ABMX("AFFL")=""
+22 SET ABMX("I")=0
+23 FOR
SET ABMX("I")=$ORDER(^AUTTLOC(ABMP("LDFN"),11,ABMX("I")))
IF 'ABMX("I")
QUIT
Begin DoDot:1
+24 SET ABMX("IDT")=$SELECT($PIECE(^AUTTLOC(ABMP("LDFN"),11,ABMX("I"),0),U,2)]"":$PIECE(^(0),U,2),1:9999999)
+25 IF ABMP("VDT")>$PIECE(^AUTTLOC(ABMP("LDFN"),11,ABMX("I"),0),U)&(ABMP("VDT")<ABMX("IDT"))
SET ABMX("AFFL")=$PIECE(^(0),U,3)
End DoDot:1
+26 IF ABMX("AFFL")=""
Begin DoDot:1
+27 SET ABME(151)=""
+28 SET ABMX("AFFL")=1
End DoDot:1
+29 ;start new code abm*2.6*6 5010
+30 IF +$GET(ABMP("EXP"))>20
Begin DoDot:1
+31 ;abm*2.6*8 HEAT37612
IF (ABMP("INS"))=""
QUIT
+32 SET ABMLNPI=$SELECT($PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,8)'="":...
... $PIECE(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1),U,8),$PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,2)),U,12)'="":$PIECE(^ABMDPARM(ABMP("LDFN"),1,2),U,12),1:ABMP("LDFN"))
+33 IF $PIECE($$NPI^XUSNPI("Organization_ID",ABMLNPI),U)<1
SET ABME(235)=""
End DoDot:1
+34 ;end new code abm*2.6*6 5010
+35 IF +$PIECE($GET(^ABMDPARM(DUZ(2),1,2)),U,3)
Begin DoDot:1
+36 SET ABMX("LOC")=$PIECE(^ABMDPARM(DUZ(2),1,2),U,3)
End DoDot:1
GOTO SITE
+37 IF ABMX("AFFL")=1
IF $PIECE(^AUTTLOC(ABMP("LDFN"),0),U,4)]""
IF $DATA(^AUTTAREA($PIECE(^(0),U,4),0))
IF $PIECE(^(0),U,2)]""
SET ABMX("LOC")=$ORDER(^AUTTLOC("C",$PIECE(^(0),U,2)_"0000",""))
IF ABMX("LOC")]""
+38 IF '$TEST
SET ABMX("LOC")=ABMP("LDFN")
+39 ;
SITE ;
+1 SET ABM("SA")=$SELECT(ABMX("LOC")=ABMP("LDFN"):1,1:0)
+2 IF 'ABM("SA")
Begin DoDot:1
+3 SET $PIECE(ABMV("X1"),U,2)=$SELECT($PIECE($GET(^ABMDPARM(DUZ(2),1,2)),U,6)]"":$PIECE(^(2),U,6),1:"C/O "_$SELECT($DATA(^DIC(4,ABMX("LOC"),0)):$EXTRACT($PIECE(^(0),U),1,26),1:$PIECE(^AUTTLOC(ABMX("LOC"),0),U,2)))
End DoDot:1
+4 ;start old code abm*2.6*11 HEAT66367
+5 ;I $D(^AUTTLOC(ABMX("LOC"),0)) D
+6 ;.S ABMNOTOK=1
+7 ;.Q:'($P(^AUTTLOC(ABMX("LOC"),0),U,12)]"")
+8 ;.Q:'($P(^AUTTLOC(ABMX("LOC"),0),U,13)]"")
+9 ;.Q:'($P(^AUTTLOC(ABMX("LOC"),0),U,14)]"")
+10 ;.Q:'($P(^AUTTLOC(ABMX("LOC"),0),U,15)]"")
+11 ;.K ABMNOTOK
+12 ;.S $P(ABMV("X1"),U,3)=$P(^AUTTLOC(ABMX("LOC"),0),U,12)
+13 ;.S $P(ABMV("X1"),U,4)=$P(^AUTTLOC(ABMX("LOC"),0),U,13)_", "
+14 ;I $G(ABMNOTOK),$D(ABMX("AFFL")) D G TAX
+15 ;.S:ABM("SA") ABME(109)=""
+16 ;.S:'ABM("SA") ABME(152)=""
+17 ;.K ABMNOTOK
+18 ;S ABMX("STATE")=$P(^AUTTLOC(ABMX("LOC"),0),"^",14)
+19 ;S ABMX("STATE")=$P($G(^DIC(5,+ABMX("STATE"),0)),"^",2)
+20 ;I ABMX("STATE")'="" D
+21 ;.S $P(ABMV("X1"),U,4)=$P(ABMV("X1"),U,4)_ABMX("STATE")_" "_$P(^AUTTLOC(ABMX("LOC"),0),U,15)
+22 ;.S $P(ABMV("X1"),U,5)=$P(^AUTTLOC(ABMX("LOC"),0),U,11)
+23 ;end old code start new code HEAT66367
+24 SET ABMNOTOK=1
+25 ;abm*2.6*11 IHS/SD/AML 6/27/2013
IF $GET(ABMP("INS"))=""
QUIT
+26 IF $PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,19)'="P"
Begin DoDot:1
+27 IF '$DATA(^AUTTLOC(ABMX("LOC")))
QUIT
+28 IF '($PIECE(^AUTTLOC(ABMX("LOC"),0),U,12)]"")
QUIT
+29 IF '($PIECE(^AUTTLOC(ABMX("LOC"),0),U,13)]"")
QUIT
+30 IF '($PIECE(^AUTTLOC(ABMX("LOC"),0),U,14)]"")
QUIT
+31 IF '($PIECE(^AUTTLOC(ABMX("LOC"),0),U,15)]"")
QUIT
+32 KILL ABMNOTOK
+33 SET $PIECE(ABMV("X1"),U,3)=$PIECE(^AUTTLOC(ABMX("LOC"),0),U,12)
+34 SET $PIECE(ABMV("X1"),U,4)=$PIECE(^AUTTLOC(ABMX("LOC"),0),U,13)_", "
+35 SET ABMX("STATE")=$PIECE(^AUTTLOC(ABMX("LOC"),0),"^",14)
+36 SET ABMX("ZIP")=$PIECE(^AUTTLOC(ABMX("LOC"),0),U,15)
End DoDot:1
+37 ;
+38 IF $PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,19)="P"
Begin DoDot:1
+39 IF '$DATA(^DIC(4,ABMX("LOC")))
QUIT
+40 IF '($PIECE($GET(^DIC(4,ABMX("LOC"),1)),U)]"")
QUIT
+41 IF '($PIECE($GET(^DIC(4,ABMX("LOC"),0)),U,2)]"")
QUIT
+42 IF '($PIECE($GET(^DIC(4,ABMX("LOC"),1)),U,3)]"")
QUIT
+43 IF '($PIECE($GET(^DIC(4,ABMX("LOC"),1)),U,4)]"")
QUIT
+44 KILL ABMNOTOK
+45 SET $PIECE(ABMV("X1"),U,3)=$PIECE($GET(^DIC(4,ABMX("LOC"),1)),U)
+46 SET $PIECE(ABMV("X1"),U,4)=$PIECE($GET(^DIC(4,ABMX("LOC"),1)),U,3)_", "
+47 SET ABMX("STATE")=$PIECE($GET(^DIC(4,ABMX("LOC"),0)),"^",2)
+48 SET ABMX("ZIP")=$PIECE($GET(^DIC(4,ABMX("LOC"),1)),U,4)
End DoDot:1
+49 ;
+50 IF $GET(ABMNOTOK)
IF $DATA(ABMX("AFFL"))
Begin DoDot:1
+51 IF ABM("SA")
SET ABME(109)=""
+52 IF 'ABM("SA")
SET ABME(152)=""
+53 KILL ABMNOTOK
End DoDot:1
GOTO TAX
+54 SET ABMX("STATE")=$PIECE($GET(^DIC(5,+ABMX("STATE"),0)),"^",2)
+55 IF ABMX("STATE")'=""
Begin DoDot:1
+56 SET $PIECE(ABMV("X1"),U,4)=$PIECE(ABMV("X1"),U,4)_ABMX("STATE")_" "_ABMX("ZIP")
+57 SET $PIECE(ABMV("X1"),U,5)=$PIECE(^AUTTLOC(ABMX("LOC"),0),U,11)
End DoDot:1
+58 ;end new code HEAT66367
+59 IF '$TEST
Begin DoDot:1
+60 IF ABM("SA")
SET ABME(109)=""
+61 IF 'ABM("SA")
SET ABME(152)=""
End DoDot:1
+62 ;export
IF $PIECE($GET(^ABMDPARM(DUZ(2),1,4)),U,14)=1
Begin DoDot:1
+63 IF $GET(ABMPAR)=""
SET ABMPAR=$$FINDLOC^ABMUCUTL
+64 SET ABMPASUF=$$ASUFAC^ABMUCUTL(ABMPAR,ABMP("VDT"))
+65 IF ABMPASUF=""
SET ABME(227)=""
+66 IF ABMX("LOC")'=ABMP("LDFN")
Begin DoDot:2
+67 ;use ASUFAC of
SET ABMUAOF=$PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,4)),U,17)
+68 SET ABMSASUF=$$ASUFAC^ABMUCUTL($SELECT(+$GET(ABMUAOF)'=0:ABMUAOF,1:ABMP("LDFN")),ABMP("VDT"))
+69 IF ABMSASUF=""
SET ABME(228)=""
End DoDot:2
+70 KILL ABMPASUF,ABMSASUF
End DoDot:1
+71 ;
TAX ;
+1 SET $PIECE(ABMV("X1"),U,6)=$PIECE(^AUTTLOC(ABMP("LDFN"),0),U,18)
+2 IF $PIECE(ABMV("X1"),U,6)=""
SET ABME(6)=$PIECE(^AUTTLOC(ABMP("LDFN"),0),U,2)
+3 QUIT
