ABMER31A.m

ABMER31A ; IHS/ASDST/DMJ - UB92 EMC RECORD 31 (Third Party Payor Address) ;

 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 ;Original;DMJ;

 ;

DIQ1 ; EP

 ; Pull Policy Holder data via DIQ1

 S ABME("EMP")=""

 Q:'$G(ABME("PH"))

 Q:$D(ABM(9000003.1,ABME("PH"),ABME("FLD")))

 N I

 S DIQ="ABM("

 S DIQ(0)="EI"

 S DIC="^AUPN3PPH("

 S DA=ABME("PH")

 S DR=".02;.04;.08;.09;.11;.12;.13;.15;.16"

 S ABME("EMP")=ABM(9000003.1,ABME("PH"),.16,"I")

 D EN^DIQ1

 K DIQ

 Q

 ;

DIQ2 ; EP

 ; Employer information from EMPLOYER file (FILE#9999999.75)

 S ABME("EMP")=ABM(9000003.1,+ABME("PH"),.16,"I")

 Q:'$G(ABME("EMP"))

 Q:$D(ABM(9999999.75,ABME("EMP"),ABME("FLD")))

 N I

 S DIQ="ABM("

 S DIQ(0)="EI"

 S DIC="^AUTNEMPL("

 S DA=ABME("EMP")

 S DR=".02;.03;.04;.05"

 D EN^DIQ1

 K DIQ

 Q

 ;

DIQ3 ; EP

 ; Employer information from file 9000001 

 S DA=$P(^AUPNPAT(ABMP("PDFN"),0),"^",19)

 Q:'DA

 Q:$D(ABM(9999999.75,DA,ABME("FLD")))

 N I

 S DIQ="ABM("

 S DIQ(0)="EI"

 S DIC="^AUTNEMPL("

 S DR=".01:.05"

 D EN^DIQ1

 K DIQ

 Q

 ;

DIQ4 ; EP

 ; Address information from file 2

 Q:$D(ABM(2,ABME("PPP"),ABME("FLD")))

 N I

 S DIQ="ABM("

 S DIQ(0)="EI"

 S DIC="^DPT("

 S DA=ABME("PPP")

 S DR=".111:.116"

 D EN^DIQ1

 K DIQ

 Q

ABMER31A  ; IHS/ASDST/DMJ - UB92 EMC RECORD 31 (Third Party Payor Address) ;

 +1       ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 +2       ;Original;DMJ;

 +3       ;

DIQ1      ; EP

 +1       ; Pull Policy Holder data via DIQ1

 +2        SET ABME("EMP")=""

 +3        IF '$GET(ABME("PH"))

               QUIT 

 +4        IF $DATA(ABM(9000003.1,ABME("PH"),ABME("FLD")))

               QUIT 

 +5        NEW I

 +6        SET DIQ="ABM("

 +7        SET DIQ(0)="EI"

 +8        SET DIC="^AUPN3PPH("

 +9        SET DA=ABME("PH")

 +10       SET DR=".02;.04;.08;.09;.11;.12;.13;.15;.16"

 +11       SET ABME("EMP")=ABM(9000003.1,ABME("PH"),.16,"I")

 +12       DO EN^DIQ1

 +13       KILL DIQ

 +14       QUIT 

 +15      ;

DIQ2      ; EP

 +1       ; Employer information from EMPLOYER file (FILE#9999999.75)

 +2        SET ABME("EMP")=ABM(9000003.1,+ABME("PH"),.16,"I")

 +3        IF '$GET(ABME("EMP"))

               QUIT 

 +4        IF $DATA(ABM(9999999.75,ABME("EMP"),ABME("FLD")))

               QUIT 

 +5        NEW I

 +6        SET DIQ="ABM("

 +7        SET DIQ(0)="EI"

 +8        SET DIC="^AUTNEMPL("

 +9        SET DA=ABME("EMP")

 +10       SET DR=".02;.03;.04;.05"

 +11       DO EN^DIQ1

 +12       KILL DIQ

 +13       QUIT 

 +14      ;

DIQ3      ; EP

 +1       ; Employer information from file 9000001 

 +2        SET DA=$PIECE(^AUPNPAT(ABMP("PDFN"),0),"^",19)

 +3        IF 'DA

               QUIT 

 +4        IF $DATA(ABM(9999999.75,DA,ABME("FLD")))

               QUIT 

 +5        NEW I

 +6        SET DIQ="ABM("

 +7        SET DIQ(0)="EI"

 +8        SET DIC="^AUTNEMPL("

 +9        SET DR=".01:.05"

 +10       DO EN^DIQ1

 +11       KILL DIQ

 +12       QUIT 

 +13      ;

DIQ4      ; EP

 +1       ; Address information from file 2

 +2        IF $DATA(ABM(2,ABME("PPP"),ABME("FLD")))

               QUIT 

 +3        NEW I

 +4        SET DIQ="ABM("

 +5        SET DIQ(0)="EI"

 +6        SET DIC="^DPT("

 +7        SET DA=ABME("PPP")

 +8        SET DR=".111:.116"

 +9        DO EN^DIQ1

 +10       KILL DIQ

 +11       QUIT