Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AGEVC

AGEVC.m

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