ABMDF11Z ; IHS/ASDST/DMJ - PRINT UB92 ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;Original;DMJ;
;
; IHS/ASDS/LSL - 04/05/00 - V2.4 Patch 1 - NOIS NCA-0300-180046
; Moved PROV to ABMDF11W because patching here would result in
; exceeding maximum routine size allowed.
;
; IHS/SD/SDR - v2.5 p9 - IM15561
; Only do state license number if not Medicare
;
; IHS/SD/SDR - v2.5 p10 - IM19557
; Correct due from patient
;
; IHS/SD/SDR - v2.5 p12 - IM24099
; Put CR/LF after quit in tag 47
; Removed extra - top of tag 51
;
45 ;
; ABMPAID = Primary + Secondary + Tertiary + Prepaid
; ABMPBAL = Gross amount - ABM("PAID")
; Form locator #57
W !
; If non-ben patient
I ABMP("ITYPE")="N" D
.S ABMPRPAY=+$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),"^",9)
.S ABMPAID=+($E($G(ABMREC(30,1)),173,182)/100)+($E($G(ABMREC(30,2)),173,182)/100)+($E($G(ABMREC(30,3)),173,182)/100)+ABMPRPAY
.S:$G(ABMPBAL)<0 ABMPBAL=0
.S ABMDE=$TR($FN(ABMPAID,"T",2),".")_"^45^10R"
.D WRT^ABMDF11W ; Total paid
.S ABMDE=$TR($FN(ABMPBAL,"T",2),".")_"^56^10R"
.D WRT^ABMDF11W ; Remaining balance
;
47 ;
W !
N I
F I=1:1:3 D
.Q:'$D(ABMREC(30,I))
.S ABMDE=$E(ABMREC(30,I),111,130) ; Insured's last name
.S ABMDE=$TR(ABMDE," ")
.I $E(ABMREC(30,I),131,139)]"" S ABMDE=ABMDE_","_$TR($E(ABMREC(30,I),131,139)," ") ; Add First Name
.I $E(ABMREC(30,I),140)]"" S ABMDE=ABMDE_" "_$E(ABMREC(30,I),140) ; Add Middle Initial
.S ABMDE=ABMDE_"^^25" ; Insured's Name
.D WRT^ABMDF11W ; form locator #58
.S ABMDE=$E(ABMREC(30,I),144,145)_"^26^2" ; Pat relation to Ins
.D WRT^ABMDF11W ; form locator #59
.S ABMDE=$E(ABMREC(30,I),35,53)_"^29^19" ; Claim Certificate ID
.D WRT^ABMDF11W ; form locator #60
.S ABMDE=$E(ABMREC(30,I),97,110)_"^49^14" ; Insured Group Name
.D WRT^ABMDF11W ; form locator #61
.S ABMDE=$E(ABMREC(30,I),80,96)_"^64^17" ; Insurance Group Num
.D WRT^ABMDF11W ; Form locator #62
;
51 ;
N I
F I=50:10:70 D
.D @(I_"^ABMER40A")
N I
F I=1:1:3 D
.W !
.Q:'$D(ABMREC(30,I))
.S ABMDE=ABMR(40,(10*I)+40)_"^^18" ; Pro Authorization #
.D WRT^ABMDF11W ; form locator #63
.S ABMDE=$E(ABMREC(30,I),146)_"^19^1R" ; Employmnt Status code
.D WRT^ABMDF11W ; form locator #64
.S ABMDE=$E(ABMREC(31,I),87,110)_"^21^24" ; Employer name
.D WRT^ABMDF11W ; form locator #65
.S ABMTMPDE=$E(ABMREC(31,I),129,143) ; Employer city, state
.S ABMDE=$P(ABMTMPDE," ",1)
.N J
.F J=2:1:$L(ABMTMPDE," ") D
..I $P(ABMTMPDE," ",J)]"" S ABMDE=ABMDE_" "_$P(ABMTMPDE," ",J)
.I $E(ABMREC(31,I),144,145)'=" " S ABMDE=ABMDE_", "_$E(ABMREC(31,I),144,145)
.S ABMDE=ABMDE_"^46^35" ; Employer location
.D WRT^ABMDF11W ; form locator #66
;
55 ;
W !!
N I
F I=40:10:120 D
.D @(I_"^ABMER70A")
N I
F I=250,260 D
.D @(I_"^ABMER70")
S ABMDE=ABMR(70,40)_"^^6" ; Principle Diagnosis
D WRT^ABMDF11W ; form locator #67
S ABMDE=ABMR(70,50)_"^7^6" ; Other Diagnosis Code 1
D WRT^ABMDF11W ; form locator #68
S ABMDE=ABMR(70,60)_"^14^6" ; Other Diagnosis Code 2
D WRT^ABMDF11W ; form locator #69
S ABMDE=ABMR(70,70)_"^21^6" ; Other Diagnosis Code 3
D WRT^ABMDF11W ; form locator #70
S ABMDE=ABMR(70,80)_"^28^6" ; Other Diagnosis Code 4
D WRT^ABMDF11W ; form locator #71
S ABMDE=ABMR(70,90)_"^35^6" ; Other Diagnosis Code 5
D WRT^ABMDF11W ; form locator #72
S ABMDE=ABMR(70,100)_"^42^6" ; Other Diagnosis Code 6
D WRT^ABMDF11W ; form locator #73
S ABMDE=ABMR(70,110)_"^49^6" ; Other Diagnosis Code 7
D WRT^ABMDF11W ; form locator #74
S ABMDE=ABMR(70,120)_"^56^6" ; Other Diagnosis Code 8
D WRT^ABMDF11W ; form locator #75
S ABMDE=ABMR(70,250)_"^64^6" ; Admitting Diagnosis
D WRT^ABMDF11W ; form locator #76
S ABMDE=ABMR(70,260)_"^71^6" ; External cause of injury
D WRT^ABMDF11W ; form locator #77
;
56 ;
W !
D PROV^ABMDF11W
; Primary Provider State Liscence #
I ABMP("ITYPE")'="R" D ;only if not Medicare
.S ABMDE=$P($G(ABM("PRV",1)),"^",3)_"^59^23"
.D WRT^ABMDF11W ;form locator #82a
;
57 ;
W !
N I
F I=130:10:240,270 D
.D @(I_"^ABMER70")
S ABMDE=ABMR(70,270)_"^^1" ; Procedure coding method used
D WRT^ABMDF11W ; form locator #79
I $P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,9)'="N" D
.D WRT^ABMDF11W ; form locator #79
.S ABMDE=ABMR(70,130)_"^3^7" ; Principle Procedure code
.D WRT^ABMDF11W ; form locator #80a
.S ABMDE=ABMR(70,140)_"^11^6" ; Principle Procedure date
.D WRT^ABMDF11W ; form locator #80b
.S ABMDE=ABMR(70,150)_"^18^7" ; Other Procedure code - 1
.D WRT^ABMDF11W ; form locator #81a
.S ABMDE=ABMR(70,160)_"^26^6" ; Other Procedure date - 1
.D WRT^ABMDF11W ; form locator #81b
.S ABMDE=ABMR(70,170)_"^33^7" ; Other Procedure code - 2
.D WRT^ABMDF11W ; form locator #81c
.S ABMDE=ABMR(70,180)_"^41^6" ; Other Procedure date - 2
.D WRT^ABMDF11W ; form locator #81d
; Primary Provider UPIN/MCD #_name
S ABMDE=$P($G(ABM("PRV",1)),"^",1)_"^49^32"
D WRT^ABMDF11W ; form locator #82b
;
58 ;
; Secondary Provider Liscence #
W !
S ABMDE=$P($G(ABM("PRV",2)),"^",3)_"^59^23"
D WRT^ABMDF11W ; form locator #83a
;
59 ;
W !
S ABMDE=ABMR(70,190)_"^3^7" ; Other Procedure code - 3
D WRT^ABMDF11W ; form locator #81e
S ABMDE=ABMR(70,200)_"^11^6" ; Other Procedure date - 3
D WRT^ABMDF11W ; form locator #81f
S ABMDE=ABMR(70,210)_"^18^7" ; Other Procedure code - 4
D WRT^ABMDF11W ; form locator #81g
S ABMDE=ABMR(70,220)_"^26^6" ; Other Procedure date - 4
D WRT^ABMDF11W ; form locator #81h
S ABMDE=ABMR(70,230)_"^33^7" ; Other Procedure code - 5
D WRT^ABMDF11W ; form locator #81i
S ABMDE=ABMR(70,240)_"^41^6" ; Other Procedure date - 5
D WRT^ABMDF11W ; form locator #81j
; Secondary Provider UPIN/MCD #_name
S ABMDE=$P($G(ABM("PRV",2)),"^",1)_"^49^32"
D WRT^ABMDF11W ; form locator #83b
;
60 ;
W !
S ABMDE=$G(^ABMDBILL(DUZ(2),ABMP("BDFN"),61,1,0))_"^^48" ; remarks line 1
D WRT^ABMDF11W ; form locator #84a
S ABMDE=$P($G(ABM("PRV",3)),"^",3)_"^59^23" ; Tertiary Provider Liscence #
D WRT^ABMDF11W ; form locator #83c
;
61 ;
W !
S ABMDE=$G(^ABMDBILL(DUZ(2),ABMP("BDFN"),61,2,0))_"^^48" ; remarks line 2
D WRT^ABMDF11W ; form locator #84b
; Tertiary Provider UPIN/MCD #_name
S ABMDE=$P($G(ABM("PRV",3)),"^",1)_"^49^32"
D WRT^ABMDF11W ; form locator #83d
;
62 ;
W !
S ABMDE=$G(^ABMDBILL(DUZ(2),ABMP("BDFN"),61,3,0))_"^^48" ; remarks line 3
D WRT^ABMDF11W ; form locator #84c
;
63 ;
W !
S ABMDE=$G(^ABMDBILL(DUZ(2),ABMP("BDFN"),61,4,0))_"^^48" ; remarks line 4
D WRT^ABMDF11W ; form locator #84d
S ABMSIGN=$P($G(^ABMDPARM(DUZ(2),1,3)),"^",8) ; UB-92 Signature IEN
S:ABMSIGN="" ABMSIGN=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),1)),"^",4) ; Approving official IEN
S ABMDE=$P($G(^VA(200,+ABMSIGN,20)),"^",2)_"^51^23" ; Signature block printed name
D WRT^ABMDF11W ; form locator #85
S ABMDE=$E(DT,4,7)_$E(DT,2,3)_"^74^6" ; Today's date
D WRT^ABMDF11W ; form locator #86
Q
ABMDF11Z ; IHS/ASDST/DMJ - PRINT UB92 ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;Original;DMJ;
+3 ;
+4 ; IHS/ASDS/LSL - 04/05/00 - V2.4 Patch 1 - NOIS NCA-0300-180046
+5 ; Moved PROV to ABMDF11W because patching here would result in
+6 ; exceeding maximum routine size allowed.
+7 ;
+8 ; IHS/SD/SDR - v2.5 p9 - IM15561
+9 ; Only do state license number if not Medicare
+10 ;
+11 ; IHS/SD/SDR - v2.5 p10 - IM19557
+12 ; Correct due from patient
+13 ;
+14 ; IHS/SD/SDR - v2.5 p12 - IM24099
+15 ; Put CR/LF after quit in tag 47
+16 ; Removed extra - top of tag 51
+17 ;
45 ;
+1 ; ABMPAID = Primary + Secondary + Tertiary + Prepaid
+2 ; ABMPBAL = Gross amount - ABM("PAID")
+3 ; Form locator #57
+4 WRITE !
+5 ; If non-ben patient
+6 IF ABMP("ITYPE")="N"
Begin DoDot:1
+7 SET ABMPRPAY=+$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),"^",9)
+8 SET ABMPAID=+($EXTRACT($GET(ABMREC(30,1)),173,182)/100)+($EXTRACT($GET(ABMREC(30,2)),173,182)/100)+($EXTRACT($GET(ABMREC(30,3)),173,182)/100)+ABMPRPAY
+9 IF $GET(ABMPBAL)<0
SET ABMPBAL=0
+10 SET ABMDE=$TRANSLATE($FNUMBER(ABMPAID,"T",2),".")_"^45^10R"
+11 ; Total paid
DO WRT^ABMDF11W
+12 SET ABMDE=$TRANSLATE($FNUMBER(ABMPBAL,"T",2),".")_"^56^10R"
+13 ; Remaining balance
DO WRT^ABMDF11W
End DoDot:1
+14 ;
47 ;
+1 WRITE !
+2 NEW I
+3 FOR I=1:1:3
Begin DoDot:1
+4 IF '$DATA(ABMREC(30,I))
QUIT
+5 ; Insured's last name
SET ABMDE=$EXTRACT(ABMREC(30,I),111,130)
+6 SET ABMDE=$TRANSLATE(ABMDE," ")
+7 ; Add First Name
IF $EXTRACT(ABMREC(30,I),131,139)]""
SET ABMDE=ABMDE_","_$TRANSLATE($EXTRACT(ABMREC(30,I),131,139)," ")
+8 ; Add Middle Initial
IF $EXTRACT(ABMREC(30,I),140)]""
SET ABMDE=ABMDE_" "_$EXTRACT(ABMREC(30,I),140)
+9 ; Insured's Name
SET ABMDE=ABMDE_"^^25"
+10 ; form locator #58
DO WRT^ABMDF11W
+11 ; Pat relation to Ins
SET ABMDE=$EXTRACT(ABMREC(30,I),144,145)_"^26^2"
+12 ; form locator #59
DO WRT^ABMDF11W
+13 ; Claim Certificate ID
SET ABMDE=$EXTRACT(ABMREC(30,I),35,53)_"^29^19"
+14 ; form locator #60
DO WRT^ABMDF11W
+15 ; Insured Group Name
SET ABMDE=$EXTRACT(ABMREC(30,I),97,110)_"^49^14"
+16 ; form locator #61
DO WRT^ABMDF11W
+17 ; Insurance Group Num
SET ABMDE=$EXTRACT(ABMREC(30,I),80,96)_"^64^17"
+18 ; Form locator #62
DO WRT^ABMDF11W
End DoDot:1
+19 ;
51 ;
+1 NEW I
+2 FOR I=50:10:70
Begin DoDot:1
+3 DO @(I_"^ABMER40A")
End DoDot:1
+4 NEW I
+5 FOR I=1:1:3
Begin DoDot:1
+6 WRITE !
+7 IF '$DATA(ABMREC(30,I))
QUIT
+8 ; Pro Authorization #
SET ABMDE=ABMR(40,(10*I)+40)_"^^18"
+9 ; form locator #63
DO WRT^ABMDF11W
+10 ; Employmnt Status code
SET ABMDE=$EXTRACT(ABMREC(30,I),146)_"^19^1R"
+11 ; form locator #64
DO WRT^ABMDF11W
+12 ; Employer name
SET ABMDE=$EXTRACT(ABMREC(31,I),87,110)_"^21^24"
+13 ; form locator #65
DO WRT^ABMDF11W
+14 ; Employer city, state
SET ABMTMPDE=$EXTRACT(ABMREC(31,I),129,143)
+15 SET ABMDE=$PIECE(ABMTMPDE," ",1)
+16 NEW J
+17 FOR J=2:1:$LENGTH(ABMTMPDE," ")
Begin DoDot:2
+18 IF $PIECE(ABMTMPDE," ",J)]""
SET ABMDE=ABMDE_" "_$PIECE(ABMTMPDE," ",J)
End DoDot:2
+19 IF $EXTRACT(ABMREC(31,I),144,145)'=" "
SET ABMDE=ABMDE_", "_$EXTRACT(ABMREC(31,I),144,145)
+20 ; Employer location
SET ABMDE=ABMDE_"^46^35"
+21 ; form locator #66
DO WRT^ABMDF11W
End DoDot:1
+22 ;
55 ;
+1 WRITE !!
+2 NEW I
+3 FOR I=40:10:120
Begin DoDot:1
+4 DO @(I_"^ABMER70A")
End DoDot:1
+5 NEW I
+6 FOR I=250,260
Begin DoDot:1
+7 DO @(I_"^ABMER70")
End DoDot:1
+8 ; Principle Diagnosis
SET ABMDE=ABMR(70,40)_"^^6"
+9 ; form locator #67
DO WRT^ABMDF11W
+10 ; Other Diagnosis Code 1
SET ABMDE=ABMR(70,50)_"^7^6"
+11 ; form locator #68
DO WRT^ABMDF11W
+12 ; Other Diagnosis Code 2
SET ABMDE=ABMR(70,60)_"^14^6"
+13 ; form locator #69
DO WRT^ABMDF11W
+14 ; Other Diagnosis Code 3
SET ABMDE=ABMR(70,70)_"^21^6"
+15 ; form locator #70
DO WRT^ABMDF11W
+16 ; Other Diagnosis Code 4
SET ABMDE=ABMR(70,80)_"^28^6"
+17 ; form locator #71
DO WRT^ABMDF11W
+18 ; Other Diagnosis Code 5
SET ABMDE=ABMR(70,90)_"^35^6"
+19 ; form locator #72
DO WRT^ABMDF11W
+20 ; Other Diagnosis Code 6
SET ABMDE=ABMR(70,100)_"^42^6"
+21 ; form locator #73
DO WRT^ABMDF11W
+22 ; Other Diagnosis Code 7
SET ABMDE=ABMR(70,110)_"^49^6"
+23 ; form locator #74
DO WRT^ABMDF11W
+24 ; Other Diagnosis Code 8
SET ABMDE=ABMR(70,120)_"^56^6"
+25 ; form locator #75
DO WRT^ABMDF11W
+26 ; Admitting Diagnosis
SET ABMDE=ABMR(70,250)_"^64^6"
+27 ; form locator #76
DO WRT^ABMDF11W
+28 ; External cause of injury
SET ABMDE=ABMR(70,260)_"^71^6"
+29 ; form locator #77
DO WRT^ABMDF11W
+30 ;
56 ;
+1 WRITE !
+2 DO PROV^ABMDF11W
+3 ; Primary Provider State Liscence #
+4 ;only if not Medicare
IF ABMP("ITYPE")'="R"
Begin DoDot:1
+5 SET ABMDE=$PIECE($GET(ABM("PRV",1)),"^",3)_"^59^23"
+6 ;form locator #82a
DO WRT^ABMDF11W
End DoDot:1
+7 ;
57 ;
+1 WRITE !
+2 NEW I
+3 FOR I=130:10:240,270
Begin DoDot:1
+4 DO @(I_"^ABMER70")
End DoDot:1
+5 ; Procedure coding method used
SET ABMDE=ABMR(70,270)_"^^1"
+6 ; form locator #79
DO WRT^ABMDF11W
+7 IF $PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,9)'="N"
Begin DoDot:1
+8 ; form locator #79
DO WRT^ABMDF11W
+9 ; Principle Procedure code
SET ABMDE=ABMR(70,130)_"^3^7"
+10 ; form locator #80a
DO WRT^ABMDF11W
+11 ; Principle Procedure date
SET ABMDE=ABMR(70,140)_"^11^6"
+12 ; form locator #80b
DO WRT^ABMDF11W
+13 ; Other Procedure code - 1
SET ABMDE=ABMR(70,150)_"^18^7"
+14 ; form locator #81a
DO WRT^ABMDF11W
+15 ; Other Procedure date - 1
SET ABMDE=ABMR(70,160)_"^26^6"
+16 ; form locator #81b
DO WRT^ABMDF11W
+17 ; Other Procedure code - 2
SET ABMDE=ABMR(70,170)_"^33^7"
+18 ; form locator #81c
DO WRT^ABMDF11W
+19 ; Other Procedure date - 2
SET ABMDE=ABMR(70,180)_"^41^6"
+20 ; form locator #81d
DO WRT^ABMDF11W
End DoDot:1
+21 ; Primary Provider UPIN/MCD #_name
+22 SET ABMDE=$PIECE($GET(ABM("PRV",1)),"^",1)_"^49^32"
+23 ; form locator #82b
DO WRT^ABMDF11W
+24 ;
58 ;
+1 ; Secondary Provider Liscence #
+2 WRITE !
+3 SET ABMDE=$PIECE($GET(ABM("PRV",2)),"^",3)_"^59^23"
+4 ; form locator #83a
DO WRT^ABMDF11W
+5 ;
59 ;
+1 WRITE !
+2 ; Other Procedure code - 3
SET ABMDE=ABMR(70,190)_"^3^7"
+3 ; form locator #81e
DO WRT^ABMDF11W
+4 ; Other Procedure date - 3
SET ABMDE=ABMR(70,200)_"^11^6"
+5 ; form locator #81f
DO WRT^ABMDF11W
+6 ; Other Procedure code - 4
SET ABMDE=ABMR(70,210)_"^18^7"
+7 ; form locator #81g
DO WRT^ABMDF11W
+8 ; Other Procedure date - 4
SET ABMDE=ABMR(70,220)_"^26^6"
+9 ; form locator #81h
DO WRT^ABMDF11W
+10 ; Other Procedure code - 5
SET ABMDE=ABMR(70,230)_"^33^7"
+11 ; form locator #81i
DO WRT^ABMDF11W
+12 ; Other Procedure date - 5
SET ABMDE=ABMR(70,240)_"^41^6"
+13 ; form locator #81j
DO WRT^ABMDF11W
+14 ; Secondary Provider UPIN/MCD #_name
+15 SET ABMDE=$PIECE($GET(ABM("PRV",2)),"^",1)_"^49^32"
+16 ; form locator #83b
DO WRT^ABMDF11W
+17 ;
60 ;
+1 WRITE !
+2 ; remarks line 1
SET ABMDE=$GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),61,1,0))_"^^48"
+3 ; form locator #84a
DO WRT^ABMDF11W
+4 ; Tertiary Provider Liscence #
SET ABMDE=$PIECE($GET(ABM("PRV",3)),"^",3)_"^59^23"
+5 ; form locator #83c
DO WRT^ABMDF11W
+6 ;
61 ;
+1 WRITE !
+2 ; remarks line 2
SET ABMDE=$GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),61,2,0))_"^^48"
+3 ; form locator #84b
DO WRT^ABMDF11W
+4 ; Tertiary Provider UPIN/MCD #_name
+5 SET ABMDE=$PIECE($GET(ABM("PRV",3)),"^",1)_"^49^32"
+6 ; form locator #83d
DO WRT^ABMDF11W
+7 ;
62 ;
+1 WRITE !
+2 ; remarks line 3
SET ABMDE=$GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),61,3,0))_"^^48"
+3 ; form locator #84c
DO WRT^ABMDF11W
+4 ;
63 ;
+1 WRITE !
+2 ; remarks line 4
SET ABMDE=$GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),61,4,0))_"^^48"
+3 ; form locator #84d
DO WRT^ABMDF11W
+4 ; UB-92 Signature IEN
SET ABMSIGN=$PIECE($GET(^ABMDPARM(DUZ(2),1,3)),"^",8)
+5 ; Approving official IEN
IF ABMSIGN=""
SET ABMSIGN=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),1)),"^",4)
+6 ; Signature block printed name
SET ABMDE=$PIECE($GET(^VA(200,+ABMSIGN,20)),"^",2)_"^51^23"
+7 ; form locator #85
DO WRT^ABMDF11W
+8 ; Today's date
SET ABMDE=$EXTRACT(DT,4,7)_$EXTRACT(DT,2,3)_"^74^6"
+9 ; form locator #86
DO WRT^ABMDF11W
+10 QUIT
