ABMDF28X ; IHS/SD/SDR - PRINT UB-04 ;
;;2.6;IHS Third Party Billing;**1,3,9,10,21,27**;NOV 12, 2009;Build 486
;IHS/SD/SDR 2.5*12 IM25033 Made changes for NM Medicaid
;IHS/SD/SDR 2.5*12 IM25136 Made change for alignment of FL4
;IHS/SD/SDR 2.5*12 IM24881 Form alignment changes
;IHS/SD/SDR 2.5*13 IM25889 Fix for blank page between forms
;
;IHS/SD/SDR 2.6*1 HEAT4566 Override address for San Felipe Pueblo
;IHS/SD/SDR 2.6*1 HEAT5837 Print delayed reason code
;IHS/SD/SDR 2.6*1 HEAT7998 print patient when ITYP="N"
;IHS/SD/SDR 2.6*1 FIXPMS10028 check FL38 and what address to print
;IHS/SD/SDR 2.6*3 HEAT13774 fix <UNDEF>12+28^ABMDF28X
;IHS/SD/SDR 2.6*21 HEAT97615 Remove date from box 37B
;IHS/SD/SDR 2.6*21 HEAT169641 Added comma and middle initial if AO Control# is 61044
;IHS/SD/SDR 2.6*21 HEAT183995 Made change so delayed reason code will only print 1 digit, no leading zero.
;IHS/SD/AML 2.6*27 CR10170 Make FL14, 15 not print leading zero for Partnership HMO.
;IHS/SD/SDR 2.6*27 CR8897 Stopped box 12 from printing if Medi-Cal and visit type 142.
;***************
;
K ABM
S ABMP("LM")=$P(^ABMDEXP(28,0),"^",2) ; Left margin of form
; FOLLOWING LINE TAGS CORRESPOND TO LINE NUMBERS
;
1 ; EP
; Provider name -form locator #1-line 1
W !
S ABMP("NOFMT")=1 ;format flag (1 = no special formatting)
D 120^ABMER10 ;Provider name
I DUZ(2)=1581,(ABMP("VTYP")=998) S ABMR(10,120)="SAN FELIPE HS"
S ABMDE=$P(^DIC(4,ABMP("LDFN"),0),U)_"^^25" ;data ^ tab ^ format
D WRT^ABMDF28W ;write data in specified format
S ABMDE=ABMR(10,120)_"^25^25" ;Pay-To Name -- form locator #2-line 1
I $$RCID^ABMERUTL(ABMP("INS"))=61044 S ABMDE=""
D WRT^ABMDF28W ;write data in specified format
D 30^ABMER20 ;Patient control number -- form locator #3a
S ABMDE=ABMR(20,30)_"^53^24"
D WRT^ABMDF28W
;
2 ;
;Provider address, Patient control number, Bill type
W !
D 130^ABMER10 ;Provider address -- form locator #1-line 2
I DUZ(2)=1581,(ABMP("VTYP")=998) S ABMR(10,130)="PO BOX 4339"
I $D(^DIC(4,ABMP("LDFN"),1)) D
.S ABMVLOC=^DIC(4,ABMP("LDFN"),1)
S ABMDE=$P($G(ABMVLOC),U)_"^^25"
D WRT^ABMDF28W
D 130^ABMER10 ;Pay-To Address -- form locator #2-line 2
S ABMDE=ABMR(10,130)_"^25^25"
I $$RCID^ABMERUTL(ABMP("INS"))=61044 S ABMDE=""
I DUZ(2)=1581,(ABMP("VTYP")=998) S ABMDE="PO BOX 4342^25^25" ;abm*2.6*1 HEAT4566
D WRT^ABMDF28W
S ABMP("HRN")=$P($G(^AUPNPAT(+ABMP("PDFN"),41,+ABMP("LDFN"),0)),U,2)
S:ABMP("HRN")="" ABMP("HRN")=$P($G(^AUPNPAT(+ABMP("PDFN"),41,DUZ(2),0)),U,2)
S ABMDE=$G(ABMP("HRN"))_"^53^24" ;Patient HRN - form locator #3b
D WRT^ABMDF28W
S ABMDE=ABMP("BTYP")_"^77^4" ;Bill type -- form locator #4
D WRT^ABMDF28W
;
3 ;
; Provider city, state, zip -- form locator #1-line 3
W !
D 140^ABMER10 ;Provider city
D 150^ABMER10 ;Provider state
D 160^ABMER10 ;Provider zip
I $L(ABMR(10,160))=9 D
.S ABMR(10,160)=$E(ABMR(10,160),1,5)_"-"_$E(ABMR(10,160),6,9)
.Q
I $D(^DIC(4,ABMP("LDFN"),1)) D
.S ABMVLOC=$G(^DIC(4,ABMP("LDFN"),1))
.S ABMLCTY=$P(ABMVLOC,U,3)
.S ABMLST=$P(^DIC(5,$P(^DIC(4,ABMP("LDFN"),0),U,2),0),U,2)
.S ABMLZIP=$P(ABMVLOC,U,4)
.S ABMDE=ABMLCTY_", "_ABMLST_" "_ABMLZIP_"^^25"
I $$RCID^ABMERUTL(ABMP("INS"))=61044 S ABMDE=$TR(ABMDE,",-")
I DUZ(2)=1581,(ABMP("VTYP")=998) S ABMDE="SAN FELIPE, NM 87001^^25"
D WRT^ABMDF28W
; Pay-To city, state, zip - form locator #2-line 3
I $L(ABMR(10,160))=9 D
.S ABMR(10,160)=$E(ABMR(10,160),1,5)_"-"_$E(ABMR(10,160),6,9)
.Q
S ABMDE=$E(ABMR(10,140),1,12)_", "_ABMR(10,150)_" "_ABMR(10,160)_"^25^25"
I $$RCID^ABMERUTL(ABMP("INS"))=61044 S ABMDE=""
I DUZ(2)=1581,(ABMP("VTYP")=998) S ABMDE="SAN FELIPE PUEBLO, NM 87001^25^27" ;abm*2.6*1 HEAT4566
D WRT^ABMDF28W
;
4 ;
W !
D 110^ABMER10 ;Provider phone form locator #1-line 4
D 40^ABMER10 ;Fed. tax number form locator #5
D 190^ABMER20 ;Stmt covers period from form locator #6
D 200^ABMER20 ;Stmt covers period to form locator #6
D 200^ABMER30 ;Covered days form locator #7-old
D 210^ABMER30 ;Non-covered days form locator #8-old
D 220^ABMER30 ;Co-insured days form locator #9-old
D 230^ABMER30 ;Lifetime reserve days form locator #10-old
S ABMDE=ABMR(10,110)_"^^25"
D WRT^ABMDF28W
I DUZ(2)=1581,(ABMP("VTYP")=998) S ABMR(10,40)=850210848
S ABMDE=$TR(ABMR(10,40),"-")_"^50^10" ;#5
D WRT^ABMDF28W
S ABMDE=ABMR(20,190)_"^60^6" ;#6
D WRT^ABMDF28W
S ABMDE=ABMR(20,200)_"^67^6" ;#6
D WRT^ABMDF28W
S ABMP("CDAYS")=$G(ABMR(30,200))
;
6 ;
; Patient's name and mailing address
W !
K ABMP("PNAME")
N I
F I=40:10:60 D ;Patient name -form locator #9
.D @(I_"^ABMER20A")
N I
F I=120:10:160 D ;Patient mailing address -form locator #9
.D @(I_"^ABMER20")
S ABMDE=ABMR(20,120)_$S(ABMR(20,130)]"":" "_ABMR(20,130),1:"")_"^41^40" ;patient str address #9a
D WRT^ABMDF28W
W !
S ABMP("PNAME")=ABMR(20,40)_", "_ABMR(20,50)_" "_ABMR(20,60)
I ($$RCID^ABMERUTL(ABMP("INS"))[61044)&(ABMR(20,60)'="") S ABMP("PNAME")=ABMR(20,40)_", "_ABMR(20,50)_", "_ABMR(20,60) ;abm*2.6*21 IHS/SD/SDR HEAT169641
S ABMDE=ABMP("PNAME")_"^2^29" ;#8b
D WRT^ABMDF28W
S ABMDE=ABMR(20,140)_"^31^30" ;patient city #9b
D WRT^ABMDF28W
S ABMDE=ABMR(20,150)_"^64^2" ;patient state #9c
D WRT^ABMDF28W
S ABMDE=ABMR(20,160)_"^68^9" ;patient zip #9d
D WRT^ABMDF28W
S ABMP("NOFMT")=0
8 ;
W !!
K ABMR
N I
F I=70:10:110 D
.D @(I_"^ABMER20A")
N I
F I=170,180,210,220,250 D
.D @(I_"^ABMER20")
N I
F I=40:10:130,210 D
.D @(I_"^ABMER41A")
S ABMDE=ABMR(20,80)_"^^8" ;Patient Birthdate
D WRT^ABMDF28W ; form locator #10
S ABMDE=ABMR(20,70)_"^10^1" ;Patient sex code
D WRT^ABMDF28W ; form locator #11
S:ABMR(20,170) ABMDE=ABMR(20,170)_"^12^6" ;Admission date
;D WRT^ABMDF28W ; form locator #12 ;abm*2.6*27 IHS/SD/SDR CR8897
I '($$RCID^ABMERUTL(ABMP("INS"))["61044"&(ABMP("VTYP")=142)) D WRT^ABMDF28W ; form locator #12 ;abm*2.6*27 IHS/SD/SDR CR8897
S:ABMR(20,180) ABMDE=ABMR(20,180)_"^18^3" ;Admission hour
D WRT^ABMDF28W ; form locator #13
I +$G(ABMR(20,100))'=0 S ABMR(20,100)="0"_ABMR(20,100)
S ABMDE=(ABMR(20,100))_"^21^3" ;Type of admission
I ($P($G(^AUTNINS(ABMP("INS"),0)),U)="NEW MEXICO MEDICAID")!($P($G(^AUTNINS(ABMP("INS"),0)),U)="MEDICAID EXEMPT") S ABMDE=+(ABMR(20,100))_"^21^3"
I (($$RCID^ABMERUTL(ABMP("INS"))["61044")&($P($G(^AUTNINS(ABMP("INS"),0)),U)'["O/P MEDI-CAL")) S ABMDE=+(ABMR(20,100))_"^21^3" ;abm*2.6*27 IHS/SD/AML CR10170
D WRT^ABMDF28W ; form locator #14
I +$G(ABMR(20,110))'=0 S ABMR(20,110)="0"_ABMR(20,110)
S ABMDE=(ABMR(20,110))_"^24^3" ;Source of admission
;I ($P($G(^AUTNINS(ABMP("INS"),0)),U)="NEW MEXICO MEDICAID")!($P($G(^AUTNINS(ABMP("INS"),0)),U)="MEDICAID EXEMPT") S ABMDE=+(ABMR(20,110))_"24^3" ;abm*2.6*9 HEAT53204
I ($P($G(^AUTNINS(ABMP("INS"),0)),U)="NEW MEXICO MEDICAID")!($P($G(^AUTNINS(ABMP("INS"),0)),U)="MEDICAID EXEMPT") S ABMDE=+(ABMR(20,110))_"^24^3" ;abm*2.6*9 HEAT53204
I (($$RCID^ABMERUTL(ABMP("INS"))["61044")&($P($G(^AUTNINS(ABMP("INS"),0)),U)'["O/P MEDI-CAL")) S ABMDE=+(ABMR(20,110))_"^24^3" ;abm*2.6*27 IHS/SD/AML CR10170
I $P($G(^AUTNINS(ABMP("INS"),0)),U)="ARIZONA MEDICAID",(ABMP("VTYP")=998) S ABMDE="^^24^3"
D WRT^ABMDF28W ; form locator #15
S:ABMR(20,220) ABMDE=ABMR(20,220)_"^27^3" ;Discharge hour
D WRT^ABMDF28W ; form locator #16
S:ABMR(20,210) ABMDE=ABMR(20,210)_"^30^3" ;Pat discharge status
D WRT^ABMDF28W ; form locator #17
;
S ABMDE=ABMR(41,40)_"^33^3" ;Condition code 1
D WRT^ABMDF28W ;form locator #18
S ABMDE=ABMR(41,50)_"^37^3" ;Condition code 2
D WRT^ABMDF28W ;form locator #19
S ABMDE=ABMR(41,60)_"^40^3" ;Condition code 3
D WRT^ABMDF28W ;form locator #20
S ABMDE=ABMR(41,70)_"^43^3" ;Condition code 4
D WRT^ABMDF28W ;form locator #21
S ABMDE=ABMR(41,80)_"^46^3" ;Condition code 5
D WRT^ABMDF28W ;form locator #22
S ABMDE=ABMR(41,90)_"^49^3" ;Condition code 6
D WRT^ABMDF28W ;form locator #23
S ABMDE=ABMR(41,100)_"^52^3" ;Condition code 7
D WRT^ABMDF28W ;form locator #24
S ABMDE=$G(ABMR(41,110))_"^55^3" ;Condition code 8
D WRT^ABMDF28W ;form locator #25
S ABMDE=$G(ABMR(41,120))_"^58^3" ;Condition code 9
D WRT^ABMDF28W ;form locator #26
S ABMDE=$G(ABMR(41,130))_"^61^3" ;Condition code 10
D WRT^ABMDF28W ;form locator #27
S ABMDE=$G(ABMR(41,210))_"^64^3" ;Condition code 11
D WRT^ABMDF28W ;form locator #28
;
S ABMDE=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U,16) ;accident state
I ABMDE S ABMDE=$P($G(^DIC(5,ABMDE,0)),U,2)_"^69^2" D WRT^ABMDF28W ;form locator #29
;
10 ;
W !!
K ABMR
N I
F I=80:10:150 D
.D @(I_"^ABMER40A")
N I
F I=280:10:300,350:10:400 D
.D @(I_"^ABMER40")
;
F I=160,170 D
.D @(I_"^ABMER40A")
N I
F I=180:10:230,310:10:330 D
.D @(I_"^ABMER40")
S ABMDE=ABMR(40,80)_"^^2" ; Occurrence code 1
D WRT^ABMDF28W ;form locator #31a
S ABMDE=ABMR(40,90)_"^3^6" ; Occurrence date 1
D WRT^ABMDF28W ;form locator #31a
;
S ABMDE=ABMR(40,100)_"^10^2" ; Occurrence code 2
D WRT^ABMDF28W ; form locator #32a
S ABMDE=ABMR(40,110)_"^13^6" ; Occurrence date 2
D WRT^ABMDF28W ; form locator #32a
;
S ABMDE=ABMR(40,120)_"^20^2" ; Occurrence code 3
D WRT^ABMDF28W ; form locator #33a
S ABMDE=ABMR(40,130)_"^23^6" ;Occurrence date 3
D WRT^ABMDF28W ; form locator #33a
;
S ABMDE=ABMR(40,140)_"^30^2" ; Occurrence code 4
D WRT^ABMDF28W ; form locator #34a
S ABMDE=ABMR(40,150)_"^33^6" ; Occurrence date 4
D WRT^ABMDF28W ; form locator #34a
;
S ABMDE=ABMR(40,280)_"^40^2" ; Occur. Span code 1
D WRT^ABMDF28W ; form locator #35a
S ABMDE=ABMR(40,290)_"^43^6" ; Occur. Span from date 1
D WRT^ABMDF28W ; form locator #35a
S ABMDE=ABMR(40,300)_"^50^6" ; Occur. Span thru date 1
D WRT^ABMDF28W ; form locator #35a
;
S ABMDE=ABMR(40,310)_"^57^2" ; Occur. Span code 1
D WRT^ABMDF28W ; form locator #36a
S ABMDE=ABMR(40,320)_"^60^6" ; Occur. Span from date 1
D WRT^ABMDF28W ; form locator #36a
S ABMDE=ABMR(40,330)_"^67^6" ; Occur. Span thru date 1
D WRT^ABMDF28W ; form locator #36a
;start new abm*2.6*1 HEAT5837
S ABMDE=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),U,16) ;delayed reason code
;I ABMDE S ABMDE=$P($G(^ABMDCODE(ABMDE,0)),U)_"^74^7" D WRT^ABMDF28W ;form locator #37a ;abm*2.6*21 IHS/SD/SDR HEAT183995
I ABMDE S ABMDE=+$P($G(^ABMDCODE(ABMDE,0)),U)_"^74^7" D WRT^ABMDF28W ;form locator #37a ;abm*2.6*21 IHS/SD/SDR HEAT183995
;end new HEAT5837
11 ;
W !
N I
S ABMDE=ABMR(40,160)_"^^2" ;Occurrence code 5
D WRT^ABMDF28W ;form locator #31b
S ABMDE=ABMR(40,170)_"^3^6" ;Occurrence date 5
D WRT^ABMDF28W ;form locator #31b
;
S ABMDE=ABMR(40,180)_"^10^2" ;Occurrence code 6
D WRT^ABMDF28W ;form locator #32b
S ABMDE=ABMR(40,190)_"^13^6" ;Occurrence date 6
D WRT^ABMDF28W ;form locator #32b
;
S ABMDE=ABMR(40,200)_"^20^2" ;Occurrence code 7
D WRT^ABMDF28W ;form locator #33b
S ABMDE=ABMR(40,210)_"^23^6" ;Occurrence date 7
D WRT^ABMDF28W ;form locator #33b
;
S ABMDE=ABMR(40,220)_"^30^2" ;Occurrence code 8
D WRT^ABMDF28W ;form locator #34b
S ABMDE=ABMR(40,230)_"^33^6" ;Occurrence date 8
D WRT^ABMDF28W ;form locator #34b
;
S ABMDE=ABMR(40,350)_"^40^2" ;Occur. Span code 3
D WRT^ABMDF28W ;form locator #35b
S ABMDE=ABMR(40,360)_"^43^6" ;Occur. Span from date 3
D WRT^ABMDF28W ;form locator #35b
S ABMDE=ABMR(40,370)_"^50^6" ;Occur. Span thru date 3
D WRT^ABMDF28W ;form locator #35b
;
S ABMDE=ABMR(40,380)_"^57^2" ;Occur. Span code 4
D WRT^ABMDF28W ;form locator #36b
S ABMDE=ABMR(40,390)_"^60^6" ;Occur. Span from date 4
D WRT^ABMDF28W ;form locator #36b
S ABMDE=ABMR(40,400)_"^67^6" ;Occur. Span thru date 4
D WRT^ABMDF28W ;form locator #36b
;
;start old abm*2.6*21 IHS/SD/SDR HEAT97615
;S ABMDE=$E($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),4)),U,9),1,22)
;S:ABMDE'="" ABMDE=ABMDE_"^58^22"
;D WRT^ABMDF28W
;end old abm*2.6*21 IHS/SD/SDR HEAT97615
;
12 ;
; If private insurance and relationship of policy holder to patient
; is not self, write name of policy holder
W !
;S ABM38FLG=$P($G(^ABMDPARM(DUZ(2),1,2)),U,10) ;abm*2.6*1 FIXPMS10028
S ABM38FLG="" ;abm*2.6*1 FIXPMS10028
S ABM38FLG=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,15) ;abm*2.6*1 FIXPMS10028
S:ABM38FLG="" ABM38FLG=$P($G(^ABMDPARM(DUZ(2),1,2)),U,10) ;abm*2.6*1 FIXPMS10028
I ABM38FLG["P" D
.;I ABMP("ITYPE")="P" D ;abm*2.6*1 FIXPMS10028
.I "^P^H^F^M^"[("^"_ABMP("ITYPE")_"^") D ;abm*2.6*1 FIXPMS10028
..;
..N I
..S I=0
..F S I=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,I)) Q:'I D ;insurer
...; insurer status = initiated
...I $P(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,I,0),"^",3)="I" D
....S ABME("INS")=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,I,0),U)
....S ABME("INSIEN")=I
..Q:'$G(ABME("INSIEN"))
..D PRVT^ABMERINS
..S ABMDE=$G(ABM(9000003.1,+$G(ABME("PH")),2,"E"))_"^^40" ;card name-policy holder
..S:($P(ABMDE,U)="") $P(ABMDE,U)=$G(ABM(9000003.1,+$G(ABME("PH")),.01,"E"))_"^^40" ;name-policy holder
..D WRT^ABMDF28W ;form locator 38
..Q
.;start new abm*2.6*1 FIXPMS10028
.;MCR
.I "^R^MD^MH^"[("^"_ABMP("ITYPE")_"^") D
..D ISET^ABMERUTL ;abm*2.6*3 HEAT13774
..S IENS=$P($G(ABMP(("INS"),ABME("INS#"))),U,3)_","_ABMP("PDFN")_","
..S ABMDE=$$GET1^DIQ(9000003.11,IENS,".05","E")_"^^40" ;MCR name
..D WRT^ABMDF28W ;form locator 38
.;MCD
.I "^D^K^"[("^"_ABMP("ITYPE")_"^") D
..S ABMDE=$$GET1^DIQ(9000004,+$G(ABMCDNUM),2101,"E")_"^^40" ;MCD name
..D WRT^ABMDF28W ;form locator 38
.;
.I ABMP("ITYPE")="N" D Q
..S ABMDE=$G(ABMP("PNAME"))_"^^40" ;patient name
..D WRT^ABMDF28W ;form locator 38
.;end new FIXPMS10028
;
I ABM38FLG["I" D
.;start new code abm*2.6*1 HEAT7998
.I ABMP("ITYPE")="N" D Q
..S ABMDE=$G(ABMP("PNAME"))_"^^40" ;patient name
..D WRT^ABMDF28W ;form locator 38
.;end new code HEAT7998
.S (ABMINMF,ABMISTRF)=""
.; billing office
.I $P($G(^AUTNINS(ABMP("INS"),1)),U)'="" D
..S ABMINM=$P(^AUTNINS(ABMP("INS"),1),U)
..S ABMINMF=1
.E S ABMINM=$P($G(^AUTNINS(ABMP("INS"),0)),U)
.; street address
.I $G(ABMINMF)=1,$P($G(^AUTNINS(ABMP("INS"),1)),U,2)'="" D
..S ABMISTR=$P(^AUTNINS(ABMP("INS"),1),U,2)
..S ABMISTRF=1
.E S ABMISTR=$P($G(^AUTNINS(ABMP("INS"),0)),U,2)
.;
.I ABMINMF=1,ABMISTRF=1 S ABMI=1
.E S ABMI=0
.S ABMICTY=$P($G(^AUTNINS(ABMP("INS"),ABMI)),U,3)
.S ABMIST=$P($G(^AUTNINS(ABMP("INS"),ABMI)),U,4)
.S ABMIZIP=$P($G(^AUTNINS(ABMP("INS"),ABMI)),U,5)
.S ABMDE=ABMINM_"^^40"
.D WRT^ABMDF28W ;form locator #38 line1
;
I ABM38FLG["B" ;if B it shouldn't do anything
I $G(ABMORE)'="" D
.D 13^ABMDF28Y
Q:$G(ABMORE)
;
OTHER ;DO OTHER ROUTINES & QUIT
D ^ABMDF28Y,^ABMDF28Z
W $$EN^ABMVDF("IOF")
K ABMR,ABMREC,ABM,ABME
K ABMINM,ABMISTR,ABMICTY,ABMIST,ABMIZIP
Q
;
TEST ;
; EP;Test forms allignment
D TEST^ABMDF28W
Q
ABMDF28X ; IHS/SD/SDR - PRINT UB-04 ;
+1 ;;2.6;IHS Third Party Billing;**1,3,9,10,21,27**;NOV 12, 2009;Build 486
+2 ;IHS/SD/SDR 2.5*12 IM25033 Made changes for NM Medicaid
+3 ;IHS/SD/SDR 2.5*12 IM25136 Made change for alignment of FL4
+4 ;IHS/SD/SDR 2.5*12 IM24881 Form alignment changes
+5 ;IHS/SD/SDR 2.5*13 IM25889 Fix for blank page between forms
+6 ;
+7 ;IHS/SD/SDR 2.6*1 HEAT4566 Override address for San Felipe Pueblo
+8 ;IHS/SD/SDR 2.6*1 HEAT5837 Print delayed reason code
+9 ;IHS/SD/SDR 2.6*1 HEAT7998 print patient when ITYP="N"
+10 ;IHS/SD/SDR 2.6*1 FIXPMS10028 check FL38 and what address to print
+11 ;IHS/SD/SDR 2.6*3 HEAT13774 fix <UNDEF>12+28^ABMDF28X
+12 ;IHS/SD/SDR 2.6*21 HEAT97615 Remove date from box 37B
+13 ;IHS/SD/SDR 2.6*21 HEAT169641 Added comma and middle initial if AO Control# is 61044
+14 ;IHS/SD/SDR 2.6*21 HEAT183995 Made change so delayed reason code will only print 1 digit, no leading zero.
+15 ;IHS/SD/AML 2.6*27 CR10170 Make FL14, 15 not print leading zero for Partnership HMO.
+16 ;IHS/SD/SDR 2.6*27 CR8897 Stopped box 12 from printing if Medi-Cal and visit type 142.
+17 ;***************
+18 ;
+19 KILL ABM
+20 ; Left margin of form
SET ABMP("LM")=$PIECE(^ABMDEXP(28,0),"^",2)
+21 ; FOLLOWING LINE TAGS CORRESPOND TO LINE NUMBERS
+22 ;
1 ; EP
+1 ; Provider name -form locator #1-line 1
+2 WRITE !
+3 ;format flag (1 = no special formatting)
SET ABMP("NOFMT")=1
+4 ;Provider name
DO 120^ABMER10
+5 IF DUZ(2)=1581
IF (ABMP("VTYP")=998)
SET ABMR(10,120)="SAN FELIPE HS"
+6 ;data ^ tab ^ format
SET ABMDE=$PIECE(^DIC(4,ABMP("LDFN"),0),U)_"^^25"
+7 ;write data in specified format
DO WRT^ABMDF28W
+8 ;Pay-To Name -- form locator #2-line 1
SET ABMDE=ABMR(10,120)_"^25^25"
+9 IF $$RCID^ABMERUTL(ABMP("INS"))=61044
SET ABMDE=""
+10 ;write data in specified format
DO WRT^ABMDF28W
+11 ;Patient control number -- form locator #3a
DO 30^ABMER20
+12 SET ABMDE=ABMR(20,30)_"^53^24"
+13 DO WRT^ABMDF28W
+14 ;
2 ;
+1 ;Provider address, Patient control number, Bill type
+2 WRITE !
+3 ;Provider address -- form locator #1-line 2
DO 130^ABMER10
+4 IF DUZ(2)=1581
IF (ABMP("VTYP")=998)
SET ABMR(10,130)="PO BOX 4339"
+5 IF $DATA(^DIC(4,ABMP("LDFN"),1))
Begin DoDot:1
+6 SET ABMVLOC=^DIC(4,ABMP("LDFN"),1)
End DoDot:1
+7 SET ABMDE=$PIECE($GET(ABMVLOC),U)_"^^25"
+8 DO WRT^ABMDF28W
+9 ;Pay-To Address -- form locator #2-line 2
DO 130^ABMER10
+10 SET ABMDE=ABMR(10,130)_"^25^25"
+11 IF $$RCID^ABMERUTL(ABMP("INS"))=61044
SET ABMDE=""
+12 ;abm*2.6*1 HEAT4566
IF DUZ(2)=1581
IF (ABMP("VTYP")=998)
SET ABMDE="PO BOX 4342^25^25"
+13 DO WRT^ABMDF28W
+14 SET ABMP("HRN")=$PIECE($GET(^AUPNPAT(+ABMP("PDFN"),41,+ABMP("LDFN"),0)),U,2)
+15 IF ABMP("HRN")=""
SET ABMP("HRN")=$PIECE($GET(^AUPNPAT(+ABMP("PDFN"),41,DUZ(2),0)),U,2)
+16 ;Patient HRN - form locator #3b
SET ABMDE=$GET(ABMP("HRN"))_"^53^24"
+17 DO WRT^ABMDF28W
+18 ;Bill type -- form locator #4
SET ABMDE=ABMP("BTYP")_"^77^4"
+19 DO WRT^ABMDF28W
+20 ;
3 ;
+1 ; Provider city, state, zip -- form locator #1-line 3
+2 WRITE !
+3 ;Provider city
DO 140^ABMER10
+4 ;Provider state
DO 150^ABMER10
+5 ;Provider zip
DO 160^ABMER10
+6 IF $LENGTH(ABMR(10,160))=9
Begin DoDot:1
+7 SET ABMR(10,160)=$EXTRACT(ABMR(10,160),1,5)_"-"_$EXTRACT(ABMR(10,160),6,9)
+8 QUIT
End DoDot:1
+9 IF $DATA(^DIC(4,ABMP("LDFN"),1))
Begin DoDot:1
+10 SET ABMVLOC=$GET(^DIC(4,ABMP("LDFN"),1))
+11 SET ABMLCTY=$PIECE(ABMVLOC,U,3)
+12 SET ABMLST=$PIECE(^DIC(5,$PIECE(^DIC(4,ABMP("LDFN"),0),U,2),0),U,2)
+13 SET ABMLZIP=$PIECE(ABMVLOC,U,4)
+14 SET ABMDE=ABMLCTY_", "_ABMLST_" "_ABMLZIP_"^^25"
End DoDot:1
+15 IF $$RCID^ABMERUTL(ABMP("INS"))=61044
SET ABMDE=$TRANSLATE(ABMDE,",-")
+16 IF DUZ(2)=1581
IF (ABMP("VTYP")=998)
SET ABMDE="SAN FELIPE, NM 87001^^25"
+17 DO WRT^ABMDF28W
+18 ; Pay-To city, state, zip - form locator #2-line 3
+19 IF $LENGTH(ABMR(10,160))=9
Begin DoDot:1
+20 SET ABMR(10,160)=$EXTRACT(ABMR(10,160),1,5)_"-"_$EXTRACT(ABMR(10,160),6,9)
+21 QUIT
End DoDot:1
+22 SET ABMDE=$EXTRACT(ABMR(10,140),1,12)_", "_ABMR(10,150)_" "_ABMR(10,160)_"^25^25"
+23 IF $$RCID^ABMERUTL(ABMP("INS"))=61044
SET ABMDE=""
+24 ;abm*2.6*1 HEAT4566
IF DUZ(2)=1581
IF (ABMP("VTYP")=998)
SET ABMDE="SAN FELIPE PUEBLO, NM 87001^25^27"
+25 DO WRT^ABMDF28W
+26 ;
4 ;
+1 WRITE !
+2 ;Provider phone form locator #1-line 4
DO 110^ABMER10
+3 ;Fed. tax number form locator #5
DO 40^ABMER10
+4 ;Stmt covers period from form locator #6
DO 190^ABMER20
+5 ;Stmt covers period to form locator #6
DO 200^ABMER20
+6 ;Covered days form locator #7-old
DO 200^ABMER30
+7 ;Non-covered days form locator #8-old
DO 210^ABMER30
+8 ;Co-insured days form locator #9-old
DO 220^ABMER30
+9 ;Lifetime reserve days form locator #10-old
DO 230^ABMER30
+10 SET ABMDE=ABMR(10,110)_"^^25"
+11 DO WRT^ABMDF28W
+12 IF DUZ(2)=1581
IF (ABMP("VTYP")=998)
SET ABMR(10,40)=850210848
+13 ;#5
SET ABMDE=$TRANSLATE(ABMR(10,40),"-")_"^50^10"
+14 DO WRT^ABMDF28W
+15 ;#6
SET ABMDE=ABMR(20,190)_"^60^6"
+16 DO WRT^ABMDF28W
+17 ;#6
SET ABMDE=ABMR(20,200)_"^67^6"
+18 DO WRT^ABMDF28W
+19 SET ABMP("CDAYS")=$GET(ABMR(30,200))
+20 ;
6 ;
+1 ; Patient's name and mailing address
+2 WRITE !
+3 KILL ABMP("PNAME")
+4 NEW I
+5 ;Patient name -form locator #9
FOR I=40:10:60
Begin DoDot:1
+6 DO @(I_"^ABMER20A")
End DoDot:1
+7 NEW I
+8 ;Patient mailing address -form locator #9
FOR I=120:10:160
Begin DoDot:1
+9 DO @(I_"^ABMER20")
End DoDot:1
+10 ;patient str address #9a
SET ABMDE=ABMR(20,120)_$SELECT(ABMR(20,130)]"":" "_ABMR(20,130),1:"")_"^41^40"
+11 DO WRT^ABMDF28W
+12 WRITE !
+13 SET ABMP("PNAME")=ABMR(20,40)_", "_ABMR(20,50)_" "_ABMR(20,60)
+14 ;abm*2.6*21 IHS/SD/SDR HEAT169641
IF ($$RCID^ABMERUTL(ABMP("INS"))[61044)&(ABMR(20,60)'="")
SET ABMP("PNAME")=ABMR(20,40)_", "_ABMR(20,50)_", "_ABMR(20,60)
+15 ;#8b
SET ABMDE=ABMP("PNAME")_"^2^29"
+16 DO WRT^ABMDF28W
+17 ;patient city #9b
SET ABMDE=ABMR(20,140)_"^31^30"
+18 DO WRT^ABMDF28W
+19 ;patient state #9c
SET ABMDE=ABMR(20,150)_"^64^2"
+20 DO WRT^ABMDF28W
+21 ;patient zip #9d
SET ABMDE=ABMR(20,160)_"^68^9"
+22 DO WRT^ABMDF28W
+23 SET ABMP("NOFMT")=0
8 ;
+1 WRITE !!
+2 KILL ABMR
+3 NEW I
+4 FOR I=70:10:110
Begin DoDot:1
+5 DO @(I_"^ABMER20A")
End DoDot:1
+6 NEW I
+7 FOR I=170,180,210,220,250
Begin DoDot:1
+8 DO @(I_"^ABMER20")
End DoDot:1
+9 NEW I
+10 FOR I=40:10:130,210
Begin DoDot:1
+11 DO @(I_"^ABMER41A")
End DoDot:1
+12 ;Patient Birthdate
SET ABMDE=ABMR(20,80)_"^^8"
+13 ; form locator #10
DO WRT^ABMDF28W
+14 ;Patient sex code
SET ABMDE=ABMR(20,70)_"^10^1"
+15 ; form locator #11
DO WRT^ABMDF28W
+16 ;Admission date
IF ABMR(20,170)
SET ABMDE=ABMR(20,170)_"^12^6"
+17 ;D WRT^ABMDF28W ; form locator #12 ;abm*2.6*27 IHS/SD/SDR CR8897
+18 ; form locator #12 ;abm*2.6*27 IHS/SD/SDR CR8897
IF '($$RCID^ABMERUTL(ABMP("INS"))["61044"&(ABMP("VTYP")=142))
DO WRT^ABMDF28W
+19 ;Admission hour
IF ABMR(20,180)
SET ABMDE=ABMR(20,180)_"^18^3"
+20 ; form locator #13
DO WRT^ABMDF28W
+21 IF +$GET(ABMR(20,100))'=0
SET ABMR(20,100)="0"_ABMR(20,100)
+22 ;Type of admission
SET ABMDE=(ABMR(20,100))_"^21^3"
+23 IF ($PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)="NEW MEXICO MEDICAID")!($PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)="MEDICAID EXEMPT")
SET ABMDE=+(ABMR(20,100))_"^21^3"
+24 ;abm*2.6*27 IHS/SD/AML CR10170
IF (($$RCID^ABMERUTL(ABMP("INS"))["61044")&($PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)'["O/P MEDI-CAL"))
SET ABMDE=+(ABMR(20,100))_"^21^3"
+25 ; form locator #14
DO WRT^ABMDF28W
+26 IF +$GET(ABMR(20,110))'=0
SET ABMR(20,110)="0"_ABMR(20,110)
+27 ;Source of admission
SET ABMDE=(ABMR(20,110))_"^24^3"
+28 ;I ($P($G(^AUTNINS(ABMP("INS"),0)),U)="NEW MEXICO MEDICAID")!($P($G(^AUTNINS(ABMP("INS"),0)),U)="MEDICAID EXEMPT") S ABMDE=+(ABMR(20,110))_"24^3" ;abm*2.6*9 HEAT53204
+29 ;abm*2.6*9 HEAT53204
IF ($PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)="NEW MEXICO MEDICAID")!($PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)="MEDICAID EXEMPT")
SET ABMDE=+(ABMR(20,110))_"^24^3"
+30 ;abm*2.6*27 IHS/SD/AML CR10170
IF (($$RCID^ABMERUTL(ABMP("INS"))["61044")&($PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)'["O/P MEDI-CAL"))
SET ABMDE=+(ABMR(20,110))_"^24^3"
+31 IF $PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)="ARIZONA MEDICAID"
IF (ABMP("VTYP")=998)
SET ABMDE="^^24^3"
+32 ; form locator #15
DO WRT^ABMDF28W
+33 ;Discharge hour
IF ABMR(20,220)
SET ABMDE=ABMR(20,220)_"^27^3"
+34 ; form locator #16
DO WRT^ABMDF28W
+35 ;Pat discharge status
IF ABMR(20,210)
SET ABMDE=ABMR(20,210)_"^30^3"
+36 ; form locator #17
DO WRT^ABMDF28W
+37 ;
+38 ;Condition code 1
SET ABMDE=ABMR(41,40)_"^33^3"
+39 ;form locator #18
DO WRT^ABMDF28W
+40 ;Condition code 2
SET ABMDE=ABMR(41,50)_"^37^3"
+41 ;form locator #19
DO WRT^ABMDF28W
+42 ;Condition code 3
SET ABMDE=ABMR(41,60)_"^40^3"
+43 ;form locator #20
DO WRT^ABMDF28W
+44 ;Condition code 4
SET ABMDE=ABMR(41,70)_"^43^3"
+45 ;form locator #21
DO WRT^ABMDF28W
+46 ;Condition code 5
SET ABMDE=ABMR(41,80)_"^46^3"
+47 ;form locator #22
DO WRT^ABMDF28W
+48 ;Condition code 6
SET ABMDE=ABMR(41,90)_"^49^3"
+49 ;form locator #23
DO WRT^ABMDF28W
+50 ;Condition code 7
SET ABMDE=ABMR(41,100)_"^52^3"
+51 ;form locator #24
DO WRT^ABMDF28W
+52 ;Condition code 8
SET ABMDE=$GET(ABMR(41,110))_"^55^3"
+53 ;form locator #25
DO WRT^ABMDF28W
+54 ;Condition code 9
SET ABMDE=$GET(ABMR(41,120))_"^58^3"
+55 ;form locator #26
DO WRT^ABMDF28W
+56 ;Condition code 10
SET ABMDE=$GET(ABMR(41,130))_"^61^3"
+57 ;form locator #27
DO WRT^ABMDF28W
+58 ;Condition code 11
SET ABMDE=$GET(ABMR(41,210))_"^64^3"
+59 ;form locator #28
DO WRT^ABMDF28W
+60 ;
+61 ;accident state
SET ABMDE=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),8)),U,16)
+62 ;form locator #29
IF ABMDE
SET ABMDE=$PIECE($GET(^DIC(5,ABMDE,0)),U,2)_"^69^2"
DO WRT^ABMDF28W
+63 ;
10 ;
+1 WRITE !!
+2 KILL ABMR
+3 NEW I
+4 FOR I=80:10:150
Begin DoDot:1
+5 DO @(I_"^ABMER40A")
End DoDot:1
+6 NEW I
+7 FOR I=280:10:300,350:10:400
Begin DoDot:1
+8 DO @(I_"^ABMER40")
End DoDot:1
+9 ;
+10 FOR I=160,170
Begin DoDot:1
+11 DO @(I_"^ABMER40A")
End DoDot:1
+12 NEW I
+13 FOR I=180:10:230,310:10:330
Begin DoDot:1
+14 DO @(I_"^ABMER40")
End DoDot:1
+15 ; Occurrence code 1
SET ABMDE=ABMR(40,80)_"^^2"
+16 ;form locator #31a
DO WRT^ABMDF28W
+17 ; Occurrence date 1
SET ABMDE=ABMR(40,90)_"^3^6"
+18 ;form locator #31a
DO WRT^ABMDF28W
+19 ;
+20 ; Occurrence code 2
SET ABMDE=ABMR(40,100)_"^10^2"
+21 ; form locator #32a
DO WRT^ABMDF28W
+22 ; Occurrence date 2
SET ABMDE=ABMR(40,110)_"^13^6"
+23 ; form locator #32a
DO WRT^ABMDF28W
+24 ;
+25 ; Occurrence code 3
SET ABMDE=ABMR(40,120)_"^20^2"
+26 ; form locator #33a
DO WRT^ABMDF28W
+27 ;Occurrence date 3
SET ABMDE=ABMR(40,130)_"^23^6"
+28 ; form locator #33a
DO WRT^ABMDF28W
+29 ;
+30 ; Occurrence code 4
SET ABMDE=ABMR(40,140)_"^30^2"
+31 ; form locator #34a
DO WRT^ABMDF28W
+32 ; Occurrence date 4
SET ABMDE=ABMR(40,150)_"^33^6"
+33 ; form locator #34a
DO WRT^ABMDF28W
+34 ;
+35 ; Occur. Span code 1
SET ABMDE=ABMR(40,280)_"^40^2"
+36 ; form locator #35a
DO WRT^ABMDF28W
+37 ; Occur. Span from date 1
SET ABMDE=ABMR(40,290)_"^43^6"
+38 ; form locator #35a
DO WRT^ABMDF28W
+39 ; Occur. Span thru date 1
SET ABMDE=ABMR(40,300)_"^50^6"
+40 ; form locator #35a
DO WRT^ABMDF28W
+41 ;
+42 ; Occur. Span code 1
SET ABMDE=ABMR(40,310)_"^57^2"
+43 ; form locator #36a
DO WRT^ABMDF28W
+44 ; Occur. Span from date 1
SET ABMDE=ABMR(40,320)_"^60^6"
+45 ; form locator #36a
DO WRT^ABMDF28W
+46 ; Occur. Span thru date 1
SET ABMDE=ABMR(40,330)_"^67^6"
+47 ; form locator #36a
DO WRT^ABMDF28W
+48 ;start new abm*2.6*1 HEAT5837
+49 ;delayed reason code
SET ABMDE=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),U,16)
+50 ;I ABMDE S ABMDE=$P($G(^ABMDCODE(ABMDE,0)),U)_"^74^7" D WRT^ABMDF28W ;form locator #37a ;abm*2.6*21 IHS/SD/SDR HEAT183995
+51 ;form locator #37a ;abm*2.6*21 IHS/SD/SDR HEAT183995
IF ABMDE
SET ABMDE=+$PIECE($GET(^ABMDCODE(ABMDE,0)),U)_"^74^7"
DO WRT^ABMDF28W
+52 ;end new HEAT5837
11 ;
+1 WRITE !
+2 NEW I
+3 ;Occurrence code 5
SET ABMDE=ABMR(40,160)_"^^2"
+4 ;form locator #31b
DO WRT^ABMDF28W
+5 ;Occurrence date 5
SET ABMDE=ABMR(40,170)_"^3^6"
+6 ;form locator #31b
DO WRT^ABMDF28W
+7 ;
+8 ;Occurrence code 6
SET ABMDE=ABMR(40,180)_"^10^2"
+9 ;form locator #32b
DO WRT^ABMDF28W
+10 ;Occurrence date 6
SET ABMDE=ABMR(40,190)_"^13^6"
+11 ;form locator #32b
DO WRT^ABMDF28W
+12 ;
+13 ;Occurrence code 7
SET ABMDE=ABMR(40,200)_"^20^2"
+14 ;form locator #33b
DO WRT^ABMDF28W
+15 ;Occurrence date 7
SET ABMDE=ABMR(40,210)_"^23^6"
+16 ;form locator #33b
DO WRT^ABMDF28W
+17 ;
+18 ;Occurrence code 8
SET ABMDE=ABMR(40,220)_"^30^2"
+19 ;form locator #34b
DO WRT^ABMDF28W
+20 ;Occurrence date 8
SET ABMDE=ABMR(40,230)_"^33^6"
+21 ;form locator #34b
DO WRT^ABMDF28W
+22 ;
+23 ;Occur. Span code 3
SET ABMDE=ABMR(40,350)_"^40^2"
+24 ;form locator #35b
DO WRT^ABMDF28W
+25 ;Occur. Span from date 3
SET ABMDE=ABMR(40,360)_"^43^6"
+26 ;form locator #35b
DO WRT^ABMDF28W
+27 ;Occur. Span thru date 3
SET ABMDE=ABMR(40,370)_"^50^6"
+28 ;form locator #35b
DO WRT^ABMDF28W
+29 ;
+30 ;Occur. Span code 4
SET ABMDE=ABMR(40,380)_"^57^2"
+31 ;form locator #36b
DO WRT^ABMDF28W
+32 ;Occur. Span from date 4
SET ABMDE=ABMR(40,390)_"^60^6"
+33 ;form locator #36b
DO WRT^ABMDF28W
+34 ;Occur. Span thru date 4
SET ABMDE=ABMR(40,400)_"^67^6"
+35 ;form locator #36b
DO WRT^ABMDF28W
+36 ;
+37 ;start old abm*2.6*21 IHS/SD/SDR HEAT97615
+38 ;S ABMDE=$E($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),4)),U,9),1,22)
+39 ;S:ABMDE'="" ABMDE=ABMDE_"^58^22"
+40 ;D WRT^ABMDF28W
+41 ;end old abm*2.6*21 IHS/SD/SDR HEAT97615
+42 ;
12 ;
+1 ; If private insurance and relationship of policy holder to patient
+2 ; is not self, write name of policy holder
+3 WRITE !
+4 ;S ABM38FLG=$P($G(^ABMDPARM(DUZ(2),1,2)),U,10) ;abm*2.6*1 FIXPMS10028
+5 ;abm*2.6*1 FIXPMS10028
SET ABM38FLG=""
+6 ;abm*2.6*1 FIXPMS10028
SET ABM38FLG=$PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,15)
+7 ;abm*2.6*1 FIXPMS10028
IF ABM38FLG=""
SET ABM38FLG=$PIECE($GET(^ABMDPARM(DUZ(2),1,2)),U,10)
+8 IF ABM38FLG["P"
Begin DoDot:1
+9 ;I ABMP("ITYPE")="P" D ;abm*2.6*1 FIXPMS10028
+10 ;abm*2.6*1 FIXPMS10028
IF "^P^H^F^M^"[("^"_ABMP("ITYPE")_"^")
Begin DoDot:2
+11 ;
+12 NEW I
+13 SET I=0
+14 ;insurer
FOR
SET I=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,I))
IF 'I
QUIT
Begin DoDot:3
+15 ; insurer status = initiated
+16 IF $PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,I,0),"^",3)="I"
Begin DoDot:4
+17 SET ABME("INS")=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,I,0),U)
+18 SET ABME("INSIEN")=I
End DoDot:4
End DoDot:3
+19 IF '$GET(ABME("INSIEN"))
QUIT
+20 DO PRVT^ABMERINS
+21 ;card name-policy holder
SET ABMDE=$GET(ABM(9000003.1,+$GET(ABME("PH")),2,"E"))_"^^40"
+22 ;name-policy holder
IF ($PIECE(ABMDE,U)="")
SET $PIECE(ABMDE,U)=$GET(ABM(9000003.1,+$GET(ABME("PH")),.01,"E"))_"^^40"
+23 ;form locator 38
DO WRT^ABMDF28W
+24 QUIT
End DoDot:2
+25 ;start new abm*2.6*1 FIXPMS10028
+26 ;MCR
+27 IF "^R^MD^MH^"[("^"_ABMP("ITYPE")_"^")
Begin DoDot:2
+28 ;abm*2.6*3 HEAT13774
DO ISET^ABMERUTL
+29 SET IENS=$PIECE($GET(ABMP(("INS"),ABME("INS#"))),U,3)_","_ABMP("PDFN")_","
+30 ;MCR name
SET ABMDE=$$GET1^DIQ(9000003.11,IENS,".05","E")_"^^40"
+31 ;form locator 38
DO WRT^ABMDF28W
End DoDot:2
+32 ;MCD
+33 IF "^D^K^"[("^"_ABMP("ITYPE")_"^")
Begin DoDot:2
+34 ;MCD name
SET ABMDE=$$GET1^DIQ(9000004,+$GET(ABMCDNUM),2101,"E")_"^^40"
+35 ;form locator 38
DO WRT^ABMDF28W
End DoDot:2
+36 ;
+37 IF ABMP("ITYPE")="N"
Begin DoDot:2
+38 ;patient name
SET ABMDE=$GET(ABMP("PNAME"))_"^^40"
+39 ;form locator 38
DO WRT^ABMDF28W
End DoDot:2
QUIT
+40 ;end new FIXPMS10028
End DoDot:1
+41 ;
+42 IF ABM38FLG["I"
Begin DoDot:1
+43 ;start new code abm*2.6*1 HEAT7998
+44 IF ABMP("ITYPE")="N"
Begin DoDot:2
+45 ;patient name
SET ABMDE=$GET(ABMP("PNAME"))_"^^40"
+46 ;form locator 38
DO WRT^ABMDF28W
End DoDot:2
QUIT
+47 ;end new code HEAT7998
+48 SET (ABMINMF,ABMISTRF)=""
+49 ; billing office
+50 IF $PIECE($GET(^AUTNINS(ABMP("INS"),1)),U)'=""
Begin DoDot:2
+51 SET ABMINM=$PIECE(^AUTNINS(ABMP("INS"),1),U)
+52 SET ABMINMF=1
End DoDot:2
+53 IF '$TEST
SET ABMINM=$PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)
+54 ; street address
+55 IF $GET(ABMINMF)=1
IF $PIECE($GET(^AUTNINS(ABMP("INS"),1)),U,2)'=""
Begin DoDot:2
+56 SET ABMISTR=$PIECE(^AUTNINS(ABMP("INS"),1),U,2)
+57 SET ABMISTRF=1
End DoDot:2
+58 IF '$TEST
SET ABMISTR=$PIECE($GET(^AUTNINS(ABMP("INS"),0)),U,2)
+59 ;
+60 IF ABMINMF=1
IF ABMISTRF=1
SET ABMI=1
+61 IF '$TEST
SET ABMI=0
+62 SET ABMICTY=$PIECE($GET(^AUTNINS(ABMP("INS"),ABMI)),U,3)
+63 SET ABMIST=$PIECE($GET(^AUTNINS(ABMP("INS"),ABMI)),U,4)
+64 SET ABMIZIP=$PIECE($GET(^AUTNINS(ABMP("INS"),ABMI)),U,5)
+65 SET ABMDE=ABMINM_"^^40"
+66 ;form locator #38 line1
DO WRT^ABMDF28W
End DoDot:1
+67 ;
+68 ;if B it shouldn't do anything
IF ABM38FLG["B"
+69 IF $GET(ABMORE)'=""
Begin DoDot:1
+70 DO 13^ABMDF28Y
End DoDot:1
+71 IF $GET(ABMORE)
QUIT
+72 ;
OTHER ;DO OTHER ROUTINES & QUIT
+1 DO ^ABMDF28Y
DO ^ABMDF28Z
+2 WRITE $$EN^ABMVDF("IOF")
+3 KILL ABMR,ABMREC,ABM,ABME
+4 KILL ABMINM,ABMISTR,ABMICTY,ABMIST,ABMIZIP
+5 QUIT
+6 ;
TEST ;
+1 ; EP;Test forms allignment
+2 DO TEST^ABMDF28W
+3 QUIT
