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

IBCNBME.m

Go to the documentation of this file.
  1. IBCNBME ;ALB/ARH-Ins Buffer: external entry points, add/edit buffer ;1 Jun 97
  1. ;;2.0;INTEGRATED BILLING;**82,103,184**;21-MAR-94
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. FEE(DFN) ; ENTRY FOR FEE BASIS: add/edit a buffer entry
  1. I '$D(^DPT(+$G(DFN),0)) Q
  1. Q:'$$INSCOV(+DFN)
  1. D DISPLAY
  1. D EDADD(1,+DFN)
  1. Q
  1. ;
  1. REG(DFN) ; ENTRY FOR REGISTRATION: add/edit a buffer entry
  1. I '$D(^DPT(+$G(DFN),0)) Q
  1. Q:'$$INSCOV(+DFN)
  1. D DISPLAY
  1. D EDADD(1,+DFN)
  1. Q
  1. ;
  1. PREG(DFN) ; ENTRY FOR PRE-REGISTRATION: add/edit a buffer entry
  1. I '$D(^DPT(+$G(DFN),0)) Q
  1. Q:'$$INSCOV(+DFN)
  1. D DISPLAY
  1. D EDADD(4,+DFN)
  1. Q
  1. ;
  1. EDADD(IBSOURCE,DFN) ; add or select a specific patient's buffer entry then edit all data
  1. ; IBSOURCE = 1-interview, 2-data match, 3-ivm, 4-pre-reg, 5-eiiv
  1. N X,Y,IBX,IBY,IBBUFDA,DIR,DIRUT,IBINSNM I '$D(^DPT(+$G(DFN),0))!('$G(IBSOURCE)) Q
  1. ;
  1. ; allow user to choose one of their own entries for this patient to edit or add a new one
  1. S DIR("?")="^D HELP^IBCNBME"
  1. S DIR(0)="FO^3:30",DIR("A")="Select INSURANCE COMPANY" D ^DIR I $D(DIRUT)!(Y="") Q
  1. ;
  1. S IBINSNM=$$UP^XLFSTR(Y),IBBUFDA=0
  1. ;
  1. ; -- If Medicare (WNR) entered call MII
  1. I IBINSNM="MEDICARE (WNR)" D ENR^IBCNSMM(DFN,IBSOURCE) Q
  1. ;
  1. S IBX=$$DICBUF^IBCNBU1(IBINSNM,DFN,DUZ) I +IBX>0 S IBY=$$EDIT Q:IBY<0 I +IBY>0 S IBBUFDA=+IBX
  1. ;I 'IBBUFDA S IBX=$$DICINS^IBCNBU1(IBINSNM) Q:IBX<0 I IBX'=0 S IBINSNM=IBX
  1. I 'IBBUFDA S IBBUFDA=$$NEW(DFN,IBINSNM,IBSOURCE)
  1. Q:'IBBUFDA W !!
  1. ;
  1. I '$$LOCK^IBCNBU1(IBBUFDA,1) Q
  1. ;
  1. D INS^IBCNBEE(IBBUFDA,"OT") W !
  1. D GRP^IBCNBEE(IBBUFDA,"OT") W !
  1. D POLICY^IBCNBEE(IBBUFDA,"OT")
  1. ;
  1. ; set buffer symbol
  1. D BUFF^IBCNEUT2(IBBUFDA,+$$INSERROR^IBCNEUT3("B",IBBUFDA))
  1. ;
  1. D UNLOCK^IBCNBU1(IBBUFDA)
  1. Q
  1. ;
  1. HELP ;
  1. N Z W !!,"You may add a new Insurance Buffer entry or edit an entry you have already ",!,"created for this patient. Insurance Company name must be 3-30 characters.",!
  1. W "To 'fast enter' Medicare coverage information, please enter 'MEDICARE (WNR)'.",!
  1. S Z=$$DICBUF^IBCNBU1("??",DFN,DUZ)
  1. Q
  1. ;
  1. NEW(DFN,INSNAME,SOURCE) ; ask then add new insurance buffer entry
  1. N X,Y,IBX,DIR,DIRUT,IBDATA S IBX=0 W !
  1. S DIR(0)="YO",DIR("A")="Add a new Insurance Buffer entry for this patient",DIR("B")="YES" D ^DIR
  1. I Y=1 S IBDATA(20.01)=INSNAME,IBDATA(60.01)=DFN S IBX=+$$ADDSTF^IBCNBES(SOURCE,DFN,.IBDATA)
  1. Q IBX
  1. ;
  1. EDIT() ; ask user if they want to edit an existing buffer entry
  1. ; returns 0 if don't want to edit, -1 if trys to exit, 1 if wants to edit existing buffer entry
  1. N X,Y,IBX,DIR,DIRUT,DUOUT,DTOUT S IBX=0 W !
  1. S DIR(0)="Y",DIR("A")="Edit existing Insurance Buffer entry for this patient",DIR("B")="YES" D ^DIR S IBX=Y I $D(DIRUT) S IBX=-1
  1. Q IBX
  1. ;
  1. ;
  1. DISPLAY ;
  1. ;
  1. W !!,?2,"This option adds or edits insurance information in the Insurance Buffer File."
  1. W !,?2,"This is a temporary file that will hold all new insurance information until"
  1. W !,?2,"authorized insurance personnel can coordinate this new information with the"
  1. W !,?2,"patient's existing insurance. You may add a new Buffer entry or edit a"
  1. W !,?2,"Buffer entry that you previously created for this patient if that entry"
  1. W !,?2,"has not yet been processed by insurance personnel."
  1. W !!,?2,"Please enter all available insurance information.",!!
  1. Q
  1. ;
  1. INSCOV(DFN) ; return true if covered by insurance is yes, false if not covered or user ^ out
  1. ; allow user to edit 'Covered By Insurance' question (2,.3192), then auto correct if if they were wrong
  1. ; (primarily needed because this field an inconsistancy check in registration so it must have a value)
  1. ;
  1. N IBX,IBY,IBCOV1 S IBX=1
  1. S IBY=$$ASKCOVD^IBCNSP2(DFN,"",.IBCOV1),IBX=+IBY
  1. D COVERED^IBCNSM31(DFN,IBCOV1)
  1. Q IBX