ABMDLCK4.m

ABMDLCK4 ; IHS/SD/SDR - check visit for elig - PART 4 ;   

 ;;2.6;IHS Third Party Billing System;**21**;NOV 12, 2009;Build 379

 ;IHS/SD/SDR - 2.6*21 - VMBP RQMT_90 - new routine

 ; *********************************************************************

7 ;EP - VMBP Elig Chk

 S ABM("TYP")="P"

 S ABM("PRI")=5

 ;After setting priority we check VAMB eligibility file

 S ABM("VACHK")=1 D 5^ABMDLCK2  ;check AUPNPRVT for VA entries

 S ABM("TYP")="V"

 S ABM("PRI")=5

 D PRIO^ABMDLCK2

 Q:'$D(^AUPNVAMB(DFN,0))

 D FIND^DIC(9999999.18,"","@;.01;.211","CP","V","*",,"I $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,Y,"".211"",""I""),1,""I"")=""V""","","ABMIL")

 I +$O(ABMIL("DILIST",0))=0 S ABME(252)="" Q

 S ABM("INS")=$P($G(^AUPNVAMB(DFN,0)),U,2)

 K ABM("REC")

 I '+$O(^AUPNVAMB(DFN,11,0)) D  Q

 .D CHK^ABMDLCK1

 .I $G(ABM("XIT")) D UNCHK^ABMDLCK2

 ;Node 11 has eligibility dates

 S ABMELGDT=0

 S ABM("MDFN")=0

 F  S ABM("MDFN")=$O(^AUPNVAMB(DFN,11,ABM("MDFN"))) Q:'ABM("MDFN")  D 73

 I 'ABMELGDT D  Q

 .I '$D(ABML(ABM("PRI"),ABM("INS"))) D

 ..I '$D(ABML(99,ABM("INS"))) D

 ...S $P(ABML(99,ABM("INS")),U)=$G(DFN)

 ...S $P(ABML(99,ABM("INS")),U,2)=$G(ABM("MDFN"))

 ...S $P(ABML(99,ABM("INS")),U,3)="M"

 ..S $P(ABML(99,ABM("INS")),U,6)=63

 E  I $D(ABML(ABM("PRI"),ABM("INS"))),ABM("PRI")<97 D

 .K ABML(99,ABM("INS"))

 K COV

 I $G(ABM("XIT")) D UNCHK^ABMDLCK2 Q

 I $G(ABM("XIT"))="A" K ABML(ABM("PRI"),ABM("INS"),"COV",ABM("CV"))

 Q

 ;

73 ;

 S ABM("REC")=^AUPNVAMB(DFN,11,ABM("MDFN"),0)

 I $P(ABM("REC"),U,1)>$P($S(ABMDISDT:ABMDISDT,1:ABMVDT),".",1) Q

 I $P(ABM("REC"),U,2)]"" Q:$P(ABM("REC"),U,2)<$P(ABMVDT,".",1)

 S ABMELGDT=1

 S COV=$P(ABM("REC"),U,3)

 ;For A or B get ien from ^AUTTPIC file

 I COV]"" S ABM("COV")=$O(^AUTTPIC("AC",ABM("INS"),COV,""))

 E  S ABM("COV")=""

 D CHK^ABMDLCK1

 Q

ABMDLCK4  ; IHS/SD/SDR - check visit for elig - PART 4 ;   

 +1       ;;2.6;IHS Third Party Billing System;**21**;NOV 12, 2009;Build 379

 +2       ;IHS/SD/SDR - 2.6*21 - VMBP RQMT_90 - new routine

 +3       ; *********************************************************************

7         ;EP - VMBP Elig Chk

 +1        SET ABM("TYP")="P"

 +2        SET ABM("PRI")=5

 +3       ;After setting priority we check VAMB eligibility file

 +4       ;check AUPNPRVT for VA entries

           SET ABM("VACHK")=1

           DO 5^ABMDLCK2

 +5        SET ABM("TYP")="V"

 +6        SET ABM("PRI")=5

 +7        DO PRIO^ABMDLCK2

 +8        IF '$DATA(^AUPNVAMB(DFN,0))

               QUIT 

 +9        DO FIND^DIC(9999999.18,"","@;.01;.211","CP","V","*",,"I $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,Y,"".211"",""I""),1,""I"")=""V""","","ABMIL")

 +10       IF +$ORDER(ABMIL("DILIST",0))=0

               SET ABME(252)=""

               QUIT 

 +11       SET ABM("INS")=$PIECE($GET(^AUPNVAMB(DFN,0)),U,2)

 +12       KILL ABM("REC")

 +13       IF '+$ORDER(^AUPNVAMB(DFN,11,0))

               Begin DoDot:1

 +14               DO CHK^ABMDLCK1

 +15               IF $GET(ABM("XIT"))

                       DO UNCHK^ABMDLCK2

               End DoDot:1

               QUIT 

 +16      ;Node 11 has eligibility dates

 +17       SET ABMELGDT=0

 +18       SET ABM("MDFN")=0

 +19       FOR 

               SET ABM("MDFN")=$ORDER(^AUPNVAMB(DFN,11,ABM("MDFN")))

               IF 'ABM("MDFN")

                   QUIT 

               DO 73

 +20       IF 'ABMELGDT

               Begin DoDot:1

 +21               IF '$DATA(ABML(ABM("PRI"),ABM("INS")))

                       Begin DoDot:2

 +22                       IF '$DATA(ABML(99,ABM("INS")))

                               Begin DoDot:3

 +23                               SET $PIECE(ABML(99,ABM("INS")),U)=$GET(DFN)

 +24                               SET $PIECE(ABML(99,ABM("INS")),U,2)=$GET(ABM("MDFN"))

 +25                               SET $PIECE(ABML(99,ABM("INS")),U,3)="M"

                               End DoDot:3

 +26                       SET $PIECE(ABML(99,ABM("INS")),U,6)=63

                       End DoDot:2

               End DoDot:1

               QUIT 

 +27      IF '$TEST

               IF $DATA(ABML(ABM("PRI"),ABM("INS")))

                   IF ABM("PRI")<97

                       Begin DoDot:1

 +28                       KILL ABML(99,ABM("INS"))

                       End DoDot:1

 +29       KILL COV

 +30       IF $GET(ABM("XIT"))

               DO UNCHK^ABMDLCK2

               QUIT 

 +31       IF $GET(ABM("XIT"))="A"

               KILL ABML(ABM("PRI"),ABM("INS"),"COV",ABM("CV"))

 +32       QUIT 

 +33      ;

73        ;

 +1        SET ABM("REC")=^AUPNVAMB(DFN,11,ABM("MDFN"),0)

 +2        IF $PIECE(ABM("REC"),U,1)>$PIECE($SELECT(ABMDISDT:ABMDISDT,1:ABMVDT),".",1)

               QUIT 

 +3        IF $PIECE(ABM("REC"),U,2)]""

               IF $PIECE(ABM("REC"),U,2)<$PIECE(ABMVDT,".",1)

                   QUIT 

 +4        SET ABMELGDT=1

 +5        SET COV=$PIECE(ABM("REC"),U,3)

 +6       ;For A or B get ien from ^AUTTPIC file

 +7        IF COV]""

               SET ABM("COV")=$ORDER(^AUTTPIC("AC",ABM("INS"),COV,""))

 +8       IF '$TEST

               SET ABM("COV")=""

 +9        DO CHK^ABMDLCK1

 +10       QUIT