ABMER20A.m

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