AGEVC ; cmi/flag/maw - AGEV Eligibility Check Driver ;
;;7.1;PATIENT REGISTRATION;**2**;JAN 31, 2007
;
;this routine will act as a trigger for manually sending a 270 message
;for eligibility information
;
MAIN ;-- this is the main routine driver
D PAT
I '$G(AGEVPAT) W !,"No Patient Selected",! Q
D TYP
I '$D(AGEVVST) D Q
. I $D(AGEVMESS) W !,AGEVMESS,! Q
. W !,"No Visit Selected",! Q
Q:$D(DIRUT)
D INS,EOJ
Q
;
PAT ;-- get the patient
W !
S APCDPAT=""
S DIC="^AUPNPAT(",DIC(0)="AEMQ"
D ^DIC
KILL DIC
Q:Y<0
S (APCDPAT,AGEVPAT)=+Y
Q
;
TYP ;-- select eligibility by which type of action
S DIR(0)="S^A:Admit Date;V:Visit Date;E:Eligibility Date"
S DIR("A")="Send Eligibility Request by "
S DIR("B")="E"
D ^DIR
Q:$D(DIRUT)
S AGEVET=Y
K DIR
S DIR(0)="Y"
S DIR("A")="Would you like to override previous eligibility checks "
D ^DIR
S AGEVOELG=+Y
K DIR
I AGEVET="A" S (AGEV("DTP012100C"),AGEV("DTP012100D"))="435"
I AGEVET="V" S (AGEV("DTP012100C"),AGEV("DTP012100D"))="472",AGEVET="A"
D @AGEVET
Q
;
A ;-- admit/visit date
S APCDLOOK="",APCDVSIT=""
KILL APCDVLK
D ^APCDVLK
Q:'$G(APCDVSIT)
KILL APCDLOOK
S AGEVVST=$G(APCDVSIT)
S AGEVVSDT=$$VALI^XBDIQ1(9000010,AGEVVST,.01)
I $$ECHK(AGEVPAT,AGEVVSDT,$G(AGEVOELG)) D Q
. S AGEVMESS="Eligibility already checked within last 30 days"
.Q
S (AGEV("DTP032100C"),AGEV("DTP032100D"))=$$DATE^INHUT(AGEVVSDT)
Q
;
E ;-- send by eligibility date
S %DT="AE",%DT("A")="Check which date for eligibility: "
S %DT("B")=$$FMTE^XLFDT(DT)
D ^%DT
Q:Y<0
S AGEVVSDT=+Y
I $$ECHK(AGEVPAT,AGEVVSDT,$G(AGEVOELG)) D Q
. S AGEVMESS="Eligibility already checked within last 30 days"
.Q
D E1(AGEVVSDT)
Q
;
E1(AGEVVSDT) ;EP - for setting up necessary elig date vars
S AGEVVST="0"
S (AGEV("DTP032100C"),AGEV("DTP032100D"))=$$DATE^INHUT(AGEVVSDT)
S (AGEV("DTP012100C"),AGEV("DTP012100D"))="307"
Q
;
INS ;-- which type of insurance should be checked?
S DIR(0)="S^MR:Medicare;MC:Medicaid;PI:Private Insurance;RR:Railroad"
S DIR(0)=DIR(0)_";AL:All"
S DIR("A")="Check which insurance for eligibility "
S DIR("B")="AL"
D ^DIR
Q:$D(DIRUT)
S AGEVINS=Y
;D @AGEVINS(AGEVPAT,AGEVVST) ;THIS PRODCUES AN UNDEFINED ERROR BECAUSE THE INDIRECTION TRIES TO TAKE THE VALUE FROM THE ARRAY AGEVINS(AGEVPAT,AGEVVST)
S TAGCALL=AGEVINS_"("_AGEVPAT_","_AGEVVST_")" ;SET UP VARIABLE CALL INSTR
D @TAGCALL ;DO THE CALL
K TAGCALL
;
Q
;
MR(AGEVPAT,AGEVVST) ;EP - get the medicare entry
Q:'$O(^AUPNMCR("B",AGEVPAT,0))
D KILL
NEW AGEVPOLH,AGEVPOLL,AGEVPOLF,AGEVPOLM
S INDA(9000003,1)=AGEVPAT
S AGEVIPI=$$VALI^XBDIQ1(9000003,AGEVPAT,.02)
S AGEVIPE=$$GET1^DIQ(9000003,AGEVPAT,.02)
S AGEV("NM1032100A")=AGEVIPE
I AGEVIPI'="" D
. S AGEV("NM1092100A")=$$GET1^DIQ(9999999.18,AGEVIPI,.07)
. I AGEV("NM1092100A")="" S AGEV("NM1092100A")="00"
.Q
S AGEVPOLH=$$GET1^DIQ(9000003,AGEVPAT,.01)
S AGEVPOLL=$P(AGEVPOLH,",")
S AGEVPOLF=$P($P(AGEVPOLH,",",2)," ")
S AGEVPOLM=$P($P(AGEVPOLH,",",2)," ",2)
S AGEV("NM1032100C")=$G(AGEVPOLL)
S AGEV("NM1042100C")=$G(AGEVPOLF)
S AGEV("NM1052100C")=$G(AGEVPOLM)
S AGEVMCRN=$$GET1^DIQ(9000003,AGEVPAT,.03)
S AGEVMCRS=$$GET1^DIQ(9000003,AGEVPAT,.04)
S AGEV("NM1092100C")=AGEVMCRN_AGEVMCRS
S AGEV("N3012100C")=$$GET1^DIQ(2,AGEVPAT,.111)
;S AGEV("N4012100C")=$$GET1^DIQ(2,AGEVPAT,.114)
S AGEV("N4012100C")=$$GET1^DIQ(9000001,AGEVPAT,1118)
S AGEVRRS=$$VALI^XBDIQ1(9000001,AGEVPAT,1117) I AGEVRRS'="" D
. S AGEVCSTI=$$VALI^XBDIQ1(9999999.05,AGEVRRS,.03)
. I AGEVCSTI'="" S AGEV("N4022100C")=$$GET1^DIQ(5,AGEVCSTI,1)
.Q
S AGEV("N4032100C")=$$GET1^DIQ(2,AGEVPAT,.116)
S AGEVDA=0 F S AGEVDA=$O(^AUPNMCR(AGEVPAT,11,AGEVDA)) Q:'AGEVDA D
. Q:$G(AGEV("MEDICARE SENT")) ;only send one message for all medicare
. S BHLXCT=$P($G(^AUPNMCR(AGEVPAT,11,AGEVDA,0)),U,3)
. S BHLEQ=$S(BHLXCT="A":"MA",1:"MB")
. S AGEV("EQ042100C")=$G(BHLEQ)
. S INDA=AGEVPAT,INDA(9000010,1)=AGEVVST,INDA(2,1)=INDA
. ;S X="BHL SEND X12 270 MESSAGE SUBSCRIBER",DIC=101 D EN^XQOR
. S AGEVMSG=$$ELGS^BHLEVENT(AGEVPAT,AGEVVST,.AGEV)
. S AGEV("MEDICARE SENT")=1 ;flag medicare that is sent
.Q
Q
;
MC(AGEVPAT,AGEVVST) ;EP - get the medicaid entry
Q:'$O(^AUPNMCD("B",AGEVPAT,0))
D KILL
NEW AGEVPOLH,AGEVPOLL,AGEVPOLF,AGEVPOLM,AGEVIPI
S AGEVDA=0
F S AGEVDA=$O(^AUPNMCD("B",AGEVPAT,AGEVDA)) Q:'AGEVDA D
. S INDA(9000004,1)=AGEVDA
. S AGEVIPI=$$VALI^XBDIQ1(9000004,AGEVDA,.11)
. S AGEVIPE=$$GET1^DIQ(9000004,AGEVDA,.11)
. I AGEVIPI="" S AGEVIPI=$$VALI^XBDIQ1(9000004,AGEVDA,.02)
. I AGEVIPE="" S AGEVIPE=$$GET1^DIQ(9000004,AGEVDA,.02)
. S AGEV("NM1032100A")=AGEVIPE
. I AGEVIPI'="" D
.. S AGEV("NM1092100A")=$$GET1^DIQ(9999999.18,AGEVIPI,.07)
.. I AGEV("NM1092100A")="" S AGEV("NM1092100A")="00"
..Q
. S AGEVPOLH=$$GET1^DIQ(9000004,AGEVDA,.01)
. S AGEVPOLL=$P(AGEVPOLH,",")
. S AGEVPOLF=$P($P(AGEVPOLH,",",2)," ")
. S AGEVPOLM=$P($P(AGEVPOLH,",",2)," ",2)
. S AGEV("NM1032100C")=$G(AGEVPOLL)
. S AGEV("NM1042100C")=$G(AGEVPOLF)
. S AGEV("NM1052100C")=$G(AGEVPOLM)
. S AGEV("NM1092100C")=$$GET1^DIQ(9000004,AGEVDA,.03)
. S AGEV("N3012100C")=$$GET1^DIQ(2,AGEVPAT,.111)
. S AGEV("N4012100C")=$$GET1^DIQ(2,AGEVPAT,.114)
. S AGEV("N4012100C")=$$GET1^DIQ(9000001,AGEVPAT,1118)
. S AGEVRRS=$$VALI^XBDIQ1(9000001,AGEVPAT,1117) I AGEVRRS'="" D
.. S AGEVCSTI=$$VALI^XBDIQ1(9999999.05,AGEVRRS,.03)
.. I AGEVCSTI'="" S AGEV("N4022100C")=$$GET1^DIQ(5,AGEVCSTI,1)
..Q
. S AGEV("N4032100C")=$$GET1^DIQ(2,AGEVPAT,.116)
. S AGEV("EQ042100C")="MC"
.Q
S INDA=AGEVPAT,INDA(9000010,1)=AGEVVST,INDA(2,1)=INDA
;S X="BHL SEND X12 270 MESSAGE SUBSCRIBER",DIC=101 D EN^XQOR
S AGEVMSG=$$ELGS^BHLEVENT(AGEVPAT,AGEVVST,.AGEV)
Q
;
PI(AGEVPAT,AGEVVST) ;EP - get the private insurance entries
Q:'$O(^AUPNPRVT("B",AGEVPAT,0))
D KILL
NEW AGEVPOLH,AGEVPOLL,AGEVPOLF,AGEVPOLM
S INDA(9000006,1)=AGEVPAT
S AGEVPOLH=$$GET1^DIQ(9000006,AGEVPAT,.01)
S AGEVPOLL=$P(AGEVPOLH,",")
S AGEVPOLF=$P($P(AGEVPOLH,",",2)," ")
S AGEVPOLM=$P($P(AGEVPOLH,",",2)," ",2)
S AGEVDA=0
F S AGEVDA=$O(^AUPNPRVT(AGEVPAT,11,AGEVDA)) Q:'AGEVDA D
. S AGEVPOLP=$P($G(^AUPNPRVT(AGEVPAT,11,AGEVDA,0)),U,8)
. Q:'$G(AGEVPOLP)
. I AGEVPOLP'="" S AGEVPLPP=$$VALI^XBDIQ1(9000003.1,AGEVPOLP,.02)
. S AGEV("INS022100D")="19"
. S AGEVRELI=$P($G(^AUPNPRVT(AGEVPAT,11,AGEVDA,0)),U,5)
. I AGEVRELI'="" D
.. S AGEVRELC=$$VALI^XBDIQ1(9999999.36,AGEVRELI,.02)
.. I AGEVRELC="02" S AGEV("INS022100D")="01"
..Q
. I AGEVPLPP=AGEVPAT S AGEVSUBS=1
. I AGEVPOLP'="" D
.. S AGEVIPI=$$VALI^XBDIQ1(9000003.1,AGEVPOLP,.03)
.. S AGEVIPE=$$GET1^DIQ(9000003.1,AGEVPOLP,.03)
.. ;AG*7.1*2 ADDED NEXT TWO LINES BECAUSE SOMETIMES THE INS PTR IS NOT
.. ;ALWAYS POPULATED IN THE POLICY HOLDER FILE
.. S:AGEVIPI="" AGEVIPI=$$GET1^DIQ(9000006.11,AGEVDA_","_AGEVPAT_",",.01,"I")
.. S:AGEVIPE="" AGECIPE=$$GET1^DIQ(9000006.11,AGEVDA_","_AGEVPAT_",",.01)
.. S AGEV("REF02")=$$GET1^DIQ(9000003.1,AGEVPOLP,.04)
..Q
. S AGEV("NM1032100A")=AGEVIPE
. I AGEVIPI'="" D
.. S AGEV("NM1092100A")=$$GET1^DIQ(9999999.18,AGEVIPI,.07)
.. I AGEV("NM1092100A")="" S AGEV("NM1092100A")="00"
..Q
. Q:'$$VALI^XBDIQ1(9999999.18,AGEVIPI,.32) ;insurer chekd for elg?
. S AGEV("NM1032100C")=$G(AGEVPOLL)
. S AGEV("NM1042100C")=$G(AGEVPOLF)
. S AGEV("NM1052100C")=$G(AGEVPOLM)
. S AGEV("NM1092100C")=$$GET1^DIQ(9000003.1,AGEVPOLP,.04)
. S AGEV("N3012100C")=$$GET1^DIQ(9000003.1,AGEVPOLP,.09)
. S AGEV("N4012100C")=$$GET1^DIQ(9000003.1,AGEVPOLP,.11)
. S AGEVPRRS=$$VALI^XBDIQ1(9000003.1,AGEVPOLP,.12)
. I AGEVPRRS'="" S AGEV("N4022100C")=$$GET1^DIQ(5,AGEVPRRS,1)
. S AGEV("N4032100C")=$$GET1^DIQ(9000003.1,AGEVPOLP,.13)
. S AGEV("EQ042100C")="GP"
. S AGEVPPLH=$$GET1^DIQ(2,AGEVPAT,.01)
. S AGEVPPLL=$P(AGEVPPLH,",")
. S AGEVPPLF=$P($P(AGEVPPLH,",",2)," ")
. S AGEVPPLM=$P($P(AGEVPPLH,",",2)," ",2)
. S AGEV("NM1032100D")=$G(AGEVPPLL)
. S AGEV("NM1042100D")=$G(AGEVPPLF)
. S AGEV("NM1052100D")=$G(AGEVPPLM)
. S AGEV("NM1092100D")=""
. S AGEV("N3012100D")=$$GET1^DIQ(2,AGEVPAT,.111)
. S AGEV("N4012100C")=$$GET1^DIQ(9000001,AGEVPAT,1118)
. S AGEVRRS=$$VALI^XBDIQ1(9000001,AGEVPAT,1117) I AGEVRRS'="" D
.. S AGEVCSTI=$$VALI^XBDIQ1(9999999.05,AGEVRRS,.03)
.. I AGEVCSTI'="" S AGEV("N4022100C")=$$GET1^DIQ(5,AGEVCSTI,1)
..Q
. S AGEV("N4032100D")=$$GET1^DIQ(2,AGEVPAT,.116)
. S AGEV("EQ042100D")="GP"
. S INDA=AGEVPAT,INDA(9000010,1)=AGEVVST,INDA(2,1)=INDA
. I $G(AGEVSUBS) D Q
.. S AGEVMSG=$$ELGS^BHLEVENT(AGEVPAT,AGEVVST,.AGEV)
.. ;S X="BHL SEND X12 270 MESSAGE SUBSCRIBER",DIC=101 D EN^XQOR
.. K AGEVSUBS
..Q
. ;S X="BHL SEND X12 270 MESSAGE",DIC=101 D EN^XQOR
. S AGEVMSG=$$ELG^BHLEVENT(AGEVPAT,AGEVVST,.AGEV)
.Q
Q
;
RR(AGEVPAT,AGEVVST) ;EP - get railroad entries
Q:'$O(^AUPNRRE("B",AGEVPAT,0))
D KILL
S INDA(9000005,1)=AGEVPAT
S AGEVIPI=$$VALI^XBDIQ1(9000005,AGEVPAT,.02)
S AGEVIPE=$$GET1^DIQ(9000005,AGEVPAT,.02)
S AGEV("NM1032100A")=AGEVIPE
I AGEVIPI'="" S AGEV("NM1092100A")=$$GET1^DIQ(9999999.18,AGEVIPI,.07)
S AGEVPOLH=$$GET1^DIQ(9000005,AGEVPAT,.01)
S AGEVPOLL=$P(AGEVPOLH,",")
S AGEVPOLF=$P($P(AGEVPOLH,",",2)," ")
S AGEVPOLM=$P($P(AGEVPOLH,",",2)," ",2)
S AGEV("NM1032100C")=$G(AGEVPOLL)
S AGEV("NM1042100C")=$G(AGEVPOLF)
S AGEV("NM1052100C")=$G(AGEVPOLM)
S AGEV("NM1092100C")=$$GET1^DIQ(9000005,AGEVPAT,.04)
S AGEV("N3012100C")=$$GET1^DIQ(2,AGEVPAT,.111)
S AGEV("N4012100C")=$$GET1^DIQ(2,AGEVPAT,.114)
S AGEVRRS=$$VALI^XBDIQ1(2,AGEVPAT,.115)
I AGEVRRS'="" S AGEV("N4022100C")=$$GET1^DIQ(5,AGEVRRS,1)
S AGEV("N4032100C")=$$GET1^DIQ(2,AGEVPAT,.116)
S AGEV("EQ042100C")="GP"
S INDA=AGEVPAT,INDA(9000010,1)=AGEVVST,INDA(2,1)=INDA
;S X="BHL SEND X12 270 MESSAGE SUBSCRIBER",DIC=101 D EN^XQOR
S AGEVMSG=$$ELGS^BHLEVENT(AGEVPAT,AGEVVST,.AGEV)
Q
;
AL(AGEVPAT,AGEVVST) ;EP - get all the entries
D MR(AGEVPAT,AGEVVST),MC(AGEVPAT,AGEVVST),PI(AGEVPAT,AGEVVST)
D RR(AGEVPAT,AGEVVST)
D LOG(AGEVPAT)
D EOJ
Q
;
EOJ ;-- kill variables and quit
I '$G(AGEVEXT) D EN^XBVK("AGEV")
D EN^XBVK("APCD")
D EN^XBVK("BHL")
Q
;
ECHK(PAT,ELGDT,OELG) ;EP - last eligibility update
I 'ELGDT Q 1
S AGEVINT=$$GET1^DIQ(9009061,DUZ(2),35)
I AGEVINT="" S AGEVINT=30
I '$P($G(^AUPNPAT(PAT,0)),U,38) Q 0
I $G(OELG) D LOG(PAT) Q 0
NEW X
S X2=ELGDT,X1=$P($G(^AUPNPAT(PAT,0)),U,38)
D ^%DTC
I X<AGEVINT Q 1
Q 0
;
VSDT(VST) ;-- return visit date
S AGEVVSDT=$P($P($G(^AUPNVSIT(VST,0)),U),".")
Q AGEVVSDT
;
LOG(PAT) ;-- set the update array in the patient file
S DIE="^AUPNPAT(",DA=PAT,DR=".38///"_DT
D ^DIE
Q
;
KILL ;-- kill off array
KILL INDA(9000003),INDA(9000004),INDA(9000005),INDA(9000003.1)
KILL AGEV(9000003),AGEV(9000004),AGEV(9000005),AGEV(9000003.1)
Q
;
AGEVC ; cmi/flag/maw - AGEV Eligibility Check Driver ;
+1 ;;7.1;PATIENT REGISTRATION;**2**;JAN 31, 2007
+2 ;
+3 ;this routine will act as a trigger for manually sending a 270 message
+4 ;for eligibility information
+5 ;
MAIN ;-- this is the main routine driver
+1 DO PAT
+2 IF '$GET(AGEVPAT)
WRITE !,"No Patient Selected",!
QUIT
+3 DO TYP
+4 IF '$DATA(AGEVVST)
Begin DoDot:1
+5 IF $DATA(AGEVMESS)
WRITE !,AGEVMESS,!
QUIT
+6 WRITE !,"No Visit Selected",!
QUIT
End DoDot:1
QUIT
+7 IF $DATA(DIRUT)
QUIT
+8 DO INS
DO EOJ
+9 QUIT
+10 ;
PAT ;-- get the patient
+1 WRITE !
+2 SET APCDPAT=""
+3 SET DIC="^AUPNPAT("
SET DIC(0)="AEMQ"
+4 DO ^DIC
+5 KILL DIC
+6 IF Y<0
QUIT
+7 SET (APCDPAT,AGEVPAT)=+Y
+8 QUIT
+9 ;
TYP ;-- select eligibility by which type of action
+1 SET DIR(0)="S^A:Admit Date;V:Visit Date;E:Eligibility Date"
+2 SET DIR("A")="Send Eligibility Request by "
+3 SET DIR("B")="E"
+4 DO ^DIR
+5 IF $DATA(DIRUT)
QUIT
+6 SET AGEVET=Y
+7 KILL DIR
+8 SET DIR(0)="Y"
+9 SET DIR("A")="Would you like to override previous eligibility checks "
+10 DO ^DIR
+11 SET AGEVOELG=+Y
+12 KILL DIR
+13 IF AGEVET="A"
SET (AGEV("DTP012100C"),AGEV("DTP012100D"))="435"
+14 IF AGEVET="V"
SET (AGEV("DTP012100C"),AGEV("DTP012100D"))="472"
SET AGEVET="A"
+15 DO @AGEVET
+16 QUIT
+17 ;
A ;-- admit/visit date
+1 SET APCDLOOK=""
SET APCDVSIT=""
+2 KILL APCDVLK
+3 DO ^APCDVLK
+4 IF '$GET(APCDVSIT)
QUIT
+5 KILL APCDLOOK
+6 SET AGEVVST=$GET(APCDVSIT)
+7 SET AGEVVSDT=$$VALI^XBDIQ1(9000010,AGEVVST,.01)
+8 IF $$ECHK(AGEVPAT,AGEVVSDT,$GET(AGEVOELG))
Begin DoDot:1
+9 SET AGEVMESS="Eligibility already checked within last 30 days"
+10 QUIT
End DoDot:1
QUIT
+11 SET (AGEV("DTP032100C"),AGEV("DTP032100D"))=$$DATE^INHUT(AGEVVSDT)
+12 QUIT
+13 ;
E ;-- send by eligibility date
+1 SET %DT="AE"
SET %DT("A")="Check which date for eligibility: "
+2 SET %DT("B")=$$FMTE^XLFDT(DT)
+3 DO ^%DT
+4 IF Y<0
QUIT
+5 SET AGEVVSDT=+Y
+6 IF $$ECHK(AGEVPAT,AGEVVSDT,$GET(AGEVOELG))
Begin DoDot:1
+7 SET AGEVMESS="Eligibility already checked within last 30 days"
+8 QUIT
End DoDot:1
QUIT
+9 DO E1(AGEVVSDT)
+10 QUIT
+11 ;
E1(AGEVVSDT) ;EP - for setting up necessary elig date vars
+1 SET AGEVVST="0"
+2 SET (AGEV("DTP032100C"),AGEV("DTP032100D"))=$$DATE^INHUT(AGEVVSDT)
+3 SET (AGEV("DTP012100C"),AGEV("DTP012100D"))="307"
+4 QUIT
+5 ;
INS ;-- which type of insurance should be checked?
+1 SET DIR(0)="S^MR:Medicare;MC:Medicaid;PI:Private Insurance;RR:Railroad"
+2 SET DIR(0)=DIR(0)_";AL:All"
+3 SET DIR("A")="Check which insurance for eligibility "
+4 SET DIR("B")="AL"
+5 DO ^DIR
+6 IF $DATA(DIRUT)
QUIT
+7 SET AGEVINS=Y
+8 ;D @AGEVINS(AGEVPAT,AGEVVST) ;THIS PRODCUES AN UNDEFINED ERROR BECAUSE THE INDIRECTION TRIES TO TAKE THE VALUE FROM THE ARRAY AGEVINS(AGEVPAT,AGEVVST)
+9 ;SET UP VARIABLE CALL INSTR
SET TAGCALL=AGEVINS_"("_AGEVPAT_","_AGEVVST_")"
+10 ;DO THE CALL
DO @TAGCALL
+11 KILL TAGCALL
+12 ;
+13 QUIT
+14 ;
MR(AGEVPAT,AGEVVST) ;EP - get the medicare entry
+1 IF '$ORDER(^AUPNMCR("B",AGEVPAT,0))
QUIT
+2 DO KILL
+3 NEW AGEVPOLH,AGEVPOLL,AGEVPOLF,AGEVPOLM
+4 SET INDA(9000003,1)=AGEVPAT
+5 SET AGEVIPI=$$VALI^XBDIQ1(9000003,AGEVPAT,.02)
+6 SET AGEVIPE=$$GET1^DIQ(9000003,AGEVPAT,.02)
+7 SET AGEV("NM1032100A")=AGEVIPE
+8 IF AGEVIPI'=""
Begin DoDot:1
+9 SET AGEV("NM1092100A")=$$GET1^DIQ(9999999.18,AGEVIPI,.07)
+10 IF AGEV("NM1092100A")=""
SET AGEV("NM1092100A")="00"
+11 QUIT
End DoDot:1
+12 SET AGEVPOLH=$$GET1^DIQ(9000003,AGEVPAT,.01)
+13 SET AGEVPOLL=$PIECE(AGEVPOLH,",")
+14 SET AGEVPOLF=$PIECE($PIECE(AGEVPOLH,",",2)," ")
+15 SET AGEVPOLM=$PIECE($PIECE(AGEVPOLH,",",2)," ",2)
+16 SET AGEV("NM1032100C")=$GET(AGEVPOLL)
+17 SET AGEV("NM1042100C")=$GET(AGEVPOLF)
+18 SET AGEV("NM1052100C")=$GET(AGEVPOLM)
+19 SET AGEVMCRN=$$GET1^DIQ(9000003,AGEVPAT,.03)
+20 SET AGEVMCRS=$$GET1^DIQ(9000003,AGEVPAT,.04)
+21 SET AGEV("NM1092100C")=AGEVMCRN_AGEVMCRS
+22 SET AGEV("N3012100C")=$$GET1^DIQ(2,AGEVPAT,.111)
+23 ;S AGEV("N4012100C")=$$GET1^DIQ(2,AGEVPAT,.114)
+24 SET AGEV("N4012100C")=$$GET1^DIQ(9000001,AGEVPAT,1118)
+25 SET AGEVRRS=$$VALI^XBDIQ1(9000001,AGEVPAT,1117)
IF AGEVRRS'=""
Begin DoDot:1
+26 SET AGEVCSTI=$$VALI^XBDIQ1(9999999.05,AGEVRRS,.03)
+27 IF AGEVCSTI'=""
SET AGEV("N4022100C")=$$GET1^DIQ(5,AGEVCSTI,1)
+28 QUIT
End DoDot:1
+29 SET AGEV("N4032100C")=$$GET1^DIQ(2,AGEVPAT,.116)
+30 SET AGEVDA=0
FOR
SET AGEVDA=$ORDER(^AUPNMCR(AGEVPAT,11,AGEVDA))
IF 'AGEVDA
QUIT
Begin DoDot:1
+31 ;only send one message for all medicare
IF $GET(AGEV("MEDICARE SENT"))
QUIT
+32 SET BHLXCT=$PIECE($GET(^AUPNMCR(AGEVPAT,11,AGEVDA,0)),U,3)
+33 SET BHLEQ=$SELECT(BHLXCT="A":"MA",1:"MB")
+34 SET AGEV("EQ042100C")=$GET(BHLEQ)
+35 SET INDA=AGEVPAT
SET INDA(9000010,1)=AGEVVST
SET INDA(2,1)=INDA
+36 ;S X="BHL SEND X12 270 MESSAGE SUBSCRIBER",DIC=101 D EN^XQOR
+37 SET AGEVMSG=$$ELGS^BHLEVENT(AGEVPAT,AGEVVST,.AGEV)
+38 ;flag medicare that is sent
SET AGEV("MEDICARE SENT")=1
+39 QUIT
End DoDot:1
+40 QUIT
+41 ;
MC(AGEVPAT,AGEVVST) ;EP - get the medicaid entry
+1 IF '$ORDER(^AUPNMCD("B",AGEVPAT,0))
QUIT
+2 DO KILL
+3 NEW AGEVPOLH,AGEVPOLL,AGEVPOLF,AGEVPOLM,AGEVIPI
+4 SET AGEVDA=0
+5 FOR
SET AGEVDA=$ORDER(^AUPNMCD("B",AGEVPAT,AGEVDA))
IF 'AGEVDA
QUIT
Begin DoDot:1
+6 SET INDA(9000004,1)=AGEVDA
+7 SET AGEVIPI=$$VALI^XBDIQ1(9000004,AGEVDA,.11)
+8 SET AGEVIPE=$$GET1^DIQ(9000004,AGEVDA,.11)
+9 IF AGEVIPI=""
SET AGEVIPI=$$VALI^XBDIQ1(9000004,AGEVDA,.02)
+10 IF AGEVIPE=""
SET AGEVIPE=$$GET1^DIQ(9000004,AGEVDA,.02)
+11 SET AGEV("NM1032100A")=AGEVIPE
+12 IF AGEVIPI'=""
Begin DoDot:2
+13 SET AGEV("NM1092100A")=$$GET1^DIQ(9999999.18,AGEVIPI,.07)
+14 IF AGEV("NM1092100A")=""
SET AGEV("NM1092100A")="00"
+15 QUIT
End DoDot:2
+16 SET AGEVPOLH=$$GET1^DIQ(9000004,AGEVDA,.01)
+17 SET AGEVPOLL=$PIECE(AGEVPOLH,",")
+18 SET AGEVPOLF=$PIECE($PIECE(AGEVPOLH,",",2)," ")
+19 SET AGEVPOLM=$PIECE($PIECE(AGEVPOLH,",",2)," ",2)
+20 SET AGEV("NM1032100C")=$GET(AGEVPOLL)
+21 SET AGEV("NM1042100C")=$GET(AGEVPOLF)
+22 SET AGEV("NM1052100C")=$GET(AGEVPOLM)
+23 SET AGEV("NM1092100C")=$$GET1^DIQ(9000004,AGEVDA,.03)
+24 SET AGEV("N3012100C")=$$GET1^DIQ(2,AGEVPAT,.111)
+25 SET AGEV("N4012100C")=$$GET1^DIQ(2,AGEVPAT,.114)
+26 SET AGEV("N4012100C")=$$GET1^DIQ(9000001,AGEVPAT,1118)
+27 SET AGEVRRS=$$VALI^XBDIQ1(9000001,AGEVPAT,1117)
IF AGEVRRS'=""
Begin DoDot:2
+28 SET AGEVCSTI=$$VALI^XBDIQ1(9999999.05,AGEVRRS,.03)
+29 IF AGEVCSTI'=""
SET AGEV("N4022100C")=$$GET1^DIQ(5,AGEVCSTI,1)
+30 QUIT
End DoDot:2
+31 SET AGEV("N4032100C")=$$GET1^DIQ(2,AGEVPAT,.116)
+32 SET AGEV("EQ042100C")="MC"
+33 QUIT
End DoDot:1
+34 SET INDA=AGEVPAT
SET INDA(9000010,1)=AGEVVST
SET INDA(2,1)=INDA
+35 ;S X="BHL SEND X12 270 MESSAGE SUBSCRIBER",DIC=101 D EN^XQOR
+36 SET AGEVMSG=$$ELGS^BHLEVENT(AGEVPAT,AGEVVST,.AGEV)
+37 QUIT
+38 ;
PI(AGEVPAT,AGEVVST) ;EP - get the private insurance entries
+1 IF '$ORDER(^AUPNPRVT("B",AGEVPAT,0))
QUIT
+2 DO KILL
+3 NEW AGEVPOLH,AGEVPOLL,AGEVPOLF,AGEVPOLM
+4 SET INDA(9000006,1)=AGEVPAT
+5 SET AGEVPOLH=$$GET1^DIQ(9000006,AGEVPAT,.01)
+6 SET AGEVPOLL=$PIECE(AGEVPOLH,",")
+7 SET AGEVPOLF=$PIECE($PIECE(AGEVPOLH,",",2)," ")
+8 SET AGEVPOLM=$PIECE($PIECE(AGEVPOLH,",",2)," ",2)
+9 SET AGEVDA=0
+10 FOR
SET AGEVDA=$ORDER(^AUPNPRVT(AGEVPAT,11,AGEVDA))
IF 'AGEVDA
QUIT
Begin DoDot:1
+11 SET AGEVPOLP=$PIECE($GET(^AUPNPRVT(AGEVPAT,11,AGEVDA,0)),U,8)
+12 IF '$GET(AGEVPOLP)
QUIT
+13 IF AGEVPOLP'=""
SET AGEVPLPP=$$VALI^XBDIQ1(9000003.1,AGEVPOLP,.02)
+14 SET AGEV("INS022100D")="19"
+15 SET AGEVRELI=$PIECE($GET(^AUPNPRVT(AGEVPAT,11,AGEVDA,0)),U,5)
+16 IF AGEVRELI'=""
Begin DoDot:2
+17 SET AGEVRELC=$$VALI^XBDIQ1(9999999.36,AGEVRELI,.02)
+18 IF AGEVRELC="02"
SET AGEV("INS022100D")="01"
+19 QUIT
End DoDot:2
+20 IF AGEVPLPP=AGEVPAT
SET AGEVSUBS=1
+21 IF AGEVPOLP'=""
Begin DoDot:2
+22 SET AGEVIPI=$$VALI^XBDIQ1(9000003.1,AGEVPOLP,.03)
+23 SET AGEVIPE=$$GET1^DIQ(9000003.1,AGEVPOLP,.03)
+24 ;AG*7.1*2 ADDED NEXT TWO LINES BECAUSE SOMETIMES THE INS PTR IS NOT
+25 ;ALWAYS POPULATED IN THE POLICY HOLDER FILE
+26 IF AGEVIPI=""
SET AGEVIPI=$$GET1^DIQ(9000006.11,AGEVDA_","_AGEVPAT_",",.01,"I")
+27 IF AGEVIPE=""
SET AGECIPE=$$GET1^DIQ(9000006.11,AGEVDA_","_AGEVPAT_",",.01)
+28 SET AGEV("REF02")=$$GET1^DIQ(9000003.1,AGEVPOLP,.04)
+29 QUIT
End DoDot:2
+30 SET AGEV("NM1032100A")=AGEVIPE
+31 IF AGEVIPI'=""
Begin DoDot:2
+32 SET AGEV("NM1092100A")=$$GET1^DIQ(9999999.18,AGEVIPI,.07)
+33 IF AGEV("NM1092100A")=""
SET AGEV("NM1092100A")="00"
+34 QUIT
End DoDot:2
+35 ;insurer chekd for elg?
IF '$$VALI^XBDIQ1(9999999.18,AGEVIPI,.32)
QUIT
+36 SET AGEV("NM1032100C")=$GET(AGEVPOLL)
+37 SET AGEV("NM1042100C")=$GET(AGEVPOLF)
+38 SET AGEV("NM1052100C")=$GET(AGEVPOLM)
+39 SET AGEV("NM1092100C")=$$GET1^DIQ(9000003.1,AGEVPOLP,.04)
+40 SET AGEV("N3012100C")=$$GET1^DIQ(9000003.1,AGEVPOLP,.09)
+41 SET AGEV("N4012100C")=$$GET1^DIQ(9000003.1,AGEVPOLP,.11)
+42 SET AGEVPRRS=$$VALI^XBDIQ1(9000003.1,AGEVPOLP,.12)
+43 IF AGEVPRRS'=""
SET AGEV("N4022100C")=$$GET1^DIQ(5,AGEVPRRS,1)
+44 SET AGEV("N4032100C")=$$GET1^DIQ(9000003.1,AGEVPOLP,.13)
+45 SET AGEV("EQ042100C")="GP"
+46 SET AGEVPPLH=$$GET1^DIQ(2,AGEVPAT,.01)
+47 SET AGEVPPLL=$PIECE(AGEVPPLH,",")
+48 SET AGEVPPLF=$PIECE($PIECE(AGEVPPLH,",",2)," ")
+49 SET AGEVPPLM=$PIECE($PIECE(AGEVPPLH,",",2)," ",2)
+50 SET AGEV("NM1032100D")=$GET(AGEVPPLL)
+51 SET AGEV("NM1042100D")=$GET(AGEVPPLF)
+52 SET AGEV("NM1052100D")=$GET(AGEVPPLM)
+53 SET AGEV("NM1092100D")=""
+54 SET AGEV("N3012100D")=$$GET1^DIQ(2,AGEVPAT,.111)
+55 SET AGEV("N4012100C")=$$GET1^DIQ(9000001,AGEVPAT,1118)
+56 SET AGEVRRS=$$VALI^XBDIQ1(9000001,AGEVPAT,1117)
IF AGEVRRS'=""
Begin DoDot:2
+57 SET AGEVCSTI=$$VALI^XBDIQ1(9999999.05,AGEVRRS,.03)
+58 IF AGEVCSTI'=""
SET AGEV("N4022100C")=$$GET1^DIQ(5,AGEVCSTI,1)
+59 QUIT
End DoDot:2
+60 SET AGEV("N4032100D")=$$GET1^DIQ(2,AGEVPAT,.116)
+61 SET AGEV("EQ042100D")="GP"
+62 SET INDA=AGEVPAT
SET INDA(9000010,1)=AGEVVST
SET INDA(2,1)=INDA
+63 IF $GET(AGEVSUBS)
Begin DoDot:2
+64 SET AGEVMSG=$$ELGS^BHLEVENT(AGEVPAT,AGEVVST,.AGEV)
+65 ;S X="BHL SEND X12 270 MESSAGE SUBSCRIBER",DIC=101 D EN^XQOR
+66 KILL AGEVSUBS
+67 QUIT
End DoDot:2
QUIT
+68 ;S X="BHL SEND X12 270 MESSAGE",DIC=101 D EN^XQOR
+69 SET AGEVMSG=$$ELG^BHLEVENT(AGEVPAT,AGEVVST,.AGEV)
+70 QUIT
End DoDot:1
+71 QUIT
+72 ;
RR(AGEVPAT,AGEVVST) ;EP - get railroad entries
+1 IF '$ORDER(^AUPNRRE("B",AGEVPAT,0))
QUIT
+2 DO KILL
+3 SET INDA(9000005,1)=AGEVPAT
+4 SET AGEVIPI=$$VALI^XBDIQ1(9000005,AGEVPAT,.02)
+5 SET AGEVIPE=$$GET1^DIQ(9000005,AGEVPAT,.02)
+6 SET AGEV("NM1032100A")=AGEVIPE
+7 IF AGEVIPI'=""
SET AGEV("NM1092100A")=$$GET1^DIQ(9999999.18,AGEVIPI,.07)
+8 SET AGEVPOLH=$$GET1^DIQ(9000005,AGEVPAT,.01)
+9 SET AGEVPOLL=$PIECE(AGEVPOLH,",")
+10 SET AGEVPOLF=$PIECE($PIECE(AGEVPOLH,",",2)," ")
+11 SET AGEVPOLM=$PIECE($PIECE(AGEVPOLH,",",2)," ",2)
+12 SET AGEV("NM1032100C")=$GET(AGEVPOLL)
+13 SET AGEV("NM1042100C")=$GET(AGEVPOLF)
+14 SET AGEV("NM1052100C")=$GET(AGEVPOLM)
+15 SET AGEV("NM1092100C")=$$GET1^DIQ(9000005,AGEVPAT,.04)
+16 SET AGEV("N3012100C")=$$GET1^DIQ(2,AGEVPAT,.111)
+17 SET AGEV("N4012100C")=$$GET1^DIQ(2,AGEVPAT,.114)
+18 SET AGEVRRS=$$VALI^XBDIQ1(2,AGEVPAT,.115)
+19 IF AGEVRRS'=""
SET AGEV("N4022100C")=$$GET1^DIQ(5,AGEVRRS,1)
+20 SET AGEV("N4032100C")=$$GET1^DIQ(2,AGEVPAT,.116)
+21 SET AGEV("EQ042100C")="GP"
+22 SET INDA=AGEVPAT
SET INDA(9000010,1)=AGEVVST
SET INDA(2,1)=INDA
+23 ;S X="BHL SEND X12 270 MESSAGE SUBSCRIBER",DIC=101 D EN^XQOR
+24 SET AGEVMSG=$$ELGS^BHLEVENT(AGEVPAT,AGEVVST,.AGEV)
+25 QUIT
+26 ;
AL(AGEVPAT,AGEVVST) ;EP - get all the entries
+1 DO MR(AGEVPAT,AGEVVST)
DO MC(AGEVPAT,AGEVVST)
DO PI(AGEVPAT,AGEVVST)
+2 DO RR(AGEVPAT,AGEVVST)
+3 DO LOG(AGEVPAT)
+4 DO EOJ
+5 QUIT
+6 ;
EOJ ;-- kill variables and quit
+1 IF '$GET(AGEVEXT)
DO EN^XBVK("AGEV")
+2 DO EN^XBVK("APCD")
+3 DO EN^XBVK("BHL")
+4 QUIT
+5 ;
ECHK(PAT,ELGDT,OELG) ;EP - last eligibility update
+1 IF 'ELGDT
QUIT 1
+2 SET AGEVINT=$$GET1^DIQ(9009061,DUZ(2),35)
+3 IF AGEVINT=""
SET AGEVINT=30
+4 IF '$PIECE($GET(^AUPNPAT(PAT,0)),U,38)
QUIT 0
+5 IF $GET(OELG)
DO LOG(PAT)
QUIT 0
+6 NEW X
+7 SET X2=ELGDT
SET X1=$PIECE($GET(^AUPNPAT(PAT,0)),U,38)
+8 DO ^%DTC
+9 IF X<AGEVINT
QUIT 1
+10 QUIT 0
+11 ;
VSDT(VST) ;-- return visit date
+1 SET AGEVVSDT=$PIECE($PIECE($GET(^AUPNVSIT(VST,0)),U),".")
+2 QUIT AGEVVSDT
+3 ;
LOG(PAT) ;-- set the update array in the patient file
+1 SET DIE="^AUPNPAT("
SET DA=PAT
SET DR=".38///"_DT
+2 DO ^DIE
+3 QUIT
+4 ;
KILL ;-- kill off array
+1 KILL INDA(9000003),INDA(9000004),INDA(9000005),INDA(9000003.1)
+2 KILL AGEV(9000003),AGEV(9000004),AGEV(9000005),AGEV(9000003.1)
+3 QUIT
+4 ;
