ABMDF11X ; IHS/ASDST/DMJ - PRINT UB92 ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;Original;DMJ;
; IHS/SD/SDR - v2.5 p8 - IM14893/IM15353
; Removal of "0" from FL19 and FL20
;
; IHS/SD/SDR - v2.5 p8 - IM15034
; Modified to print 2-page claims correctly
;
; IHS/SD/SDR - v2.5 p9 - IM12048
; Correction to FL4
;
; IHS/SD/SDR - v2.5 p9 - IM18032
; Put Medicaid Resubmission Number in FL37
;
; IHS/SD/SDR - v2.5 p9 - IM16991
; Added code for San Felipe VT 998
;
; IHS/SD/SDR - v2.5 p9 - IM17778
; Added code for AZ Medicaid to not print source of admission if VT 998
;
; IHS/SD/SDR - v2.5 p10 - IM20182/IM20211
; Fixed FL4 to keep it from wrapping
;
; IHS/SD/SDR - v2.5 p10 - IM20000
; Added code to use CARD NAME for Policy Holder
;**********************************************************************
;
K ABM
S ABMP("LM")=$P(^ABMDEXP(11,0),"^",2) ; Left margin of form
;
; FOLLOWING LINE TAGS CORRESPOND TO LINE NUMBERS
;
1 ; EP
; Provider name -- form locator #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=ABMR(10,120)_"^^25" ; data ^ tab ^ format
D WRT^ABMDF11W ; write data in specified format
;
2 ;
; Provider address, Patient control number, Bill type
W !
D 130^ABMER10 ; Provider address -- form locator #1
D 30^ABMER20 ; Patient control number -- form locator #3
I DUZ(2)=1581,(ABMP("VTYP")=998) S ABMR(10,130)="PO BOX 4339"
S ABMDE=ABMR(10,130)_"^^25"
D WRT^ABMDF11W
S ABMDE=ABMR(20,30)_"^57^20"
D WRT^ABMDF11W
S ABMDE=ABMP("BTYP")_"^77^3" ; Bill type -- form locator #4
D WRT^ABMDF11W
;
3 ;
; Provider city, state, zip -- form locator #1
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
S ABMDE=ABMR(10,140)_", "_ABMR(10,150)_" "_ABMR(10,160)_"^^25"
I DUZ(2)=1581,(ABMP("VTYP")=998) S ABMDE="SAN FELIPE, NM 87001^^25"
D WRT^ABMDF11W
;
4 ;
W !
D 110^ABMER10 ; Provider phone -- form locator #1
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
D 210^ABMER30 ; Non-covered days -- form locator #8
D 220^ABMER30 ; Co-insured days -- form locator #9
D 230^ABMER30 ; Lifetime reserve days -- form locator #10
S ABMDE=ABMR(10,110)_"^^25"
D WRT^ABMDF11W
I DUZ(2)=1581,(ABMP("VTYP")=998) S ABMR(10,40)=850210848
S ABMDE=ABMR(10,40)_"^26^10"
D WRT^ABMDF11W
S ABMDE=ABMR(20,190)_"^37^6"
D WRT^ABMDF11W
S ABMDE=ABMR(20,200)_"^44^6"
D WRT^ABMDF11W
S ABMDE=ABMR(30,200)_"^51^3R"
S ABMP("CDAYS")=$G(ABMR(30,200))
D:ABMR(30,200) WRT^ABMDF11W
S ABMDE=ABMR(30,210)_"^55^4R"
D:ABMR(30,210) WRT^ABMDF11W
S ABMDE=ABMR(30,220)_"^60^3R"
D WRT^ABMDF11W
S ABMDE=ABMR(30,230)_"^64^3R"
D WRT^ABMDF11W
;
6 ;
; Patient's name and mailing address
W !!
K ABMP("PNAME")
N I
F I=40:10:60 D ; Patient name -- form locator #12
. D @(I_"^ABMER20A")
N I
F I=120:10:160 D ; Patient mailing address -- form locator #13
. D @(I_"^ABMER20")
I $L(ABMR(20,160))=9 D
. S ABMR(20,160)=$E(ABMR(20,160),1,5)_"-"_$E(ABMR(20,160),6,9)
. Q
S ABMP("PNAME")=ABMR(20,40)_", "_ABMR(20,50)_" "_ABMR(20,60)
S ABMDE=ABMP("PNAME")_"^^30"
D WRT^ABMDF11W
S ABMDE=ABMR(20,120)_$S(ABMR(20,130)]"":" "_ABMR(20,130),1:"")_", "_ABMR(20,140)_", "_ABMR(20,150)_" "_ABMR(20,160)_"^31^50"
D WRT^ABMDF11W
S ABMP("NOFMT")=0
; Quit if printing additional pages to ONE itemized UB-92 claim
;
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:100 D
.D @(I_"^ABMER41A")
S ABMDE=ABMR(20,80)_"^^8" ; Patient Birthdate
D WRT^ABMDF11W ; form locator #14
S ABMDE=ABMR(20,70)_"^9^1" ; Patient sex code
D WRT^ABMDF11W ; form locator #15
S ABMDE=ABMR(20,90)_"^12^1" ; Marital Status code
D WRT^ABMDF11W ; form locator #16
S:ABMR(20,170) ABMDE=ABMR(20,170)_"^14^6" ; Admission date
D WRT^ABMDF11W ; form locator #17
S:ABMR(20,180) ABMDE=ABMR(20,180)_"^21^2" ; Admission hour
D WRT^ABMDF11W ; form locator #18
I +$G(ABMR(20,100))'=0 S ABMR(20,100)="0"_ABMR(20,100)
S ABMDE=(ABMR(20,100))_"^24^2" ; Type of admission
D WRT^ABMDF11W ; form locator #19
I +$G(ABMR(20,110))'=0 S ABMR(20,110)="0"_ABMR(20,110)
S ABMDE=(ABMR(20,110))_"^27^2" ; Source of admission
I $P($G(^AUTNINS(ABMP("INS"),0)),U)="ARIZONA MEDICAID",(ABMP("VTYP")=998) S ABMDE="^^28^2"
D WRT^ABMDF11W ; form locator #20
S:ABMR(20,220) ABMDE=ABMR(20,220)_"^30^2" ; Discharge hour
D WRT^ABMDF11W ; form locator #21
S:ABMR(20,210) ABMDE=ABMR(20,210)_"^33^2" ; Pat discharge status
D WRT^ABMDF11W ; form locator #22
S ABMDE=ABMR(20,250)_"^36^17" ; Medical record num.
D WRT^ABMDF11W ; form locator #23
S ABMDE=ABMR(41,40)_"^54^2" ; Condition code - 1
D WRT^ABMDF11W ; form locator #24
S ABMDE=ABMR(41,50)_"^57^2" ; Condition code - 2
D WRT^ABMDF11W ; form locator #25
S ABMDE=ABMR(41,60)_"^60^2" ; Condition code - 3
D WRT^ABMDF11W ; form locator #26
S ABMDE=ABMR(41,70)_"^63^2" ; Condition code - 4
D WRT^ABMDF11W ; form locator #27
S ABMDE=ABMR(41,80)_"^66^2" ; Condition code - 5
D WRT^ABMDF11W ; form locator #28
S ABMDE=ABMR(41,90)_"^69^2" ; Condition code - 6
D WRT^ABMDF11W ; form locator #29
S ABMDE=ABMR(41,100)_"^72^2" ; Condition code - 7
D WRT^ABMDF11W ; form locator #30
;
10 ;
W !!
K ABMR
N I
F I=80:10:150 D
.D @(I_"^ABMER40A")
N I
F I=280:10:300 D
.D @(I_"^ABMER40")
S ABMDE=ABMR(40,80)_"^^2" ; Occurrence code - 1
D WRT^ABMDF11W ; form locator #32a
S ABMDE=ABMR(40,90)_"^3^6" ; Occurrence date - 1
D WRT^ABMDF11W ; form locator #32a
S ABMDE=ABMR(40,100)_"^10^2" ; Occurrence code - 2
D WRT^ABMDF11W ; form locator #33a
S ABMDE=ABMR(40,110)_"^13^6" ; Occurrence date - 2
D WRT^ABMDF11W ; form locator #33a
S ABMDE=ABMR(40,120)_"^20^2" ; Occurrence code - 3
D WRT^ABMDF11W ; form locator #34a
S ABMDE=ABMR(40,130)_"^23^6" ; Occurrence date - 3
D WRT^ABMDF11W ; form locator #34a
S ABMDE=ABMR(40,140)_"^30^2" ; Occurrence code - 4
D WRT^ABMDF11W ; form locator #35a
S ABMDE=ABMR(40,150)_"^33^6" ; Occurrence date - 4
D WRT^ABMDF11W ; form locator #35a
S ABMDE=ABMR(40,280)_"^40^2" ; Occur. Span code - 1
D WRT^ABMDF11W ; form locator #36a
S ABMDE=ABMR(40,290)_"^43^6" ; Occur. Span from date - 1
D WRT^ABMDF11W ; form locator #36a
S ABMDE=ABMR(40,300)_"^50^6" ; Occur. Span thru date - 1
D WRT^ABMDF11W ; form locator #36a
;
11 ;
W !
K ABMR
N I
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,160)_"^^2" ; Occurrence code - 5
D WRT^ABMDF11W ; form locator #32b
S ABMDE=ABMR(40,170)_"^3^6" ; Occurrence date - 5
D WRT^ABMDF11W ; form locator #32b
S ABMDE=ABMR(40,180)_"^10^2" ; Occurrence code - 6
D WRT^ABMDF11W ; form locator #33b
S ABMDE=ABMR(40,190)_"^13^6" ; Occurrence date - 6
D WRT^ABMDF11W ; form locator #33b
S ABMDE=ABMR(40,200)_"^20^2" ; Occurrence code - 7
D WRT^ABMDF11W ; form locator #34b
S ABMDE=ABMR(40,210)_"^23^6" ; Occurrence date - 7
D WRT^ABMDF11W ; form locator #34b
S ABMDE=ABMR(40,220)_"^30^2" ; Occurrence code - 8
D WRT^ABMDF11W ; form locator #35b
S ABMDE=ABMR(40,230)_"^33^6" ; Occurrence date - 8
D WRT^ABMDF11W ; form locator #35b
S ABMDE=ABMR(40,310)_"^40^2" ; Occur. Span code - 2
D WRT^ABMDF11W ; form locator #36b
S ABMDE=ABMR(40,320)_"^43^6" ; Occur. Span from date - 2
D WRT^ABMDF11W ; form locator #36b
S ABMDE=ABMR(40,330)_"^50^6" ; Occur. Span thru date - 2
D WRT^ABMDF11W ; form locator #36b
S ABMDE=$E($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),4)),U,9),1,22)
S:ABMDE'="" ABMDE=ABMDE_"^58^22"
D WRT^ABMDF11W
;
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)
I ABM38FLG["P" D
.I ABMP("ITYPE")="P" D
..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),"^",1)
....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^ABMDF11W ;form locator 38
..Q
;
I ABM38FLG["I" D
.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^ABMDF11W ;form locator 38 line1
;
I ABM38FLG["B" ;if B it shouldn't do anything
I $G(ABMORE)'="" D
.D 13^ABMDF11Y
Q:$G(ABMORE)
;
OTHER ;DO OTHER ROUTINES & QUIT
D ^ABMDF11Y,^ABMDF11Z
W $$EN^ABMVDF("IOF")
K ABMR,ABMREC,ABM,ABME
K ABMINM,ABMISTR,ABMICTY,ABMIST,ABMIZIP
Q
;
TEST ;
; EP;Test forms allignment
D TEST^ABMDF11W
Q
ABMDF11X ; IHS/ASDST/DMJ - PRINT UB92 ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;Original;DMJ;
+3 ; IHS/SD/SDR - v2.5 p8 - IM14893/IM15353
+4 ; Removal of "0" from FL19 and FL20
+5 ;
+6 ; IHS/SD/SDR - v2.5 p8 - IM15034
+7 ; Modified to print 2-page claims correctly
+8 ;
+9 ; IHS/SD/SDR - v2.5 p9 - IM12048
+10 ; Correction to FL4
+11 ;
+12 ; IHS/SD/SDR - v2.5 p9 - IM18032
+13 ; Put Medicaid Resubmission Number in FL37
+14 ;
+15 ; IHS/SD/SDR - v2.5 p9 - IM16991
+16 ; Added code for San Felipe VT 998
+17 ;
+18 ; IHS/SD/SDR - v2.5 p9 - IM17778
+19 ; Added code for AZ Medicaid to not print source of admission if VT 998
+20 ;
+21 ; IHS/SD/SDR - v2.5 p10 - IM20182/IM20211
+22 ; Fixed FL4 to keep it from wrapping
+23 ;
+24 ; IHS/SD/SDR - v2.5 p10 - IM20000
+25 ; Added code to use CARD NAME for Policy Holder
+26 ;**********************************************************************
+27 ;
+28 KILL ABM
+29 ; Left margin of form
SET ABMP("LM")=$PIECE(^ABMDEXP(11,0),"^",2)
+30 ;
+31 ; FOLLOWING LINE TAGS CORRESPOND TO LINE NUMBERS
+32 ;
1 ; EP
+1 ; Provider name -- form locator #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=ABMR(10,120)_"^^25"
+7 ; write data in specified format
DO WRT^ABMDF11W
+8 ;
2 ;
+1 ; Provider address, Patient control number, Bill type
+2 WRITE !
+3 ; Provider address -- form locator #1
DO 130^ABMER10
+4 ; Patient control number -- form locator #3
DO 30^ABMER20
+5 IF DUZ(2)=1581
IF (ABMP("VTYP")=998)
SET ABMR(10,130)="PO BOX 4339"
+6 SET ABMDE=ABMR(10,130)_"^^25"
+7 DO WRT^ABMDF11W
+8 SET ABMDE=ABMR(20,30)_"^57^20"
+9 DO WRT^ABMDF11W
+10 ; Bill type -- form locator #4
SET ABMDE=ABMP("BTYP")_"^77^3"
+11 DO WRT^ABMDF11W
+12 ;
3 ;
+1 ; Provider city, state, zip -- form locator #1
+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 SET ABMDE=ABMR(10,140)_", "_ABMR(10,150)_" "_ABMR(10,160)_"^^25"
+10 IF DUZ(2)=1581
IF (ABMP("VTYP")=998)
SET ABMDE="SAN FELIPE, NM 87001^^25"
+11 DO WRT^ABMDF11W
+12 ;
4 ;
+1 WRITE !
+2 ; Provider phone -- form locator #1
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
DO 200^ABMER30
+7 ; Non-covered days -- form locator #8
DO 210^ABMER30
+8 ; Co-insured days -- form locator #9
DO 220^ABMER30
+9 ; Lifetime reserve days -- form locator #10
DO 230^ABMER30
+10 SET ABMDE=ABMR(10,110)_"^^25"
+11 DO WRT^ABMDF11W
+12 IF DUZ(2)=1581
IF (ABMP("VTYP")=998)
SET ABMR(10,40)=850210848
+13 SET ABMDE=ABMR(10,40)_"^26^10"
+14 DO WRT^ABMDF11W
+15 SET ABMDE=ABMR(20,190)_"^37^6"
+16 DO WRT^ABMDF11W
+17 SET ABMDE=ABMR(20,200)_"^44^6"
+18 DO WRT^ABMDF11W
+19 SET ABMDE=ABMR(30,200)_"^51^3R"
+20 SET ABMP("CDAYS")=$GET(ABMR(30,200))
+21 IF ABMR(30,200)
DO WRT^ABMDF11W
+22 SET ABMDE=ABMR(30,210)_"^55^4R"
+23 IF ABMR(30,210)
DO WRT^ABMDF11W
+24 SET ABMDE=ABMR(30,220)_"^60^3R"
+25 DO WRT^ABMDF11W
+26 SET ABMDE=ABMR(30,230)_"^64^3R"
+27 DO WRT^ABMDF11W
+28 ;
6 ;
+1 ; Patient's name and mailing address
+2 WRITE !!
+3 KILL ABMP("PNAME")
+4 NEW I
+5 ; Patient name -- form locator #12
FOR I=40:10:60
Begin DoDot:1
+6 DO @(I_"^ABMER20A")
End DoDot:1
+7 NEW I
+8 ; Patient mailing address -- form locator #13
FOR I=120:10:160
Begin DoDot:1
+9 DO @(I_"^ABMER20")
End DoDot:1
+10 IF $LENGTH(ABMR(20,160))=9
Begin DoDot:1
+11 SET ABMR(20,160)=$EXTRACT(ABMR(20,160),1,5)_"-"_$EXTRACT(ABMR(20,160),6,9)
+12 QUIT
End DoDot:1
+13 SET ABMP("PNAME")=ABMR(20,40)_", "_ABMR(20,50)_" "_ABMR(20,60)
+14 SET ABMDE=ABMP("PNAME")_"^^30"
+15 DO WRT^ABMDF11W
+16 SET ABMDE=ABMR(20,120)_$SELECT(ABMR(20,130)]"":" "_ABMR(20,130),1:"")_", "_ABMR(20,140)_", "_ABMR(20,150)_" "_ABMR(20,160)_"^31^50"
+17 DO WRT^ABMDF11W
+18 SET ABMP("NOFMT")=0
+19 ; Quit if printing additional pages to ONE itemized UB-92 claim
+20 ;
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:100
Begin DoDot:1
+11 DO @(I_"^ABMER41A")
End DoDot:1
+12 ; Patient Birthdate
SET ABMDE=ABMR(20,80)_"^^8"
+13 ; form locator #14
DO WRT^ABMDF11W
+14 ; Patient sex code
SET ABMDE=ABMR(20,70)_"^9^1"
+15 ; form locator #15
DO WRT^ABMDF11W
+16 ; Marital Status code
SET ABMDE=ABMR(20,90)_"^12^1"
+17 ; form locator #16
DO WRT^ABMDF11W
+18 ; Admission date
IF ABMR(20,170)
SET ABMDE=ABMR(20,170)_"^14^6"
+19 ; form locator #17
DO WRT^ABMDF11W
+20 ; Admission hour
IF ABMR(20,180)
SET ABMDE=ABMR(20,180)_"^21^2"
+21 ; form locator #18
DO WRT^ABMDF11W
+22 IF +$GET(ABMR(20,100))'=0
SET ABMR(20,100)="0"_ABMR(20,100)
+23 ; Type of admission
SET ABMDE=(ABMR(20,100))_"^24^2"
+24 ; form locator #19
DO WRT^ABMDF11W
+25 IF +$GET(ABMR(20,110))'=0
SET ABMR(20,110)="0"_ABMR(20,110)
+26 ; Source of admission
SET ABMDE=(ABMR(20,110))_"^27^2"
+27 IF $PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)="ARIZONA MEDICAID"
IF (ABMP("VTYP")=998)
SET ABMDE="^^28^2"
+28 ; form locator #20
DO WRT^ABMDF11W
+29 ; Discharge hour
IF ABMR(20,220)
SET ABMDE=ABMR(20,220)_"^30^2"
+30 ; form locator #21
DO WRT^ABMDF11W
+31 ; Pat discharge status
IF ABMR(20,210)
SET ABMDE=ABMR(20,210)_"^33^2"
+32 ; form locator #22
DO WRT^ABMDF11W
+33 ; Medical record num.
SET ABMDE=ABMR(20,250)_"^36^17"
+34 ; form locator #23
DO WRT^ABMDF11W
+35 ; Condition code - 1
SET ABMDE=ABMR(41,40)_"^54^2"
+36 ; form locator #24
DO WRT^ABMDF11W
+37 ; Condition code - 2
SET ABMDE=ABMR(41,50)_"^57^2"
+38 ; form locator #25
DO WRT^ABMDF11W
+39 ; Condition code - 3
SET ABMDE=ABMR(41,60)_"^60^2"
+40 ; form locator #26
DO WRT^ABMDF11W
+41 ; Condition code - 4
SET ABMDE=ABMR(41,70)_"^63^2"
+42 ; form locator #27
DO WRT^ABMDF11W
+43 ; Condition code - 5
SET ABMDE=ABMR(41,80)_"^66^2"
+44 ; form locator #28
DO WRT^ABMDF11W
+45 ; Condition code - 6
SET ABMDE=ABMR(41,90)_"^69^2"
+46 ; form locator #29
DO WRT^ABMDF11W
+47 ; Condition code - 7
SET ABMDE=ABMR(41,100)_"^72^2"
+48 ; form locator #30
DO WRT^ABMDF11W
+49 ;
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
Begin DoDot:1
+8 DO @(I_"^ABMER40")
End DoDot:1
+9 ; Occurrence code - 1
SET ABMDE=ABMR(40,80)_"^^2"
+10 ; form locator #32a
DO WRT^ABMDF11W
+11 ; Occurrence date - 1
SET ABMDE=ABMR(40,90)_"^3^6"
+12 ; form locator #32a
DO WRT^ABMDF11W
+13 ; Occurrence code - 2
SET ABMDE=ABMR(40,100)_"^10^2"
+14 ; form locator #33a
DO WRT^ABMDF11W
+15 ; Occurrence date - 2
SET ABMDE=ABMR(40,110)_"^13^6"
+16 ; form locator #33a
DO WRT^ABMDF11W
+17 ; Occurrence code - 3
SET ABMDE=ABMR(40,120)_"^20^2"
+18 ; form locator #34a
DO WRT^ABMDF11W
+19 ; Occurrence date - 3
SET ABMDE=ABMR(40,130)_"^23^6"
+20 ; form locator #34a
DO WRT^ABMDF11W
+21 ; Occurrence code - 4
SET ABMDE=ABMR(40,140)_"^30^2"
+22 ; form locator #35a
DO WRT^ABMDF11W
+23 ; Occurrence date - 4
SET ABMDE=ABMR(40,150)_"^33^6"
+24 ; form locator #35a
DO WRT^ABMDF11W
+25 ; Occur. Span code - 1
SET ABMDE=ABMR(40,280)_"^40^2"
+26 ; form locator #36a
DO WRT^ABMDF11W
+27 ; Occur. Span from date - 1
SET ABMDE=ABMR(40,290)_"^43^6"
+28 ; form locator #36a
DO WRT^ABMDF11W
+29 ; Occur. Span thru date - 1
SET ABMDE=ABMR(40,300)_"^50^6"
+30 ; form locator #36a
DO WRT^ABMDF11W
+31 ;
11 ;
+1 WRITE !
+2 KILL ABMR
+3 NEW I
+4 FOR I=160,170
Begin DoDot:1
+5 DO @(I_"^ABMER40A")
End DoDot:1
+6 NEW I
+7 FOR I=180:10:230,310:10:330
Begin DoDot:1
+8 DO @(I_"^ABMER40")
End DoDot:1
+9 ; Occurrence code - 5
SET ABMDE=ABMR(40,160)_"^^2"
+10 ; form locator #32b
DO WRT^ABMDF11W
+11 ; Occurrence date - 5
SET ABMDE=ABMR(40,170)_"^3^6"
+12 ; form locator #32b
DO WRT^ABMDF11W
+13 ; Occurrence code - 6
SET ABMDE=ABMR(40,180)_"^10^2"
+14 ; form locator #33b
DO WRT^ABMDF11W
+15 ; Occurrence date - 6
SET ABMDE=ABMR(40,190)_"^13^6"
+16 ; form locator #33b
DO WRT^ABMDF11W
+17 ; Occurrence code - 7
SET ABMDE=ABMR(40,200)_"^20^2"
+18 ; form locator #34b
DO WRT^ABMDF11W
+19 ; Occurrence date - 7
SET ABMDE=ABMR(40,210)_"^23^6"
+20 ; form locator #34b
DO WRT^ABMDF11W
+21 ; Occurrence code - 8
SET ABMDE=ABMR(40,220)_"^30^2"
+22 ; form locator #35b
DO WRT^ABMDF11W
+23 ; Occurrence date - 8
SET ABMDE=ABMR(40,230)_"^33^6"
+24 ; form locator #35b
DO WRT^ABMDF11W
+25 ; Occur. Span code - 2
SET ABMDE=ABMR(40,310)_"^40^2"
+26 ; form locator #36b
DO WRT^ABMDF11W
+27 ; Occur. Span from date - 2
SET ABMDE=ABMR(40,320)_"^43^6"
+28 ; form locator #36b
DO WRT^ABMDF11W
+29 ; Occur. Span thru date - 2
SET ABMDE=ABMR(40,330)_"^50^6"
+30 ; form locator #36b
DO WRT^ABMDF11W
+31 SET ABMDE=$EXTRACT($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),4)),U,9),1,22)
+32 IF ABMDE'=""
SET ABMDE=ABMDE_"^58^22"
+33 DO WRT^ABMDF11W
+34 ;
12 ;
+1 ; If private insurance and relationship of policy holder to patient
+2 ; is not self, write name of policy holder
+3 WRITE !
+4 SET ABM38FLG=$PIECE($GET(^ABMDPARM(DUZ(2),1,2)),U,10)
+5 IF ABM38FLG["P"
Begin DoDot:1
+6 IF ABMP("ITYPE")="P"
Begin DoDot:2
+7 NEW I
+8 SET I=0
+9 ;insurer
FOR
SET I=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,I))
IF 'I
QUIT
Begin DoDot:3
+10 ; insurer status = initiated
+11 IF $PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,I,0),"^",3)="I"
Begin DoDot:4
+12 SET ABME("INS")=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,I,0),"^",1)
+13 SET ABME("INSIEN")=I
End DoDot:4
End DoDot:3
+14 IF '$GET(ABME("INSIEN"))
QUIT
+15 DO PRVT^ABMERINS
+16 ;card name-policy holder
SET ABMDE=$GET(ABM(9000003.1,+$GET(ABME("PH")),2,"E"))_"^^40"
+17 ;name-policy holder
IF ($PIECE(ABMDE,U)="")
SET $PIECE(ABMDE,U)=$GET(ABM(9000003.1,+$GET(ABME("PH")),.01,"E"))_"^^40"
+18 ;form locator 38
DO WRT^ABMDF11W
+19 QUIT
End DoDot:2
End DoDot:1
+20 ;
+21 IF ABM38FLG["I"
Begin DoDot:1
+22 SET (ABMINMF,ABMISTRF)=""
+23 ; billing office
+24 IF $PIECE($GET(^AUTNINS(ABMP("INS"),1)),U)'=""
Begin DoDot:2
+25 SET ABMINM=$PIECE(^AUTNINS(ABMP("INS"),1),U)
+26 SET ABMINMF=1
End DoDot:2
+27 IF '$TEST
SET ABMINM=$PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)
+28 ; street address
+29 IF $GET(ABMINMF)=1
IF $PIECE($GET(^AUTNINS(ABMP("INS"),1)),U,2)'=""
Begin DoDot:2
+30 SET ABMISTR=$PIECE(^AUTNINS(ABMP("INS"),1),U,2)
+31 SET ABMISTRF=1
End DoDot:2
+32 IF '$TEST
SET ABMISTR=$PIECE($GET(^AUTNINS(ABMP("INS"),0)),U,2)
+33 ;
+34 IF ABMINMF=1
IF ABMISTRF=1
SET ABMI=1
+35 IF '$TEST
SET ABMI=0
+36 SET ABMICTY=$PIECE($GET(^AUTNINS(ABMP("INS"),ABMI)),U,3)
+37 SET ABMIST=$PIECE($GET(^AUTNINS(ABMP("INS"),ABMI)),U,4)
+38 SET ABMIZIP=$PIECE($GET(^AUTNINS(ABMP("INS"),ABMI)),U,5)
+39 SET ABMDE=ABMINM_"^^40"
+40 ;form locator 38 line1
DO WRT^ABMDF11W
End DoDot:1
+41 ;
+42 ;if B it shouldn't do anything
IF ABM38FLG["B"
+43 IF $GET(ABMORE)'=""
Begin DoDot:1
+44 DO 13^ABMDF11Y
End DoDot:1
+45 IF $GET(ABMORE)
QUIT
+46 ;
OTHER ;DO OTHER ROUTINES & QUIT
+1 DO ^ABMDF11Y
DO ^ABMDF11Z
+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^ABMDF11W
+3 QUIT
