- 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
