ABMUTLN ; IHS/ASDST/DMJ - NAME UTILITIES ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009;Build 379
;Original;DMJ;02/07/96 12:33 PM
;
;IHS/SD/SDR - v2.5 p10 - IM20000 Added code to look at Card Name for Policy Holder
;
LNM(X,Y) ;PEP - last name
;x=file
;y=internal entry number
D SET
D KILL
I X="" Q X
D FILE
S X=$P(ABME("NM"),",",1)
Q X
FNM(X,Y) ;PEP - first name
;x=file
;y=internal entry number
D SET
D KILL
I X="" Q X
D FILE
S X=$P(ABME("NM"),",",2)
S X=$$STRPL^ABMERUTL(X)
I $L(X," ")>1 D
.S X=$P(X," ",1,$L(X," ")-1)
Q X
MI(X,Y) ;PEP - middle name/initial
;x=file
;y=internal entry number
D SET
D KILL
I X="" Q X
D FILE
S X=$P(ABME("NM"),",",2)
I $L(X," ")<2 S X="" Q X
S X=$P(X," ",$L(X," "))
S X=$TR(X,".,")
Q X
SFX(X,Y) ;PEP - suffix (generation)
;x=file
;y=internal entry number
D SET
D KILL
I X="" Q X
D FILE
S X=$G(ABME("NSFX"))
Q X
DOB(X,Y) ;PEP - date of birth
;x=file
;y=internal entry number
D SET
D KILL
I X="" Q X
D FILE
S X=$G(ABME("DOB"))
Q X
SEX(X,Y) ;PEP - sex
;x=file
;y=internal entry number
D SET
D KILL
I X="" Q X
D FILE
S X=$G(ABME("SEX"))
Q X
SET ;set abmpdfn
S ABMFILE=X
S ABMIEN=Y
I X=3 S ABMFILE=9000003.1
S ABMIEN=Y
I ABMFILE=2 D
.I '$D(^DPT(+ABMIEN,0)) S X="" Q
.S ABMPDFN=ABMIEN
I ABMFILE=200 D
.S:'$D(^VA(200,+ABMIEN,0)) X=""
I ABMFILE=9000003.1 D
.S:'$D(^AUPN3PPH(+ABMIEN,0)) X=""
Q
KILL ;kill off old abme
K ABME("NM"),ABME("DOB"),ABME("SEX"),ABME("NSFX")
Q
FILE ;retrieve from file
I ABMFILE=2 D PAT
I ABMFILE=200 D NP
I ABMFILE=9000003.1 D PH
D STRIP
Q
PAT ; Patient name
S ABMP("ITYPE")=$G(ABMP("ITYPE"))
; 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("NM")=$P($G(^AUPNMCR(ABMPDFN,21)),U)
..S ABME("DOB")=$P($G(^AUPNMCR(ABMPDFN,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("NM")=$P($G(^AUPNRRE(ABMPDFN,21)),U)
..S ABME("DOB")=$P($G(^AUPNRRE(ABMPDFN,21)),"^",2) ; DOB
;
; if insurer type is Medicaid FI
I ABMP("ITYPE")="D"!(ABMP("ITYPE")="K") D
.Q:'$G(ABMCDNUM)
.S ABME("NM")=$P($G(^AUPNMCD(ABMCDNUM,21)),U) ; Pat name
.S ABME("DOB")=$P($G(^AUPNMCD(ABMCDNUM,21)),"^",2) ; dob
;
; Else get from patient file
S:$G(ABME("NM"))="" ABME("NM")=$P($G(^DPT(+ABMPDFN,0)),U)
S:$G(ABME("DOB"))="" ABME("DOB")=$P(^DPT(ABMPDFN,0),"^",3)
; sex code & marital status
S ABME("SEX")=$P(^DPT(ABMPDFN,0),"^",2),ABME("MS")=$P(^(0),"^",5)
Q
NP ;new person file
S ABME("NM")=$P($G(^VA(200,ABMIEN,0)),U)
S ABME("SEX")=$P($G(^VA(200,ABMIEN,1)),"^",2)
S ABME("DOB")=$P($G(^VA(200,ABMIEN,1)),"^",3)
Q
PH ;policy holder file
S ABME("NM")=$P($G(^AUPN3PPH(ABMIEN,1)),U)
S:ABME("NM")="" ABME("NM")=$P($G(^AUPN3PPH(ABMIEN,0)),U)
S ABME("SEX")=$P(^AUPN3PPH(ABMIEN,0),"^",8)
S ABME("DOB")=$P(^AUPN3PPH(ABMIEN,0),"^",19)
Q
STRIP ;strip suffix (generation)
K ABME("NSFX")
N I
F I=" JR."," SR."," III."," IV." D STR1
Q:$G(ABME("NSFX"))'=""
F I=" JR"," SR"," III"," IV" D STR1
Q
STR1 ;one name
Q:ABME("NM")'[I
S ABME("NSFX")=$TR(I," .")
S ABME("NM")=$P(ABME("NM"),I,1)_$P(ABME("NM"),I,2)
Q
ABMUTLN ; IHS/ASDST/DMJ - NAME UTILITIES ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009;Build 379
+2 ;Original;DMJ;02/07/96 12:33 PM
+3 ;
+4 ;IHS/SD/SDR - v2.5 p10 - IM20000 Added code to look at Card Name for Policy Holder
+5 ;
LNM(X,Y) ;PEP - last name
+1 ;x=file
+2 ;y=internal entry number
+3 DO SET
+4 DO KILL
+5 IF X=""
QUIT X
+6 DO FILE
+7 SET X=$PIECE(ABME("NM"),",",1)
+8 QUIT X
FNM(X,Y) ;PEP - first name
+1 ;x=file
+2 ;y=internal entry number
+3 DO SET
+4 DO KILL
+5 IF X=""
QUIT X
+6 DO FILE
+7 SET X=$PIECE(ABME("NM"),",",2)
+8 SET X=$$STRPL^ABMERUTL(X)
+9 IF $LENGTH(X," ")>1
Begin DoDot:1
+10 SET X=$PIECE(X," ",1,$LENGTH(X," ")-1)
End DoDot:1
+11 QUIT X
MI(X,Y) ;PEP - middle name/initial
+1 ;x=file
+2 ;y=internal entry number
+3 DO SET
+4 DO KILL
+5 IF X=""
QUIT X
+6 DO FILE
+7 SET X=$PIECE(ABME("NM"),",",2)
+8 IF $LENGTH(X," ")<2
SET X=""
QUIT X
+9 SET X=$PIECE(X," ",$LENGTH(X," "))
+10 SET X=$TRANSLATE(X,".,")
+11 QUIT X
SFX(X,Y) ;PEP - suffix (generation)
+1 ;x=file
+2 ;y=internal entry number
+3 DO SET
+4 DO KILL
+5 IF X=""
QUIT X
+6 DO FILE
+7 SET X=$GET(ABME("NSFX"))
+8 QUIT X
DOB(X,Y) ;PEP - date of birth
+1 ;x=file
+2 ;y=internal entry number
+3 DO SET
+4 DO KILL
+5 IF X=""
QUIT X
+6 DO FILE
+7 SET X=$GET(ABME("DOB"))
+8 QUIT X
SEX(X,Y) ;PEP - sex
+1 ;x=file
+2 ;y=internal entry number
+3 DO SET
+4 DO KILL
+5 IF X=""
QUIT X
+6 DO FILE
+7 SET X=$GET(ABME("SEX"))
+8 QUIT X
SET ;set abmpdfn
+1 SET ABMFILE=X
+2 SET ABMIEN=Y
+3 IF X=3
SET ABMFILE=9000003.1
+4 SET ABMIEN=Y
+5 IF ABMFILE=2
Begin DoDot:1
+6 IF '$DATA(^DPT(+ABMIEN,0))
SET X=""
QUIT
+7 SET ABMPDFN=ABMIEN
End DoDot:1
+8 IF ABMFILE=200
Begin DoDot:1
+9 IF '$DATA(^VA(200,+ABMIEN,0))
SET X=""
End DoDot:1
+10 IF ABMFILE=9000003.1
Begin DoDot:1
+11 IF '$DATA(^AUPN3PPH(+ABMIEN,0))
SET X=""
End DoDot:1
+12 QUIT
KILL ;kill off old abme
+1 KILL ABME("NM"),ABME("DOB"),ABME("SEX"),ABME("NSFX")
+2 QUIT
FILE ;retrieve from file
+1 IF ABMFILE=2
DO PAT
+2 IF ABMFILE=200
DO NP
+3 IF ABMFILE=9000003.1
DO PH
+4 DO STRIP
+5 QUIT
PAT ; Patient name
+1 SET ABMP("ITYPE")=$GET(ABMP("ITYPE"))
+2 ; if insurer type is Medicare FI
+3 IF ABMP("ITYPE")="R"
Begin DoDot:1
+4 ; if insurer name contains "MEDICARE"
+5 IF $PIECE(^AUTNINS(ABMP("INS"),0),U)["MEDICARE"
Begin DoDot:2
+6 ; Medicare Patient name from MEDICARE ELIGIBLE
+7 SET ABME("NM")=$PIECE($GET(^AUPNMCR(ABMPDFN,21)),U)
+8 ; DOB
SET ABME("DOB")=$PIECE($GET(^AUPNMCR(ABMPDFN,21)),"^",2)
End DoDot:2
+9 ; If insurer name contains "RAILROAD"
+10 IF $PIECE(^AUTNINS(ABMP("INS"),0),U)["RAILROAD"
Begin DoDot:2
+11 ; Railroad Patient name from RAILROAD ELIGIBLE
+12 SET ABME("NM")=$PIECE($GET(^AUPNRRE(ABMPDFN,21)),U)
+13 ; DOB
SET ABME("DOB")=$PIECE($GET(^AUPNRRE(ABMPDFN,21)),"^",2)
End DoDot:2
End DoDot:1
+14 ;
+15 ; if insurer type is Medicaid FI
+16 IF ABMP("ITYPE")="D"!(ABMP("ITYPE")="K")
Begin DoDot:1
+17 IF '$GET(ABMCDNUM)
QUIT
+18 ; Pat name
SET ABME("NM")=$PIECE($GET(^AUPNMCD(ABMCDNUM,21)),U)
+19 ; dob
SET ABME("DOB")=$PIECE($GET(^AUPNMCD(ABMCDNUM,21)),"^",2)
End DoDot:1
+20 ;
+21 ; Else get from patient file
+22 IF $GET(ABME("NM"))=""
SET ABME("NM")=$PIECE($GET(^DPT(+ABMPDFN,0)),U)
+23 IF $GET(ABME("DOB"))=""
SET ABME("DOB")=$PIECE(^DPT(ABMPDFN,0),"^",3)
+24 ; sex code & marital status
+25 SET ABME("SEX")=$PIECE(^DPT(ABMPDFN,0),"^",2)
SET ABME("MS")=$PIECE(^(0),"^",5)
+26 QUIT
NP ;new person file
+1 SET ABME("NM")=$PIECE($GET(^VA(200,ABMIEN,0)),U)
+2 SET ABME("SEX")=$PIECE($GET(^VA(200,ABMIEN,1)),"^",2)
+3 SET ABME("DOB")=$PIECE($GET(^VA(200,ABMIEN,1)),"^",3)
+4 QUIT
PH ;policy holder file
+1 SET ABME("NM")=$PIECE($GET(^AUPN3PPH(ABMIEN,1)),U)
+2 IF ABME("NM")=""
SET ABME("NM")=$PIECE($GET(^AUPN3PPH(ABMIEN,0)),U)
+3 SET ABME("SEX")=$PIECE(^AUPN3PPH(ABMIEN,0),"^",8)
+4 SET ABME("DOB")=$PIECE(^AUPN3PPH(ABMIEN,0),"^",19)
+5 QUIT
STRIP ;strip suffix (generation)
+1 KILL ABME("NSFX")
+2 NEW I
+3 FOR I=" JR."," SR."," III."," IV."
DO STR1
+4 IF $GET(ABME("NSFX"))'=""
QUIT
+5 FOR I=" JR"," SR"," III"," IV"
DO STR1
+6 QUIT
STR1 ;one name
+1 IF ABME("NM")'[I
QUIT
+2 SET ABME("NSFX")=$TRANSLATE(I," .")
+3 SET ABME("NM")=$PIECE(ABME("NM"),I,1)_$PIECE(ABME("NM"),I,2)
+4 QUIT
