ABMDEFIP.m

ABMDEFIP ; IHS/ASDST/DMJ - FIX INSURER POINTERS ;

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

 ;

 ; IHS/SD/SDR - v2.5 p10 - IM20247

 ;   Fix for TransWorld error <UNDEF>DBFX+4^ABMDEFIP

 ;

DBFX(X,Y)         ;EP FIX BILL INSURANCE MULTIPLE IF BROKEN POINTER MEDICAID

 ;X=IEN (CLAIM OR BILL), Y=INSURER IEN UNDER FIELD #13 (INS MULTIPLE)

 S:'$G(ABMDUZ2) ABMDUZ2=DUZ(2)

 N ABMP

 S ABMP("D0")=X,ABMP("D1")=Y

 S ABMP("ZERO")=$G(^ABMDBILL(ABMDUZ2,ABMP("D0"),13,ABMP("D1"),0))

 S ABMP("PDFN")=$P(^ABMDBILL(ABMDUZ2,ABMP("D0"),0),U,5)

 S ABMP("VDT")=$P(^ABMDBILL(ABMDUZ2,ABMP("D0"),7),U)

 D MGET

 I $G(ABMP(1)) S $P(^ABMDBILL(ABMDUZ2,ABMP("D0"),13,ABMP("D1"),0),U,6)=ABMP(1),$P(^(0),U,7)=ABMP(2)

 Q

DCFX(X,Y)        ;EP FIX CLAIM INSURANCE MULTIPLE IF BROKEN POINTER, MEDICAID

 N ABMP

 S ABMP("D0")=X,ABMP("D1")=Y

 S ABMP("ZERO")=^ABMDCLM(DUZ(2),ABMP("D0"),13,ABMP("D1"),0)

 S ABMP("PDFN")=$P(^ABMDCLM(DUZ(2),ABMP("D0"),0),U)

 S ABMP("VDT")=$P(^ABMDCLM(DUZ(2),ABMP("D0"),0),"^",2)

 D MGET

 I $G(ABMP(1)) S $P(^ABMDCLM(DUZ(2),ABMP("D0"),13,ABMP("D1"),0),"^",6)=ABMP(1),$P(^(0),"^",7)=ABMP(2)

 K ABMPINS,ABMPRI,ABMPVDT,DFN

 Q

MGET ;GET NEW POINTER

 S ABMP("INSCO")=$P(ABMP("ZERO"),U)

 Q:$P($G(^AUTNINS(ABMP("INSCO"),2)),U)'="D"

 S ABMP("PTR")=$P(ABMP("ZERO"),"^",6)

 S DFN=ABMP("PDFN")

 Q:$P($G(^AUPNMCD(+ABMP("PTR"),0)),U)=DFN

 S ABMPVDT=ABMP("VDT")

 D ELG^ABMDLCK("",.ABML,DFN,ABMPVDT)

 S ABMPRI=0 F  S ABMPRI=$O(ABML(ABMPRI)) Q:'ABMPRI  D

 .S ABMPINS=0 F  S ABMPINS=$O(ABML(ABMPRI,ABMPINS)) Q:'ABMPINS  D

 ..Q:ABMPINS'=ABMP("INSCO")

 ..N I F I=1,2 S ABMP(I)=$P(ABML(ABMPRI,ABMPINS),"^",I)

 Q

ABMDEFIP  ; IHS/ASDST/DMJ - FIX INSURER POINTERS ;

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

 +2       ;

 +3       ; IHS/SD/SDR - v2.5 p10 - IM20247

 +4       ;   Fix for TransWorld error <UNDEF>DBFX+4^ABMDEFIP

 +5       ;

DBFX(X,Y) ;EP FIX BILL INSURANCE MULTIPLE IF BROKEN POINTER MEDICAID

 +1       ;X=IEN (CLAIM OR BILL), Y=INSURER IEN UNDER FIELD #13 (INS MULTIPLE)

 +2        IF '$GET(ABMDUZ2)

               SET ABMDUZ2=DUZ(2)

 +3        NEW ABMP

 +4        SET ABMP("D0")=X

           SET ABMP("D1")=Y

 +5        SET ABMP("ZERO")=$GET(^ABMDBILL(ABMDUZ2,ABMP("D0"),13,ABMP("D1"),0))

 +6        SET ABMP("PDFN")=$PIECE(^ABMDBILL(ABMDUZ2,ABMP("D0"),0),U,5)

 +7        SET ABMP("VDT")=$PIECE(^ABMDBILL(ABMDUZ2,ABMP("D0"),7),U)

 +8        DO MGET

 +9        IF $GET(ABMP(1))

               SET $PIECE(^ABMDBILL(ABMDUZ2,ABMP("D0"),13,ABMP("D1"),0),U,6)=ABMP(1)

               SET $PIECE(^(0),U,7)=ABMP(2)

 +10       QUIT 

DCFX(X,Y) ;EP FIX CLAIM INSURANCE MULTIPLE IF BROKEN POINTER, MEDICAID

 +1        NEW ABMP

 +2        SET ABMP("D0")=X

           SET ABMP("D1")=Y

 +3        SET ABMP("ZERO")=^ABMDCLM(DUZ(2),ABMP("D0"),13,ABMP("D1"),0)

 +4        SET ABMP("PDFN")=$PIECE(^ABMDCLM(DUZ(2),ABMP("D0"),0),U)

 +5        SET ABMP("VDT")=$PIECE(^ABMDCLM(DUZ(2),ABMP("D0"),0),"^",2)

 +6        DO MGET

 +7        IF $GET(ABMP(1))

               SET $PIECE(^ABMDCLM(DUZ(2),ABMP("D0"),13,ABMP("D1"),0),"^",6)=ABMP(1)

               SET $PIECE(^(0),"^",7)=ABMP(2)

 +8        KILL ABMPINS,ABMPRI,ABMPVDT,DFN

 +9        QUIT 

MGET      ;GET NEW POINTER

 +1        SET ABMP("INSCO")=$PIECE(ABMP("ZERO"),U)

 +2        IF $PIECE($GET(^AUTNINS(ABMP("INSCO"),2)),U)'="D"

               QUIT 

 +3        SET ABMP("PTR")=$PIECE(ABMP("ZERO"),"^",6)

 +4        SET DFN=ABMP("PDFN")

 +5        IF $PIECE($GET(^AUPNMCD(+ABMP("PTR"),0)),U)=DFN

               QUIT 

 +6        SET ABMPVDT=ABMP("VDT")

 +7        DO ELG^ABMDLCK("",.ABML,DFN,ABMPVDT)

 +8        SET ABMPRI=0

           FOR 

               SET ABMPRI=$ORDER(ABML(ABMPRI))

               IF 'ABMPRI

                   QUIT 

               Begin DoDot:1

 +9                SET ABMPINS=0

                   FOR 

                       SET ABMPINS=$ORDER(ABML(ABMPRI,ABMPINS))

                       IF 'ABMPINS

                           QUIT 

                       Begin DoDot:2

 +10                       IF ABMPINS'=ABMP("INSCO")

                               QUIT 

 +11                       NEW I

                           FOR I=1,2

                               SET ABMP(I)=$PIECE(ABML(ABMPRI,ABMPINS),"^",I)

                       End DoDot:2

               End DoDot:1

 +12       QUIT