- 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
