ABMDF51Z ;IHS/DSD/DMJ/LSL - PRINT UB92
;;2.6;IHS 3P BILLING SYSTEM;**14,21**;NOV 12, 2009;Build 379
;Original;DMJ;
;
;IHS/SD/SDR - v2.5 p9 - IM15936 - Added check for Medi-Cal
;IHS/SD/SDR - v2.5 p9 - IM17233 - Removed "." from Dxs
;IHS/SD/SDR - v2.5 p10 - IM20981 - Correction to error <UNDEF>58+14^ABMDF51Z
;IHS/SD/SDR - v2.5 p11 - IM24315 - Made FL 64/65/66 not print for Medi-Cal
;
;IHS/SD/SDR - 2.6*21 - HEAT123457 - Updated 61044 checks from 'equals' to 'contains'
;
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 ABMPBAL=+$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),2)),"^",3)-ABMPAID
. S: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))
.;Q:$E(ABMREC(30,I),26,30)'=61044 ;abm*2.6*21 IHS/SD/SDR HEAT123457
.Q:$E(ABMREC(30,I),26,30)'["61044" ;abm*2.6*21 IHS/SD/SDR HEAT123457
.Q:I'=$G(ABMFLAG)
.W !
.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
.S ABMDE=$E(ABMREC(30,I),144,145)_"^26^2" ; Pat relation to Ins
.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
.S ABMDE=$E(ABMREC(30,I),80,96)_"^64^17" ; Insurance Group Num
W:'$G(ABMFLAG) !
W !!
K ABMQUIT,ABMFLAG
;
51 ;
W !
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
.;I $$RCID^ABMERUTL(ABMP("INS"))=61044 Q ;abm*2.6*21 IHS/SD/SDR HEAT123457
.I $$RCID^ABMERUTL(ABMP("INS"))["61044" Q ;abm*2.6*21 IHS/SD/SDR HEAT123457
.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=$TR(ABMR(70,40),".")_"^^6" ; Principle Diagnosis
D WRT^ABMDF11W ; form locator #67
S ABMDE=$TR(ABMR(70,50),".")_"^7^6" ; Other Diagnosis Code 1
D WRT^ABMDF11W ; form locator #68
S ABMDE=$TR(ABMR(70,60),".")_"^14^6" ; Other Diagnosis Code 2
D WRT^ABMDF11W ; form locator #69
S ABMDE=$TR(ABMR(70,70),".")_"^21^6" ; Other Diagnosis Code 3
D WRT^ABMDF11W ; form locator #70
S ABMDE=$TR(ABMR(70,80),".")_"^28^6" ; Other Diagnosis Code 4
D WRT^ABMDF11W ; form locator #71
S ABMDE=$TR(ABMR(70,90),".")_"^35^6" ; Other Diagnosis Code 5
D WRT^ABMDF11W ; form locator #72
S ABMDE=$TR(ABMR(70,100),".")_"^42^6" ; Other Diagnosis Code 6
D WRT^ABMDF11W ; form locator #73
S ABMDE=$TR(ABMR(70,110),".")_"^49^6" ; Other Diagnosis Code 7
D WRT^ABMDF11W ; form locator #74
S ABMDE=$TR(ABMR(70,120),".")_"^56^6" ; Other Diagnosis Code 8
D WRT^ABMDF11W ; form locator #75
S ABMDE=$TR(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
; Primary Provider State License #
S ABMDE=$P($G(ABM("PRV",1)),"^",3)_"^59^23"
;
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
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)),U)_"^49^32"
;
58 ;
; Secondary Provider License #
W !
S ABMDE=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),0)),"^",8)_"^59^23"
;I $$RCID^ABMERUTL(ABMP("INS"))=61044 D ;as long as we are talking MEDI-CAL ;abm*2.6*21 IHS/SD/SDR HEAT123457
I $$RCID^ABMERUTL(ABMP("INS"))["61044" D ;as long as we are talking MEDI-CAL ;abm*2.6*21 IHS/SD/SDR HEAT123457
.N ABMDFX,ABMDFP,ABMDFO
.;Get Attending provider dfn from Bill file-
.S ABMDFX=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","A",""))
.S ABMDFP=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,ABMDFX,0),"^")
.;Get O/P MEDI-CAL 9 dfn from Insurer file
.S ABMDFO=$O(^AUTNINS("B","O/P MEDI-CAL 9",""))
.;Get PIN out of the 3P Insurer file Provider multiple, 3rd subscript
.Q:ABMDFO="" ;didn't find entry
.S ABMDE=$P($G(^ABMNINS(DUZ(2),ABMDFO,3,ABMDFP,0)),"^",2)_"^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)),U)_"^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)),U)_"^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
;
PROV ;
; PROVIDER INFORMATION
; ABM("PRV",#) = UPIN/MCD #_Provider name ^ UPIN/MCD# ^
; Provider State License Number
S ABMPRVTP=0 ; Initialize Provider Type
S ABMPCNT=0 ; Initialize Provider Count
F S ABMPRVTP=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C",ABMPRVTP)) Q:ABMPRVTP="" D
. S ABMPRVNO=0 ; Initialize Provider Number
. F S ABMPRVNO=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C",ABMPRVTP,ABMPRVNO)) Q:'ABMPRVNO D
. . ; NEW PERSON file IEN
. . S ABMPRV=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,ABMPRVNO,0),U)
. . S ABMPCNT=ABMPCNT+1 ; Increment provider count
. . Q:ABMPCNT>3 ; only 1st 3 providers
. . S ABM("PRV",ABMPCNT)=$P($G(^VA(200,ABMPRV,0)),U) ; Provider name
. . S ABM("PRV",ABMPCNT)=$TR(ABM("PRV",ABMPCNT),","," ")
. . ; If Medicare FI, find provider UPIN
. . I ABMP("ITYPE")="R" D
. . . S ABMUPIN=$P($G(^VA(200,ABMPRV,9999999)),"^",8)
. . . S:ABMUPIN="" ABMUPIN="PHS000"
. . . Q
. . S $P(ABM("PRV",ABMPCNT),"^",2)=$S(ABMP("ITYPE")="D":$P(^VA(200,ABMPRV,9999999),"^",7),ABMP("ITYPE")="R":ABMUPIN,1:"")
. . S:$P(ABM("PRV",ABMPCNT),"^",2)]"" $P(ABM("PRV",ABMPCNT),"^")=$P(ABM("PRV",ABMPCNT),"^",2)_" "_$P(ABM("PRV",ABMPCNT),"^")
. . S ABMVST=$P($G(^AUTTLOC(+ABMP("LDFN"),0)),"^",23) ; state IEN
. . S:ABMVST="" ABMVST=$P($G(^AUTTLOC(+ABMP("LDFN"),0)),"^",14)
. . S $P(ABM("PRV",ABMPCNT),"^",3)=$$SLN^ABMERUTL(ABMPRV,ABMVST) ; Provider State License number
Q
ABMDF51Z ;IHS/DSD/DMJ/LSL - PRINT UB92
+1 ;;2.6;IHS 3P BILLING SYSTEM;**14,21**;NOV 12, 2009;Build 379
+2 ;Original;DMJ;
+3 ;
+4 ;IHS/SD/SDR - v2.5 p9 - IM15936 - Added check for Medi-Cal
+5 ;IHS/SD/SDR - v2.5 p9 - IM17233 - Removed "." from Dxs
+6 ;IHS/SD/SDR - v2.5 p10 - IM20981 - Correction to error <UNDEF>58+14^ABMDF51Z
+7 ;IHS/SD/SDR - v2.5 p11 - IM24315 - Made FL 64/65/66 not print for Medi-Cal
+8 ;
+9 ;IHS/SD/SDR - 2.6*21 - HEAT123457 - Updated 61044 checks from 'equals' to 'contains'
+10 ;
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 SET ABMPBAL=+$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),2)),"^",3)-ABMPAID
+10 IF ABMPBAL<0
SET ABMPBAL=0
+11 SET ABMDE=$TRANSLATE($FNUMBER(ABMPAID,"T",2),".")_"^45^10R"
+12 ; Total paid
DO WRT^ABMDF11W
+13 SET ABMDE=$TRANSLATE($FNUMBER(ABMPBAL,"T",2),".")_"^56^10R"
+14 ; Remaining balance
DO WRT^ABMDF11W
End DoDot:1
+15 ;
47 ;
+1 WRITE !
+2 NEW I
+3 FOR I=1:1:3
Begin DoDot:1
+4 IF '$DATA(ABMREC(30,I))
QUIT
+5 ;Q:$E(ABMREC(30,I),26,30)'=61044 ;abm*2.6*21 IHS/SD/SDR HEAT123457
+6 ;abm*2.6*21 IHS/SD/SDR HEAT123457
IF $EXTRACT(ABMREC(30,I),26,30)'["61044"
QUIT
+7 IF I'=$GET(ABMFLAG)
QUIT
+8 WRITE !
+9 ; Insured's last name
SET ABMDE=$EXTRACT(ABMREC(30,I),111,130)
+10 SET ABMDE=$TRANSLATE(ABMDE," ")
+11 ; Add First Name
IF $EXTRACT(ABMREC(30,I),131,139)]""
SET ABMDE=ABMDE_","_$TRANSLATE($EXTRACT(ABMREC(30,I),131,139)," ")
+12 ; Add Middle Initial
IF $EXTRACT(ABMREC(30,I),140)]""
SET ABMDE=ABMDE_" "_$EXTRACT(ABMREC(30,I),140)
+13 ; Insured's Name
SET ABMDE=ABMDE_"^^25"
+14 ; Pat relation to Ins
SET ABMDE=$EXTRACT(ABMREC(30,I),144,145)_"^26^2"
+15 ; Claim Certificate ID
SET ABMDE=$EXTRACT(ABMREC(30,I),35,53)_"^29^19"
+16 ; form locator #60
DO WRT^ABMDF11W
+17 ; Insured Group Name
SET ABMDE=$EXTRACT(ABMREC(30,I),97,110)_"^49^14"
+18 ; Insurance Group Num
SET ABMDE=$EXTRACT(ABMREC(30,I),80,96)_"^64^17"
End DoDot:1
+19 IF '$GET(ABMFLAG)
WRITE !
+20 WRITE !!
+21 KILL ABMQUIT,ABMFLAG
+22 ;
51 ;
+1 WRITE !
+2 NEW I
+3 FOR I=50:10:70
Begin DoDot:1
+4 DO @(I_"^ABMER40A")
End DoDot:1
+5 NEW I
+6 FOR I=1:1:3
Begin DoDot:1
+7 WRITE !
+8 IF '$DATA(ABMREC(30,I))
QUIT
+9 ; Pro Authorization #
SET ABMDE=ABMR(40,(10*I)+40)_"^^18"
+10 ; form locator #63
DO WRT^ABMDF11W
+11 ;I $$RCID^ABMERUTL(ABMP("INS"))=61044 Q ;abm*2.6*21 IHS/SD/SDR HEAT123457
+12 ;abm*2.6*21 IHS/SD/SDR HEAT123457
IF $$RCID^ABMERUTL(ABMP("INS"))["61044"
QUIT
+13 ; Employmnt Status code
SET ABMDE=$EXTRACT(ABMREC(30,I),146)_"^19^1R"
+14 ; form locator #64
DO WRT^ABMDF11W
+15 ; Employer name
SET ABMDE=$EXTRACT(ABMREC(31,I),87,110)_"^21^24"
+16 ; form locator #65
DO WRT^ABMDF11W
+17 ; Employer city, state
SET ABMTMPDE=$EXTRACT(ABMREC(31,I),129,143)
+18 SET ABMDE=$PIECE(ABMTMPDE," ",1)
+19 NEW J
+20 FOR J=2:1:$LENGTH(ABMTMPDE," ")
Begin DoDot:2
+21 IF $PIECE(ABMTMPDE," ",J)]""
SET ABMDE=ABMDE_" "_$PIECE(ABMTMPDE," ",J)
End DoDot:2
+22 IF $EXTRACT(ABMREC(31,I),144,145)'=" "
SET ABMDE=ABMDE_", "_$EXTRACT(ABMREC(31,I),144,145)
+23 ; Employer location
SET ABMDE=ABMDE_"^46^35"
+24 ; form locator #66
DO WRT^ABMDF11W
End DoDot:1
+25 ;
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=$TRANSLATE(ABMR(70,40),".")_"^^6"
+9 ; form locator #67
DO WRT^ABMDF11W
+10 ; Other Diagnosis Code 1
SET ABMDE=$TRANSLATE(ABMR(70,50),".")_"^7^6"
+11 ; form locator #68
DO WRT^ABMDF11W
+12 ; Other Diagnosis Code 2
SET ABMDE=$TRANSLATE(ABMR(70,60),".")_"^14^6"
+13 ; form locator #69
DO WRT^ABMDF11W
+14 ; Other Diagnosis Code 3
SET ABMDE=$TRANSLATE(ABMR(70,70),".")_"^21^6"
+15 ; form locator #70
DO WRT^ABMDF11W
+16 ; Other Diagnosis Code 4
SET ABMDE=$TRANSLATE(ABMR(70,80),".")_"^28^6"
+17 ; form locator #71
DO WRT^ABMDF11W
+18 ; Other Diagnosis Code 5
SET ABMDE=$TRANSLATE(ABMR(70,90),".")_"^35^6"
+19 ; form locator #72
DO WRT^ABMDF11W
+20 ; Other Diagnosis Code 6
SET ABMDE=$TRANSLATE(ABMR(70,100),".")_"^42^6"
+21 ; form locator #73
DO WRT^ABMDF11W
+22 ; Other Diagnosis Code 7
SET ABMDE=$TRANSLATE(ABMR(70,110),".")_"^49^6"
+23 ; form locator #74
DO WRT^ABMDF11W
+24 ; Other Diagnosis Code 8
SET ABMDE=$TRANSLATE(ABMR(70,120),".")_"^56^6"
+25 ; form locator #75
DO WRT^ABMDF11W
+26 ; Admitting Diagnosis
SET ABMDE=$TRANSLATE(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
+3 ; Primary Provider State License #
+4 SET ABMDE=$PIECE($GET(ABM("PRV",1)),"^",3)_"^59^23"
+5 ;
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 ; Principle Procedure code
SET ABMDE=ABMR(70,130)_"^3^7"
+8 ; form locator #80a
DO WRT^ABMDF11W
+9 ; Principle Procedure date
SET ABMDE=ABMR(70,140)_"^11^6"
+10 ; form locator #80b
DO WRT^ABMDF11W
+11 ; Other Procedure code - 1
SET ABMDE=ABMR(70,150)_"^18^7"
+12 ; form locator #81a
DO WRT^ABMDF11W
+13 ; Other Procedure date - 1
SET ABMDE=ABMR(70,160)_"^26^6"
+14 ; form locator #81b
DO WRT^ABMDF11W
+15 ; Other Procedure code - 2
SET ABMDE=ABMR(70,170)_"^33^7"
+16 ; form locator #81c
DO WRT^ABMDF11W
+17 ; Other Procedure date - 2
SET ABMDE=ABMR(70,180)_"^41^6"
+18 ; form locator #81d
DO WRT^ABMDF11W
+19 ; Primary Provider UPIN/MCD #_name
+20 SET ABMDE=$PIECE($GET(ABM("PRV",1)),U)_"^49^32"
+21 ;
58 ;
+1 ; Secondary Provider License #
+2 WRITE !
+3 SET ABMDE=$PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),0)),"^",8)_"^59^23"
+4 ;I $$RCID^ABMERUTL(ABMP("INS"))=61044 D ;as long as we are talking MEDI-CAL ;abm*2.6*21 IHS/SD/SDR HEAT123457
+5 ;as long as we are talking MEDI-CAL ;abm*2.6*21 IHS/SD/SDR HEAT123457
IF $$RCID^ABMERUTL(ABMP("INS"))["61044"
Begin DoDot:1
+6 NEW ABMDFX,ABMDFP,ABMDFO
+7 ;Get Attending provider dfn from Bill file-
+8 SET ABMDFX=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","A",""))
+9 SET ABMDFP=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,ABMDFX,0),"^")
+10 ;Get O/P MEDI-CAL 9 dfn from Insurer file
+11 SET ABMDFO=$ORDER(^AUTNINS("B","O/P MEDI-CAL 9",""))
+12 ;Get PIN out of the 3P Insurer file Provider multiple, 3rd subscript
+13 ;didn't find entry
IF ABMDFO=""
QUIT
+14 SET ABMDE=$PIECE($GET(^ABMNINS(DUZ(2),ABMDFO,3,ABMDFP,0)),"^",2)_"^59^23"
End DoDot:1
+15 ; form locator #83a
DO WRT^ABMDF11W
+16 ;
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)),U)_"^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)),U)_"^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
+11 ;
PROV ;
+1 ; PROVIDER INFORMATION
+2 ; ABM("PRV",#) = UPIN/MCD #_Provider name ^ UPIN/MCD# ^
+3 ; Provider State License Number
+4 ; Initialize Provider Type
SET ABMPRVTP=0
+5 ; Initialize Provider Count
SET ABMPCNT=0
+6 FOR
SET ABMPRVTP=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C",ABMPRVTP))
IF ABMPRVTP=""
QUIT
Begin DoDot:1
+7 ; Initialize Provider Number
SET ABMPRVNO=0
+8 FOR
SET ABMPRVNO=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C",ABMPRVTP,ABMPRVNO))
IF 'ABMPRVNO
QUIT
Begin DoDot:2
+9 ; NEW PERSON file IEN
+10 SET ABMPRV=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,ABMPRVNO,0),U)
+11 ; Increment provider count
SET ABMPCNT=ABMPCNT+1
+12 ; only 1st 3 providers
IF ABMPCNT>3
QUIT
+13 ; Provider name
SET ABM("PRV",ABMPCNT)=$PIECE($GET(^VA(200,ABMPRV,0)),U)
+14 SET ABM("PRV",ABMPCNT)=$TRANSLATE(ABM("PRV",ABMPCNT),","," ")
+15 ; If Medicare FI, find provider UPIN
+16 IF ABMP("ITYPE")="R"
Begin DoDot:3
+17 SET ABMUPIN=$PIECE($GET(^VA(200,ABMPRV,9999999)),"^",8)
+18 IF ABMUPIN=""
SET ABMUPIN="PHS000"
+19 QUIT
End DoDot:3
+20 SET $PIECE(ABM("PRV",ABMPCNT),"^",2)=$SELECT(ABMP("ITYPE")="D":$PIECE(^VA(200,ABMPRV,9999999),"^",7),ABMP("ITYPE")="R":ABMUPIN,1:"")
+21 IF $PIECE(ABM("PRV",ABMPCNT),"^",2)]""
SET $PIECE(ABM("PRV",ABMPCNT),"^")=$PIECE(ABM("PRV",ABMPCNT),"^",2)_" "_$PIECE(ABM("PRV",ABMPCNT),"^")
+22 ; state IEN
SET ABMVST=$PIECE($GET(^AUTTLOC(+ABMP("LDFN"),0)),"^",23)
+23 IF ABMVST=""
SET ABMVST=$PIECE($GET(^AUTTLOC(+ABMP("LDFN"),0)),"^",14)
+24 ; Provider State License number
SET $PIECE(ABM("PRV",ABMPCNT),"^",3)=$$SLN^ABMERUTL(ABMPRV,ABMVST)
End DoDot:2
End DoDot:1
+25 QUIT
