ABMDF11X ; IHS/ASDST/DMJ - PRINT UB92 ;
;;2.5;IHS 3P BILLING SYSTEM;;APR 05, 2002
;Original;DMJ;
;
; IHS/ASDS/LSL - 07/10/00 - V2.4 Patch 2 - NOIS NDA-0700-180029
; Modified to allow two (2) characters to print in box 18 and
; 19 of UB-92
;
; IHS/ASDS/SDH - 08/23/01 - v2.4 Patch 9 - NOIS NDA-0801-180080
; Modified to fix missing days from inpatient stays
;
; IHS/ASDS/SDH - 11/27/01 - v2.4 p10 - NOIS UAA-0901-170076
; Modified so it would print what was selected in the UB-92
; FL38 field (policy holder, insurer, or blank)
;
;**********************************************************************
;
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
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
S ABMDE=ABMR(10,130)_"^^25"
D WRT^ABMDF11W
S ABMDE=ABMR(20,30)_"^57^20"
D WRT^ABMDF11W
;S ABMDE=ABMP("BTYP")_"^"_$S($G(IOM)=80:77,1:78)_"^3" ; Bill type -- form locator #4 ;*** TESTING - AEF *** COMMENTED OUT
S ABMDE=ABMP("BTYP")_"^"_77_"^3" ; Bill type -- form locator #4 ;*** TESTING - AEF *** NEW LINE
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"
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
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
Q:$G(ABMORE)
;
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
S ABMDE=(0_ABMR(20,100))_"^25^2" ; Type of admission
D WRT^ABMDF11W ; form locator #19
S ABMDE=(0_ABMR(20,110))_"^28^2" ; Source of admission
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
;
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
..; AmpMed needs to always see responsible party
..S ABMDE=$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
;
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.5;IHS 3P BILLING SYSTEM;;APR 05, 2002
+2 ;Original;DMJ;
+3 ;
+4 ; IHS/ASDS/LSL - 07/10/00 - V2.4 Patch 2 - NOIS NDA-0700-180029
+5 ; Modified to allow two (2) characters to print in box 18 and
+6 ; 19 of UB-92
+7 ;
+8 ; IHS/ASDS/SDH - 08/23/01 - v2.4 Patch 9 - NOIS NDA-0801-180080
+9 ; Modified to fix missing days from inpatient stays
+10 ;
+11 ; IHS/ASDS/SDH - 11/27/01 - v2.4 p10 - NOIS UAA-0901-170076
+12 ; Modified so it would print what was selected in the UB-92
+13 ; FL38 field (policy holder, insurer, or blank)
+14 ;
+15 ;**********************************************************************
+16 ;
+17 KILL ABM
+18 ; Left margin of form
SET ABMP("LM")=$PIECE(^ABMDEXP(11,0),"^",2)
+19 ;
+20 ; FOLLOWING LINE TAGS CORRESPOND TO LINE NUMBERS
+21 ;
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 ; data ^ tab ^ format
SET ABMDE=ABMR(10,120)_"^^25"
+6 ; write data in specified format
DO WRT^ABMDF11W
+7 ;
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 SET ABMDE=ABMR(10,130)_"^^25"
+6 DO WRT^ABMDF11W
+7 SET ABMDE=ABMR(20,30)_"^57^20"
+8 DO WRT^ABMDF11W
+9 ;S ABMDE=ABMP("BTYP")_"^"_$S($G(IOM)=80:77,1:78)_"^3" ; Bill type -- form locator #4 ;*** TESTING - AEF *** COMMENTED OUT
+10 ; Bill type -- form locator #4 ;*** TESTING - AEF *** NEW LINE
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 DO WRT^ABMDF11W
+11 ;
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 SET ABMDE=ABMR(10,40)_"^26^10"
+13 DO WRT^ABMDF11W
+14 SET ABMDE=ABMR(20,190)_"^37^6"
+15 DO WRT^ABMDF11W
+16 SET ABMDE=ABMR(20,200)_"^44^6"
+17 DO WRT^ABMDF11W
+18 SET ABMDE=ABMR(30,200)_"^51^3R"
+19 SET ABMP("CDAYS")=$GET(ABMR(30,200))
+20 IF ABMR(30,200)
DO WRT^ABMDF11W
+21 SET ABMDE=ABMR(30,210)_"^55^4R"
+22 IF ABMR(30,210)
DO WRT^ABMDF11W
+23 SET ABMDE=ABMR(30,220)_"^60^3R"
+24 DO WRT^ABMDF11W
+25 SET ABMDE=ABMR(30,230)_"^64^3R"
+26 DO WRT^ABMDF11W
+27 ;
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 IF $GET(ABMORE)
QUIT
+21 ;
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 ; Type of admission
SET ABMDE=(0_ABMR(20,100))_"^25^2"
+23 ; form locator #19
DO WRT^ABMDF11W
+24 ; Source of admission
SET ABMDE=(0_ABMR(20,110))_"^28^2"
+25 ; form locator #20
DO WRT^ABMDF11W
+26 ; Discharge hour
IF ABMR(20,220)
SET ABMDE=ABMR(20,220)_"^30^2"
+27 ; form locator #21
DO WRT^ABMDF11W
+28 ; Pat discharge status
IF ABMR(20,210)
SET ABMDE=ABMR(20,210)_"^33^2"
+29 ; form locator #22
DO WRT^ABMDF11W
+30 ; Medical record num.
SET ABMDE=ABMR(20,250)_"^36^17"
+31 ; form locator #23
DO WRT^ABMDF11W
+32 ; Condition code - 1
SET ABMDE=ABMR(41,40)_"^54^2"
+33 ; form locator #24
DO WRT^ABMDF11W
+34 ; Condition code - 2
SET ABMDE=ABMR(41,50)_"^57^2"
+35 ; form locator #25
DO WRT^ABMDF11W
+36 ; Condition code - 3
SET ABMDE=ABMR(41,60)_"^60^2"
+37 ; form locator #26
DO WRT^ABMDF11W
+38 ; Condition code - 4
SET ABMDE=ABMR(41,70)_"^63^2"
+39 ; form locator #27
DO WRT^ABMDF11W
+40 ; Condition code - 5
SET ABMDE=ABMR(41,80)_"^66^2"
+41 ; form locator #28
DO WRT^ABMDF11W
+42 ; Condition code - 6
SET ABMDE=ABMR(41,90)_"^69^2"
+43 ; form locator #29
DO WRT^ABMDF11W
+44 ; Condition code - 7
SET ABMDE=ABMR(41,100)_"^72^2"
+45 ; form locator #30
DO WRT^ABMDF11W
+46 ;
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 ;
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 ; AmpMed needs to always see responsible party
+17 ;name-policy holder
SET ABMDE=$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 ;
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
