ABMER20A ; IHS/ASDST/DMJ - UB92 EMC RECORD 20 (Patient) cont'd ;
;;2.6;IHS 3P BILLING SYSTEM;**21**;NOV 12, 2009;Build 379
;Original;DMJ;02/07/96 12:33 PM
;
;IHS/DSD/DMJ - 7/15/1999 NOIS BXX-0799-150034 Patch 3 #3
; Modified to allow spaces in patient last name
; IHS/ASDS/DMJ - 04/20/00 - V2.4 Patch 1 - NOIS HQW-0500-100040
; Modified location code to check for satellite first. If no satellite, use parent.
; IHS/ASDS/LSL - 07/10/00 - V2.4 Path 2 - NOIS NDA-0700-180029
; Modified to strip off the leading zero of admission source and admission type.
; IHS/ASDS/LSL - 09/06/00 - V2.4 Patch 3 - NOIS CAA-0900-110008
; If nothing in admission source or type, make it null instead of 0 (zero).
; IHS/ASDS/SDH - 09/27/01 - v2.4 Patch 9 - NOIS XAA-0901-200095
; After moving Kidscare to Page 5 from Page 7 found that there are checks that are done for Medicaid that should also
; be done for Kidscare.
;
;IHS/SD/SDR - 2.6*21 - HEAT169641 - Include comma and middle initial if AO Control# is 61044
;
; *********************************************************************
;
LOOP ;LOOP HERE
F I=10:10:110 D
.D @I
.I $D(^ABMEXLM("AA",+$G(ABMP("INS")),+$G(ABMP("EXP")),20,I)) D @(^(I))
.I '$G(ABMP("NOFMT")) S ABMREC(20)=$G(ABMREC(20))_ABMR(20,I)
Q
;
10 ;Record type
S ABMR(20,10)=20
Q
;
20 ;Filler
S ABMR(20,20)=""
S ABMR(20,20)=$$FMT^ABMERUTL(ABMR(20,20),2)
Q
;
30 ;Patient Control Number, (SOURCE: FILE=9000001.41,FIELD=.02)
S ABMR(20,30)=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U)
I $P($G(^ABMDPARM(DUZ(2),1,2)),"^",4)'="" D
.S $P(ABMR(20,30),"-",2)=$P($G(^ABMDPARM(DUZ(2),1,2)),"^",4)
I $P($G(^ABMDPARM(DUZ(2),1,4)),"^",9) D
.Q:ABMP("LDFN")=DUZ(2)
.Q:$P($G(^ABMDPARM(ABMP("LDFN"),1,2)),"^",4)=""
.S $P(ABMR(20,30),"-",2)=$P(^ABMDPARM(ABMP("LDFN"),1,2),"^",4)
I $P($G(^ABMDPARM(DUZ(2),1,3)),"^",3) D
.D 250^ABMER20
.Q:$TR(ABMR(20,250)," ")=""
.S ABMR(20,30)=ABMR(20,30)_"-"_ABMR(20,250)
S ABMR(20,30)=$$FMT^ABMERUTL(ABMR(20,30),20)
Q
;
40 ;Patient Last Name (SOURCE: FILE=2, FIELD=.01)
; form locator #12
I '$D(ABME("PNM")) D PNM
S ABMR(20,40)=$P(ABME("PNM"),",",1)
I $G(ABMP("EXP"))=10 S ABMR(20,40)=$TR(ABMR(20,40),"-.,'/")
S ABMR(20,40)=$$FMT^ABMERUTL(ABMR(20,40),20)
Q
;
50 ;Patient First Name (SOURCE: FILE=2, FIELD=.01)
; form locator #12
I '$D(ABME("PNM")) D PNM
S ABMR(20,50)=$P(ABME("PNM"),",",2)
D
.Q:ABMR(20,50)="BABY BOY"
.Q:ABMR(20,50)="BABY GIRL"
.S ABMR(20,50)=$P(ABMR(20,50)," ",1)
S ABMR(20,50)=$$FMT^ABMERUTL(ABMR(20,50),9)
Q
;
60 ;Patient Middle Initial (SOURCE: FILE=2, FIELD=.01)
; form locator #12
I '$D(ABME("PNM")) D PNM
S ABMR(20,60)=$P(ABME("PNM"),",",2)
I ABMR(20,60)="BABY BOY" S ABMR(20,60)=" " Q
I ABMR(20,60)="BABY GIRL" S ABMR(20,60)=" " Q
S ABMR(20,60)=$P(ABMR(20,60)," ",2)
S ABMR(20,60)=$E(ABMR(20,60))
I ($$RCID^ABMERUTL(ABMP("INS"))[61044) S ABMR(20,60)=$P(ABME("PNM"),",",3) ;abm*2.6*21 IHS/SD/SDR HEAT169641
S ABMR(20,60)=$$FMT^ABMERUTL(ABMR(20,60),1)
Q
;
70 ;Patient Sex Code (SOURCE: FILE=2, FIELD=.02)
; form locator #15
I '$D(ABME("SEX")) D PNM
S ABMR(20,70)=$S(ABME("SEX")="":"U",1:ABME("SEX"))
Q
;
80 ;Patient's Birth Date (SOURCE: FILE=2, FIELD=.03)
; form locator #14
I '$D(ABME("DOB")) D PNM
S ABMR(20,80)=$$Y2KDT^ABMDUTL(ABME("DOB"))
Q
;
90 ;Marital Status Code (SOURCE: FILE=2, FIELD=.05)
; form locator #16
I '$D(ABME("MS")) D PNM
S ABMR(20,90)=$S(ABME("MS")=1:"D",ABME("MS")=2:"M",ABME("MS")=4:"W",ABME("MS")=5:"X",ABME("MS")=6:"S",1:"U")
Q
;
100 ;Type of Admission (SOURCE: FILE=9002274.4, FIELD=.51)
; form locator #19
S ABME("FLD")=.51
D DIQ1
S ABMR(20,100)=+ABM(9002274.4,ABMP("BDFN"),.51,"E")
; if type of admission is "" and visit type is outpatient and
; insurance type is Medicare FI set type of admission to 1
I 'ABMR(20,100),ABMP("VTYP")=131,ABMP("ITYPE")="R" S ABMR(20,100)=1
S:'ABMR(20,100) ABMR(20,100)=""
S ABMR(20,100)=$$FMT^ABMERUTL(ABMR(20,100),1)
Q
;
110 ;Source of Admission (SOURCE: FILE=9002274.4, FIELD=.52)
; form locator #20
S ABME("FLD")=.52
D DIQ1
S ABMR(20,110)=+ABM(9002274.4,ABMP("BDFN"),.52,"E")
; if type of admission is "" and visit type is outpatient and
; insurance type is Medicare FI set type of admission to 1
I 'ABMR(20,110),ABMP("VTYP")=131,ABMP("ITYPE")="R" S ABMR(20,110)=1
S:'ABMR(20,110) ABMR(20,110)=""
S ABMR(20,110)=$$FMT^ABMERUTL(ABMR(20,110),1)
Q
;
DIQ1 ;PULL BILL DATA VIA DIQ1
Q:$D(ABM(9002274.4,ABMP("BDFN"),ABME("FLD")))
N I
S DIQ="ABM("
S DIQ(0)="EI"
S DIC="^ABMDBILL(DUZ(2),"
S DA=ABMP("BDFN")
S DR=".01;.21;.51;.52;.53;.61;.62;.63;.64;.71;.72;.99"
D EN^DIQ1
K DIQ
Q
;
PNM ; EP
; Patient name
K ABME("PNM"),ABME("DOB")
; if insurer type is Medicare FI
I ABMP("ITYPE")="R" D
.; if insurer name contains "MEDICARE"
.I $P(^AUTNINS(ABMP("INS"),0),U)["MEDICARE" D
..; Medicare Patient name from MEDICARE ELIGIBLE
..S ABME("PNM")=$P($G(^AUPNMCR(ABMP("PDFN"),21)),U)
..S ABME("DOB")=$P($G(^AUPNMCR(ABMP("PDFN"),21)),"^",2) ; DOB
.; If insurer name contains "RAILROAD"
.I $P(^AUTNINS(ABMP("INS"),0),U)["RAILROAD" D
..; Railroad Patient name from RAILROAD ELIGIBLE
..S ABME("PNM")=$P($G(^AUPNRRE(ABMP("PDFN"),21)),U)
..S ABME("DOB")=$P($G(^AUPNRRE(ABMP("PDFN"),21)),"^",2) ; DOB
;
; if insurer type is Medicaid FI
I ABMP("ITYPE")="D"!(ABMP("ITYPE")="K") D
.Q:'$G(ABMCDNUM)
.S ABME("PNM")=$P($G(^AUPNMCD(ABMCDNUM,21)),U) ; Pat name
.I $P($P(ABME("PNM"),",",2)," ",2)'=""&($$RCID^ABMERUTL(ABMP("INS"))[61044) S $P(ABME("PNM"),",",2)=$P($P(ABME("PNM"),",",2)," ",1)_","_$P($P(ABME("PNM"),",",2)," ",2) ;abm*2.6*21 IHS/SD/SDR HEAT169641
.S ABME("DOB")=$P($G(^AUPNMCD(ABMCDNUM,21)),"^",2) ; dob
;
; Else get from patient file
S:$G(ABME("PNM"))="" ABME("PNM")=$P($G(^DPT(+ABMP("PDFN"),0)),U)
S:$G(ABME("DOB"))="" ABME("DOB")=$P(^DPT(ABMP("PDFN"),0),"^",3)
; sex code & marital status
S ABME("SEX")=$P(^DPT(ABMP("PDFN"),0),"^",2),ABME("MS")=$P(^(0),"^",5)
Q
;
EX(ABMX,ABMY) ; EP
; Extrincic function here
;
; INPUT: ABMX = data element
; Y = bill internal entry number
;
; OUTPUT: Y = bill internal entry number
;
S ABMP("BDFN")=ABMY
D SET^ABMERUTL
I '$G(ABMP("NOFMT")) S ABMP("FMT")=0
D @ABMX
S Y=ABMR(20,ABMX)
K ABMR(20,ABMX),ABMX,ABMY
I $D(ABMP("FMT")) S ABMP("FMT")=1
Q Y
ABMER20A ; IHS/ASDST/DMJ - UB92 EMC RECORD 20 (Patient) cont'd ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**21**;NOV 12, 2009;Build 379
+2 ;Original;DMJ;02/07/96 12:33 PM
+3 ;
+4 ;IHS/DSD/DMJ - 7/15/1999 NOIS BXX-0799-150034 Patch 3 #3
+5 ; Modified to allow spaces in patient last name
+6 ; IHS/ASDS/DMJ - 04/20/00 - V2.4 Patch 1 - NOIS HQW-0500-100040
+7 ; Modified location code to check for satellite first. If no satellite, use parent.
+8 ; IHS/ASDS/LSL - 07/10/00 - V2.4 Path 2 - NOIS NDA-0700-180029
+9 ; Modified to strip off the leading zero of admission source and admission type.
+10 ; IHS/ASDS/LSL - 09/06/00 - V2.4 Patch 3 - NOIS CAA-0900-110008
+11 ; If nothing in admission source or type, make it null instead of 0 (zero).
+12 ; IHS/ASDS/SDH - 09/27/01 - v2.4 Patch 9 - NOIS XAA-0901-200095
+13 ; After moving Kidscare to Page 5 from Page 7 found that there are checks that are done for Medicaid that should also
+14 ; be done for Kidscare.
+15 ;
+16 ;IHS/SD/SDR - 2.6*21 - HEAT169641 - Include comma and middle initial if AO Control# is 61044
+17 ;
+18 ; *********************************************************************
+19 ;
LOOP ;LOOP HERE
+1 FOR I=10:10:110
Begin DoDot:1
+2 DO @I
+3 IF $DATA(^ABMEXLM("AA",+$GET(ABMP("INS")),+$GET(ABMP("EXP")),20,I))
DO @(^(I))
+4 IF '$GET(ABMP("NOFMT"))
SET ABMREC(20)=$GET(ABMREC(20))_ABMR(20,I)
End DoDot:1
+5 QUIT
+6 ;
10 ;Record type
+1 SET ABMR(20,10)=20
+2 QUIT
+3 ;
20 ;Filler
+1 SET ABMR(20,20)=""
+2 SET ABMR(20,20)=$$FMT^ABMERUTL(ABMR(20,20),2)
+3 QUIT
+4 ;
30 ;Patient Control Number, (SOURCE: FILE=9000001.41,FIELD=.02)
+1 SET ABMR(20,30)=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U)
+2 IF $PIECE($GET(^ABMDPARM(DUZ(2),1,2)),"^",4)'=""
Begin DoDot:1
+3 SET $PIECE(ABMR(20,30),"-",2)=$PIECE($GET(^ABMDPARM(DUZ(2),1,2)),"^",4)
End DoDot:1
+4 IF $PIECE($GET(^ABMDPARM(DUZ(2),1,4)),"^",9)
Begin DoDot:1
+5 IF ABMP("LDFN")=DUZ(2)
QUIT
+6 IF $PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,2)),"^",4)=""
QUIT
+7 SET $PIECE(ABMR(20,30),"-",2)=$PIECE(^ABMDPARM(ABMP("LDFN"),1,2),"^",4)
End DoDot:1
+8 IF $PIECE($GET(^ABMDPARM(DUZ(2),1,3)),"^",3)
Begin DoDot:1
+9 DO 250^ABMER20
+10 IF $TRANSLATE(ABMR(20,250)," ")=""
QUIT
+11 SET ABMR(20,30)=ABMR(20,30)_"-"_ABMR(20,250)
End DoDot:1
+12 SET ABMR(20,30)=$$FMT^ABMERUTL(ABMR(20,30),20)
+13 QUIT
+14 ;
40 ;Patient Last Name (SOURCE: FILE=2, FIELD=.01)
+1 ; form locator #12
+2 IF '$DATA(ABME("PNM"))
DO PNM
+3 SET ABMR(20,40)=$PIECE(ABME("PNM"),",",1)
+4 IF $GET(ABMP("EXP"))=10
SET ABMR(20,40)=$TRANSLATE(ABMR(20,40),"-.,'/")
+5 SET ABMR(20,40)=$$FMT^ABMERUTL(ABMR(20,40),20)
+6 QUIT
+7 ;
50 ;Patient First Name (SOURCE: FILE=2, FIELD=.01)
+1 ; form locator #12
+2 IF '$DATA(ABME("PNM"))
DO PNM
+3 SET ABMR(20,50)=$PIECE(ABME("PNM"),",",2)
+4 Begin DoDot:1
+5 IF ABMR(20,50)="BABY BOY"
QUIT
+6 IF ABMR(20,50)="BABY GIRL"
QUIT
+7 SET ABMR(20,50)=$PIECE(ABMR(20,50)," ",1)
End DoDot:1
+8 SET ABMR(20,50)=$$FMT^ABMERUTL(ABMR(20,50),9)
+9 QUIT
+10 ;
60 ;Patient Middle Initial (SOURCE: FILE=2, FIELD=.01)
+1 ; form locator #12
+2 IF '$DATA(ABME("PNM"))
DO PNM
+3 SET ABMR(20,60)=$PIECE(ABME("PNM"),",",2)
+4 IF ABMR(20,60)="BABY BOY"
SET ABMR(20,60)=" "
QUIT
+5 IF ABMR(20,60)="BABY GIRL"
SET ABMR(20,60)=" "
QUIT
+6 SET ABMR(20,60)=$PIECE(ABMR(20,60)," ",2)
+7 SET ABMR(20,60)=$EXTRACT(ABMR(20,60))
+8 ;abm*2.6*21 IHS/SD/SDR HEAT169641
IF ($$RCID^ABMERUTL(ABMP("INS"))[61044)
SET ABMR(20,60)=$PIECE(ABME("PNM"),",",3)
+9 SET ABMR(20,60)=$$FMT^ABMERUTL(ABMR(20,60),1)
+10 QUIT
+11 ;
70 ;Patient Sex Code (SOURCE: FILE=2, FIELD=.02)
+1 ; form locator #15
+2 IF '$DATA(ABME("SEX"))
DO PNM
+3 SET ABMR(20,70)=$SELECT(ABME("SEX")="":"U",1:ABME("SEX"))
+4 QUIT
+5 ;
80 ;Patient's Birth Date (SOURCE: FILE=2, FIELD=.03)
+1 ; form locator #14
+2 IF '$DATA(ABME("DOB"))
DO PNM
+3 SET ABMR(20,80)=$$Y2KDT^ABMDUTL(ABME("DOB"))
+4 QUIT
+5 ;
90 ;Marital Status Code (SOURCE: FILE=2, FIELD=.05)
+1 ; form locator #16
+2 IF '$DATA(ABME("MS"))
DO PNM
+3 SET ABMR(20,90)=$SELECT(ABME("MS")=1:"D",ABME("MS")=2:"M",ABME("MS")=4:"W",ABME("MS")=5:"X",ABME("MS")=6:"S",1:"U")
+4 QUIT
+5 ;
100 ;Type of Admission (SOURCE: FILE=9002274.4, FIELD=.51)
+1 ; form locator #19
+2 SET ABME("FLD")=.51
+3 DO DIQ1
+4 SET ABMR(20,100)=+ABM(9002274.4,ABMP("BDFN"),.51,"E")
+5 ; if type of admission is "" and visit type is outpatient and
+6 ; insurance type is Medicare FI set type of admission to 1
+7 IF 'ABMR(20,100)
IF ABMP("VTYP")=131
IF ABMP("ITYPE")="R"
SET ABMR(20,100)=1
+8 IF 'ABMR(20,100)
SET ABMR(20,100)=""
+9 SET ABMR(20,100)=$$FMT^ABMERUTL(ABMR(20,100),1)
+10 QUIT
+11 ;
110 ;Source of Admission (SOURCE: FILE=9002274.4, FIELD=.52)
+1 ; form locator #20
+2 SET ABME("FLD")=.52
+3 DO DIQ1
+4 SET ABMR(20,110)=+ABM(9002274.4,ABMP("BDFN"),.52,"E")
+5 ; if type of admission is "" and visit type is outpatient and
+6 ; insurance type is Medicare FI set type of admission to 1
+7 IF 'ABMR(20,110)
IF ABMP("VTYP")=131
IF ABMP("ITYPE")="R"
SET ABMR(20,110)=1
+8 IF 'ABMR(20,110)
SET ABMR(20,110)=""
+9 SET ABMR(20,110)=$$FMT^ABMERUTL(ABMR(20,110),1)
+10 QUIT
+11 ;
DIQ1 ;PULL BILL DATA VIA DIQ1
+1 IF $DATA(ABM(9002274.4,ABMP("BDFN"),ABME("FLD")))
QUIT
+2 NEW I
+3 SET DIQ="ABM("
+4 SET DIQ(0)="EI"
+5 SET DIC="^ABMDBILL(DUZ(2),"
+6 SET DA=ABMP("BDFN")
+7 SET DR=".01;.21;.51;.52;.53;.61;.62;.63;.64;.71;.72;.99"
+8 DO EN^DIQ1
+9 KILL DIQ
+10 QUIT
+11 ;
PNM ; EP
+1 ; Patient name
+2 KILL ABME("PNM"),ABME("DOB")
+3 ; if insurer type is Medicare FI
+4 IF ABMP("ITYPE")="R"
Begin DoDot:1
+5 ; if insurer name contains "MEDICARE"
+6 IF $PIECE(^AUTNINS(ABMP("INS"),0),U)["MEDICARE"
Begin DoDot:2
+7 ; Medicare Patient name from MEDICARE ELIGIBLE
+8 SET ABME("PNM")=$PIECE($GET(^AUPNMCR(ABMP("PDFN"),21)),U)
+9 ; DOB
SET ABME("DOB")=$PIECE($GET(^AUPNMCR(ABMP("PDFN"),21)),"^",2)
End DoDot:2
+10 ; If insurer name contains "RAILROAD"
+11 IF $PIECE(^AUTNINS(ABMP("INS"),0),U)["RAILROAD"
Begin DoDot:2
+12 ; Railroad Patient name from RAILROAD ELIGIBLE
+13 SET ABME("PNM")=$PIECE($GET(^AUPNRRE(ABMP("PDFN"),21)),U)
+14 ; DOB
SET ABME("DOB")=$PIECE($GET(^AUPNRRE(ABMP("PDFN"),21)),"^",2)
End DoDot:2
End DoDot:1
+15 ;
+16 ; if insurer type is Medicaid FI
+17 IF ABMP("ITYPE")="D"!(ABMP("ITYPE")="K")
Begin DoDot:1
+18 IF '$GET(ABMCDNUM)
QUIT
+19 ; Pat name
SET ABME("PNM")=$PIECE($GET(^AUPNMCD(ABMCDNUM,21)),U)
+20 ;abm*2.6*21 IHS/SD/SDR HEAT169641
IF $PIECE($PIECE(ABME("PNM"),",",2)," ",2)'=""&($$RCID^ABMERUTL(ABMP("INS"))[61044)
SET $PIECE(ABME("PNM"),",",2)=$PIECE($PIECE(ABME("PNM"),",",2)," ",1)_","_$PIECE($PIECE(ABME("PNM"),",",2)," ",2)
+21 ; dob
SET ABME("DOB")=$PIECE($GET(^AUPNMCD(ABMCDNUM,21)),"^",2)
End DoDot:1
+22 ;
+23 ; Else get from patient file
+24 IF $GET(ABME("PNM"))=""
SET ABME("PNM")=$PIECE($GET(^DPT(+ABMP("PDFN"),0)),U)
+25 IF $GET(ABME("DOB"))=""
SET ABME("DOB")=$PIECE(^DPT(ABMP("PDFN"),0),"^",3)
+26 ; sex code & marital status
+27 SET ABME("SEX")=$PIECE(^DPT(ABMP("PDFN"),0),"^",2)
SET ABME("MS")=$PIECE(^(0),"^",5)
+28 QUIT
+29 ;
EX(ABMX,ABMY) ; EP
+1 ; Extrincic function here
+2 ;
+3 ; INPUT: ABMX = data element
+4 ; Y = bill internal entry number
+5 ;
+6 ; OUTPUT: Y = bill internal entry number
+7 ;
+8 SET ABMP("BDFN")=ABMY
+9 DO SET^ABMERUTL
+10 IF '$GET(ABMP("NOFMT"))
SET ABMP("FMT")=0
+11 DO @ABMX
+12 SET Y=ABMR(20,ABMX)
+13 KILL ABMR(20,ABMX),ABMX,ABMY
+14 IF $DATA(ABMP("FMT"))
SET ABMP("FMT")=1
+15 QUIT Y
