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