ABMUTLN.m

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