ABMDE2X3 ; IHS/SD/SDR - PAGE 2 - INSURER DATA CK PART 3 ;
;;2.6;IHS Third Party Billing System;**3,8,10,11,13**;NOV 12, 2009;Build 213
;
; IHS/ASDS/DMJ - 10/04/00 - V2.4 P3 - NOIS HQW-1000-100062 - Modified code to be CACHE compliant
;
; IHS/SD/SDR - 10/30/02 - V2.5 P2 - QXX-0402-130120 - Updated error codes 11 and 105 so they would
; be a little more specific and come on if none of the data was there instead of just checking the pieces
; IHS/SD/SDR - v2.5 p11 - IM22822 - Fixed <UNDEF>REMPL+16^ABMDE2X3
;
;IHS/SD/SDR - abm*2.6*3 - HEAT8996 - made group number/name print for Medicaid
;IHS/SD/SDR - 2.6*13 - new export mode 35 - added code for worker's compensation group name
;
; *********************************************************************
;
; X2=PHDFN;NAME^RDFN;RELATIONSHIP^ADDR1^ADDR2^PHONE^SEX^DOB
; X3=EMPLOYER^ADDR1^ADDR2^PHONE^STATUS^GROUP^GROUP #^EMPL #
;
S ABMVREL=$P(ABMV("X2"),"^",2)
I $P(ABMVREL,";",2)="SELF"&($P(ABMV("X1"),U,5)]"") D G XIT
.S $P(ABMVREL,";",2)=$P(ABMV("X1"),"^",5)
.S $P(ABMV("X2"),"^",2)=ABMVREL
I $P(ABMV("X2"),U)]"" G XIT
;
;start new code abm*2.6*3 HEAT8996
GRP ;
;I $P($G(^AUTNINS(ABMP("INS"),2)),U)="D" D ;abm*2.6*8 HEAT37612
;I +$G(ABMP("INS"))'=0,$P($G(^AUTNINS(ABMP("INS"),2)),U)="D" D ;abm*2.6*8 HEAT37612 ;abm*2.6*10 HEAT73780
I +$G(ABMP("INS"))'=0,$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")="D" D ;abm*2.6*8 HEAT37612 ;abm*2.6*10 HEAT73780
.S:(+$G(ABMX("2"))'=0) ABMX("GRP")=$P($G(^AUPNMCD(+ABMX("2"),0)),U,17)
.I $G(ABMX("GRP"))]"" D
..I $D(^AUTNEGRP(ABMX("GRP"),0)) D
...S $P(ABMV("X3"),U,6)=$P(^AUTNEGRP(ABMX("GRP"),0),U)
...S $P(ABMV("X3"),U,7)=$S($D(^AUTNEGRP(ABMX("GRP"),11,ABMP("VTYP"),0)):$P(^(0),U,2),1:$P(^AUTNEGRP(ABMX("GRP"),0),U,2))
;end new code abm*2.6*3 HEAT8996
;
REG ;
S ABMX("HDFN")=ABMP("PDFN")
S ABMV("X2")=ABMP("PDFN")_";"_$S($P(ABMV("X1"),U,5)]"":$P(ABMV("X1"),U,5),1:$P(^DPT(ABMP("PDFN"),0),U))
I $P(^DPT(ABMP("PDFN"),0),U,2)]"" S $P(ABMV("X2"),U,6)=$P(^(0),U,2)
;E S ABME(13)="" ;abm*2.6*11 MU2 gender
I $P(^DPT(ABMP("PDFN"),0),U,2)=""!($P(^DPT(ABMP("PDFN"),0),U,2)="U") S ABME(13)="" ;abm*2.6*11 MU2 gender
S $P(ABMV("X2"),U,7)=$P(^DPT(ABMP("PDFN"),0),U,3)
S $P(ABMV("X2"),U,2)=$O(^AUTTRLSH("B","SELF",""))_";SELF"
I '+$D(^DPT(ABMX("HDFN"),.11)) S ABME(11)="" Q
I +$D(^DPT(ABMX("HDFN"),.11)) D
.I '($P(^DPT(ABMX("HDFN"),.11),U)]"") S ABME(11)="" Q
.I '($P(^DPT(ABMX("HDFN"),.11),U,4)]"") S ABME(11)="" Q
.I '($P(^DPT(ABMX("HDFN"),.11),U,5)]"") S ABME(11)="" Q
.I '($P(^DPT(ABMX("HDFN"),.11),U,6)]"") S ABME(11)="" Q
.S $P(ABMV("X2"),U,3)=$P(^DPT(ABMX("HDFN"),.11),U)
.S $P(ABMV("X2"),U,4)=$P(^DPT(ABMX("HDFN"),.11),U,4)_", "
I $D(ABME(11)) G REMPL
I $P(^DPT(ABMX("HDFN"),.11),U,5)]"" D
.I $D(^DIC(5,$P(^DPT(ABMX("HDFN"),.11),U,5),0)) D
..S $P(ABMV("X2"),U,4)=$P(ABMV("X2"),U,4)_$P(^DIC(5,$P(^DPT(ABMX("HDFN"),.11),U,5),0),U,2)_" "_$P(^DPT(ABMX("HDFN"),.11),U,6)
..S:$D(^DPT(ABMX("HDFN"),.13)) $P(ABMV("X2"),U,5)=$P(^DPT(ABMX("HDFN"),.13),U)
E S ABME(11)=""
;
REMPL ; X3=EMPLOYER;ADDR 1^ADDR 2^PHONE^STATUS
;
I $P(^AUPNPAT(ABMX("HDFN"),0),U,19)]"" D
.I $D(^AUTNEMPL($P(^AUPNPAT(ABMX("HDFN"),0),U,19),0)) D
..S ABMX("Y")=^AUTNEMPL($P(^AUPNPAT(ABMX("HDFN"),0),U,19),0)
..S $P(ABMV("X3"),U)=$P(ABMX("Y"),U)
E S ABME(73)="" G XIT
I $D(ABMX("Y")) D
.I '($P(ABMX("Y"),U,2)]"") S ABME(75)="" Q
.I '($P(ABMX("Y"),U,3)]"") S ABME(75)="" Q
.I '($P(ABMX("Y"),U,4)]"") S ABME(75)="" Q
.I '($P(ABMX("Y"),U,5)]"") S ABME(75)="" Q
.S $P(ABMV("X3"),U,2)=$P(ABMX("Y"),U,2)
.S $P(ABMV("X3"),U,3)=$P(ABMX("Y"),U,3)_", "
.I $D(^DIC(5,$P(ABMX("Y"),U,4),0)) D
..S $P(ABMV("X3"),U,3)=$P(ABMV("X3"),U,3)_$P(^DIC(5,$P(ABMX("Y"),U,4),0),U,2)_" "_$P(ABMX("Y"),U,5)
.S $P(ABMV("X3"),U,4)=$P(ABMX("Y"),U,6)
S ABMX("Y")=$P(^AUPNPAT(ABMX("HDFN"),0),U,21)
I ABMX("Y")="" S ABME(72)="" G XIT
S ABMX("Y0")=$P(^DD(9000001,.21,0),U,3)
S ABMX("Y0")=$P(ABMX("Y0"),ABMX("Y")_":",2)
S ABMX("Y0")=$P(ABMX("Y0"),";",1)
S $P(ABMV("X3"),U,5)=ABMX("Y")_";"_ABMX("Y0")
;start new abm*2.6*13 exp mode 35
I ABMITYP="W" D
.I $G(^AUPNWC(ABMP("PDFN"),0))'="" D ;entry in 9000042-Workman's Comp
..S ABMWCIEN=0
..F S ABMWCIEN=$O(^AUPNWC(ABMP("PDFN"),11,ABMWCIEN)) Q:+ABMWCIEN=0 D Q:$D(ABMLW)
...S ABMWEFDT=$P($G(^AUPNWC(ABMP("PDFN"),11,ABMWCIEN,0)),U,12)
...S ABMWEXDT=$P($G(^AUPNWC(ABMP("PDFN"),11,ABMWCIEN,0)),U,13)
...I ABMWEFDT>$P($S($G(ABMDISDT):ABMDISDT,1:ABMP("VDT")),".",1) Q
...I ABMWEXDT'="",ABMWEXDT<$P(ABMP("VDT"),".",1) Q
...S $P(ABMV("X3"),U,6)=$$GET1^DIQ(9999999.77,$P($G(^AUPNWC(ABMP("PDFN"),11,ABMWCIEN,0)),U,11),".01","E")
;end new exp mode 35
;
XIT ;
Q
ABMDE2X3 ; IHS/SD/SDR - PAGE 2 - INSURER DATA CK PART 3 ;
+1 ;;2.6;IHS Third Party Billing System;**3,8,10,11,13**;NOV 12, 2009;Build 213
+2 ;
+3 ; IHS/ASDS/DMJ - 10/04/00 - V2.4 P3 - NOIS HQW-1000-100062 - Modified code to be CACHE compliant
+4 ;
+5 ; IHS/SD/SDR - 10/30/02 - V2.5 P2 - QXX-0402-130120 - Updated error codes 11 and 105 so they would
+6 ; be a little more specific and come on if none of the data was there instead of just checking the pieces
+7 ; IHS/SD/SDR - v2.5 p11 - IM22822 - Fixed <UNDEF>REMPL+16^ABMDE2X3
+8 ;
+9 ;IHS/SD/SDR - abm*2.6*3 - HEAT8996 - made group number/name print for Medicaid
+10 ;IHS/SD/SDR - 2.6*13 - new export mode 35 - added code for worker's compensation group name
+11 ;
+12 ; *********************************************************************
+13 ;
+14 ; X2=PHDFN;NAME^RDFN;RELATIONSHIP^ADDR1^ADDR2^PHONE^SEX^DOB
+15 ; X3=EMPLOYER^ADDR1^ADDR2^PHONE^STATUS^GROUP^GROUP #^EMPL #
+16 ;
+17 SET ABMVREL=$PIECE(ABMV("X2"),"^",2)
+18 IF $PIECE(ABMVREL,";",2)="SELF"&($PIECE(ABMV("X1"),U,5)]"")
Begin DoDot:1
+19 SET $PIECE(ABMVREL,";",2)=$PIECE(ABMV("X1"),"^",5)
+20 SET $PIECE(ABMV("X2"),"^",2)=ABMVREL
End DoDot:1
GOTO XIT
+21 IF $PIECE(ABMV("X2"),U)]""
GOTO XIT
+22 ;
+23 ;start new code abm*2.6*3 HEAT8996
GRP ;
+1 ;I $P($G(^AUTNINS(ABMP("INS"),2)),U)="D" D ;abm*2.6*8 HEAT37612
+2 ;I +$G(ABMP("INS"))'=0,$P($G(^AUTNINS(ABMP("INS"),2)),U)="D" D ;abm*2.6*8 HEAT37612 ;abm*2.6*10 HEAT73780
+3 ;abm*2.6*8 HEAT37612 ;abm*2.6*10 HEAT73780
IF +$GET(ABMP("INS"))'=0
IF $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")="D"
Begin DoDot:1
+4 IF (+$GET(ABMX("2"))'=0)
SET ABMX("GRP")=$PIECE($GET(^AUPNMCD(+ABMX("2"),0)),U,17)
+5 IF $GET(ABMX("GRP"))]""
Begin DoDot:2
+6 IF $DATA(^AUTNEGRP(ABMX("GRP"),0))
Begin DoDot:3
+7 SET $PIECE(ABMV("X3"),U,6)=$PIECE(^AUTNEGRP(ABMX("GRP"),0),U)
+8 SET $PIECE(ABMV("X3"),U,7)=$SELECT($DATA(^AUTNEGRP(ABMX("GRP"),11,ABMP("VTYP"),0)):$PIECE(^(0),U,2),1:$PIECE(^AUTNEGRP(ABMX("GRP"),0),U,2))
End DoDot:3
End DoDot:2
End DoDot:1
+9 ;end new code abm*2.6*3 HEAT8996
+10 ;
REG ;
+1 SET ABMX("HDFN")=ABMP("PDFN")
+2 SET ABMV("X2")=ABMP("PDFN")_";"_$SELECT($PIECE(ABMV("X1"),U,5)]"":$PIECE(ABMV("X1"),U,5),1:$PIECE(^DPT(ABMP("PDFN"),0),U))
+3 IF $PIECE(^DPT(ABMP("PDFN"),0),U,2)]""
SET $PIECE(ABMV("X2"),U,6)=$PIECE(^(0),U,2)
+4 ;E S ABME(13)="" ;abm*2.6*11 MU2 gender
+5 ;abm*2.6*11 MU2 gender
IF $PIECE(^DPT(ABMP("PDFN"),0),U,2)=""!($PIECE(^DPT(ABMP("PDFN"),0),U,2)="U")
SET ABME(13)=""
+6 SET $PIECE(ABMV("X2"),U,7)=$PIECE(^DPT(ABMP("PDFN"),0),U,3)
+7 SET $PIECE(ABMV("X2"),U,2)=$ORDER(^AUTTRLSH("B","SELF",""))_";SELF"
+8 IF '+$DATA(^DPT(ABMX("HDFN"),.11))
SET ABME(11)=""
QUIT
+9 IF +$DATA(^DPT(ABMX("HDFN"),.11))
Begin DoDot:1
+10 IF '($PIECE(^DPT(ABMX("HDFN"),.11),U)]"")
SET ABME(11)=""
QUIT
+11 IF '($PIECE(^DPT(ABMX("HDFN"),.11),U,4)]"")
SET ABME(11)=""
QUIT
+12 IF '($PIECE(^DPT(ABMX("HDFN"),.11),U,5)]"")
SET ABME(11)=""
QUIT
+13 IF '($PIECE(^DPT(ABMX("HDFN"),.11),U,6)]"")
SET ABME(11)=""
QUIT
+14 SET $PIECE(ABMV("X2"),U,3)=$PIECE(^DPT(ABMX("HDFN"),.11),U)
+15 SET $PIECE(ABMV("X2"),U,4)=$PIECE(^DPT(ABMX("HDFN"),.11),U,4)_", "
End DoDot:1
+16 IF $DATA(ABME(11))
GOTO REMPL
+17 IF $PIECE(^DPT(ABMX("HDFN"),.11),U,5)]""
Begin DoDot:1
+18 IF $DATA(^DIC(5,$PIECE(^DPT(ABMX("HDFN"),.11),U,5),0))
Begin DoDot:2
+19 SET $PIECE(ABMV("X2"),U,4)=$PIECE(ABMV("X2"),U,4)_$PIECE(^DIC(5,$PIECE(^DPT(ABMX("HDFN"),.11),U,5),0),U,2)_" "_$PIECE(^DPT(ABMX("HDFN"),.11),U,6)
+20 IF $DATA(^DPT(ABMX("HDFN"),.13))
SET $PIECE(ABMV("X2"),U,5)=$PIECE(^DPT(ABMX("HDFN"),.13),U)
End DoDot:2
End DoDot:1
+21 IF '$TEST
SET ABME(11)=""
+22 ;
REMPL ; X3=EMPLOYER;ADDR 1^ADDR 2^PHONE^STATUS
+1 ;
+2 IF $PIECE(^AUPNPAT(ABMX("HDFN"),0),U,19)]""
Begin DoDot:1
+3 IF $DATA(^AUTNEMPL($PIECE(^AUPNPAT(ABMX("HDFN"),0),U,19),0))
Begin DoDot:2
+4 SET ABMX("Y")=^AUTNEMPL($PIECE(^AUPNPAT(ABMX("HDFN"),0),U,19),0)
+5 SET $PIECE(ABMV("X3"),U)=$PIECE(ABMX("Y"),U)
End DoDot:2
End DoDot:1
+6 IF '$TEST
SET ABME(73)=""
GOTO XIT
+7 IF $DATA(ABMX("Y"))
Begin DoDot:1
+8 IF '($PIECE(ABMX("Y"),U,2)]"")
SET ABME(75)=""
QUIT
+9 IF '($PIECE(ABMX("Y"),U,3)]"")
SET ABME(75)=""
QUIT
+10 IF '($PIECE(ABMX("Y"),U,4)]"")
SET ABME(75)=""
QUIT
+11 IF '($PIECE(ABMX("Y"),U,5)]"")
SET ABME(75)=""
QUIT
+12 SET $PIECE(ABMV("X3"),U,2)=$PIECE(ABMX("Y"),U,2)
+13 SET $PIECE(ABMV("X3"),U,3)=$PIECE(ABMX("Y"),U,3)_", "
+14 IF $DATA(^DIC(5,$PIECE(ABMX("Y"),U,4),0))
Begin DoDot:2
+15 SET $PIECE(ABMV("X3"),U,3)=$PIECE(ABMV("X3"),U,3)_$PIECE(^DIC(5,$PIECE(ABMX("Y"),U,4),0),U,2)_" "_$PIECE(ABMX("Y"),U,5)
End DoDot:2
+16 SET $PIECE(ABMV("X3"),U,4)=$PIECE(ABMX("Y"),U,6)
End DoDot:1
+17 SET ABMX("Y")=$PIECE(^AUPNPAT(ABMX("HDFN"),0),U,21)
+18 IF ABMX("Y")=""
SET ABME(72)=""
GOTO XIT
+19 SET ABMX("Y0")=$PIECE(^DD(9000001,.21,0),U,3)
+20 SET ABMX("Y0")=$PIECE(ABMX("Y0"),ABMX("Y")_":",2)
+21 SET ABMX("Y0")=$PIECE(ABMX("Y0"),";",1)
+22 SET $PIECE(ABMV("X3"),U,5)=ABMX("Y")_";"_ABMX("Y0")
+23 ;start new abm*2.6*13 exp mode 35
+24 IF ABMITYP="W"
Begin DoDot:1
+25 ;entry in 9000042-Workman's Comp
IF $GET(^AUPNWC(ABMP("PDFN"),0))'=""
Begin DoDot:2
+26 SET ABMWCIEN=0
+27 FOR
SET ABMWCIEN=$ORDER(^AUPNWC(ABMP("PDFN"),11,ABMWCIEN))
IF +ABMWCIEN=0
QUIT
Begin DoDot:3
+28 SET ABMWEFDT=$PIECE($GET(^AUPNWC(ABMP("PDFN"),11,ABMWCIEN,0)),U,12)
+29 SET ABMWEXDT=$PIECE($GET(^AUPNWC(ABMP("PDFN"),11,ABMWCIEN,0)),U,13)
+30 IF ABMWEFDT>$PIECE($SELECT($GET(ABMDISDT):ABMDISDT,1:ABMP("VDT")),".",1)
QUIT
+31 IF ABMWEXDT'=""
IF ABMWEXDT<$PIECE(ABMP("VDT"),".",1)
QUIT
+32 SET $PIECE(ABMV("X3"),U,6)=$$GET1^DIQ(9999999.77,$PIECE($GET(^AUPNWC(ABMP("PDFN"),11,ABMWCIEN,0)),U,11),".01","E")
End DoDot:3
IF $DATA(ABMLW)
QUIT
End DoDot:2
End DoDot:1
+33 ;end new exp mode 35
+34 ;
XIT ;
+1 QUIT
