IBCNBLA1 ;ALB/ARH - Ins Buffer: LM action calls (cont) ;1 Jun 97
;;2.0;INTEGRATED BILLING;**82,133,149,184,252,271,416,438,506,528,737**;21-MAR-94;Build 19
;;Per VA Directive 6402, this routine should not be modified.
;
ADDBUF ; add a new buffer entry protocol
N DIC,DIR,DIRUT,DUOUT,X,Y,IBIN,DFN,IBBUFDA,IBDATA,AMLIST,IBHELP
D FULL^VALM1 S VALMBCK="R"
;
; Patient lookup
S DIC(0)="AEQM",DIC="^DPT(" D ^DIC Q:Y'>0 S DFN=+Y W !
;
INS ; Insurance company lookup
S DIR("A")="Insurance Company",DIR(0)="FO^1:30"
S DIR("?",1)="Please enter the name of the insurance company that provides coverage for this"
S DIR("?",2)="patient. This response is a free text response, however, a partial insurance"
S DIR("?")="company name look-up is available here."
; BHS - 10/15/03 - Removed quit condition when user enters a caret
; during the insurance lister and only sets IBIN
; when a valid selection is made
D ^DIR K DIR Q:$D(DIRUT) S IBIN=Y,Y=$$DICINS^IBCNBU1(Y,1,10) I Y'<0,Y'=0 S IBIN=Y
;
; ESG - 6/17/02 - Usage of Auto Match file when adding a buffer entry
; - SDD 5.1.3
;
; BHS - 10/15/03 - Added condition to allow Auto Match lookup when user
; entered a caret during the insurance lister
I Y=0!(Y<0),$$AMLOOK^IBCNEUT1(IBIN,1,.AMLIST) S Y=$$AMSEL^IBCNEUT1(.AMLIST) I Y'<0,Y'=0 S IBIN=Y
I '$$INPTTR(355.33,20.01,$$UP^XLFSTR(IBIN)) D G INS
. D FIELD^DID(355.33,20.01,"","HELP-PROMPT","IBHELP")
. W !?5,IBHELP("HELP-PROMPT") Q
;
S DIR(0)="Y",DIR("A")="Add a new Insurance Buffer entry for this patient and company",DIR("B")="YES" W ! D ^DIR K DIR Q:Y'=1
;
S IBDATA(20.01)=$$UP^XLFSTR(IBIN),IBDATA(60.01)=DFN
S IBBUFDA=+$$ADDSTF^IBCNBES(1,DFN,.IBDATA) K IBDATA Q:'IBBUFDA
;
I '$$LOCK^IBCNBU1(IBBUFDA,1) Q
D INSHELP^IBCNBEE,INS^IBCNBEE(IBBUFDA)
D GRPHELP^IBCNBEE,GRP^IBCNBEE(IBBUFDA)
D POLHELP^IBCNBEE,POLICY^IBCNBEE(IBBUFDA)
D BUFF^IBCNEUT2(IBBUFDA,+$$INSERROR^IBCNEUT3("B",IBBUFDA)) ; symbol
D UNLOCK^IBCNBU1(IBBUFDA)
;
D INIT^IBCNBLL,HDR^IBCNBLL S VALMBCK="R"
Q
;
INSEDIT(IBBUFDA) ; edit the Insurance data of a buffer entry
;
Q:'$G(IBBUFDA) D FULL^VALM1
D INSHELP^IBCNBEE,INS^IBCNBEE(IBBUFDA)
;
D CLEAN^VALM10,INIT^IBCNBLE,HDR^IBCNBLE S VALMBCK="R" D UPDLN^IBCNBLL(IBBUFDA,"EDITED")
Q
;
GRPEDIT(IBBUFDA) ; edit the Group/Plan data of a buffer entry
;
Q:'$G(IBBUFDA) D FULL^VALM1
D GRPHELP^IBCNBEE,GRP^IBCNBEE(IBBUFDA)
;
D CLEAN^VALM10,INIT^IBCNBLE,HDR^IBCNBLE S VALMBCK="R"
Q
;
POLEDIT(IBBUFDA) ; edit the Subscriber Policy data of a buffer entry
;
Q:'$G(IBBUFDA) D FULL^VALM1
D POLHELP^IBCNBEE,POLICY^IBCNBEE(IBBUFDA)
;
D CLEAN^VALM10,INIT^IBCNBLE,HDR^IBCNBLE S VALMBCK="R" D UPDLN^IBCNBLL(IBBUFDA,"EDITED")
Q
;
ALLEDIT(IBBUFDA) ; edit All data of a buffer entry
;
Q:'$G(IBBUFDA) D FULL^VALM1
D INSHELP^IBCNBEE,INS^IBCNBEE(IBBUFDA)
D GRPHELP^IBCNBEE,GRP^IBCNBEE(IBBUFDA)
D POLHELP^IBCNBEE,POLICY^IBCNBEE(IBBUFDA)
;
D CLEAN^VALM10,INIT^IBCNBLE,HDR^IBCNBLE S VALMBCK="R" D UPDLN^IBCNBLL(IBBUFDA,"EDITED")
Q
;
CMPEDIT(IBBUFDA) ; display a buffer entry and an existing ins entry for comparison, allow edit of buffer data
Q:'$G(IBBUFDA)
N IBDA,IBPOLDA,IBGRPDA,IBINSDA,DIR,DIRUT,X,Y
;
D FULL^VALM1
;
S IBDA=$$SEL^IBCNBLA("IBCNBLPX") I 'IBDA G CMPQ
I $P(IBDA,U,4)'="",+$G(^IBA(355.33,+IBBUFDA,60))'=$P(IBDA,U,4) W !,"Buffer Patient doesn't match Policy Patient, can't continue." G CMPQ
S IBINSDA=+IBDA,IBGRPDA=+$P(IBDA,U,2),IBPOLDA=+$P(IBDA,U,3)
;
CEINS W @IOF
I 'IBINSDA W !,"No Insurance Company Selected for Comparison."
W ! D INS^IBCNBCD(IBBUFDA,IBINSDA)
S DIR("?")="The Buffer entry's Insurance Company data may be edited or Return advances the display to the Group/Plan data.",DIR("??")="^D HELP^IBCNBUH,WAIT^IBCNBUH,INS^IBCNBCD("_IBBUFDA_","_IBINSDA_")"
W ! S DIR(0)="FO",DIR("A")="Enter 'E' to edit buffer data or Return to continue"
D ^DIR K DIR I Y'="",$D(DIRUT) G CMPQ
I Y'="","EEee"[Y D INSHELP^IBCNBEE,INS^IBCNBEE(IBBUFDA) G CEINS
;
CEGRP W @IOF
I 'IBGRPDA W !,"No Insurance Group/Plan Selected for Comparison."
I +IBGRPDA W !,?14,"Patient is "_$S(+IBPOLDA:"",1:"NOT ")_"a member of this Insurance Group/Plan",!
W ! D GRP^IBCNBCD(IBBUFDA,IBGRPDA)
S DIR("?")="The Buffer entry's Group/Plan data may be edited or Return advances the display to the Patient Policy data.",DIR("??")="^D HELP^IBCNBUH,WAIT^IBCNBUH,GRP^IBCNBCD("_IBBUFDA_","_IBGRPDA_")"
W ! S DIR(0)="FO",DIR("A")="Enter 'E' to edit buffer data or Return to continue"
D ^DIR K DIR I Y'="",$D(DIRUT) G CMPQ
I Y'="","EEee"[Y D GRPHELP^IBCNBEE,GRP^IBCNBEE(IBBUFDA) G CEGRP
;
CEPOL W @IOF
I 'IBPOLDA W !,"No Patient Policy Selected for Comparison."
W ! D POLICY^IBCNBCD(IBBUFDA,IBPOLDA)
S DIR("?")="The Buffer entry's Patient Policy data may be edited or return to the screen display.",DIR("??")="^D HELP^IBCNBUH,WAIT^IBCNBUH,POLICY^IBCNBCD("_IBBUFDA_","_IBPOLDA_")"
W ! S DIR(0)="FO",DIR("A")="Enter 'E' to edit buffer data or Return to continue"
D ^DIR K DIR I Y'="",$D(DIRUT) G CMPQ
I Y'="","EEee"[Y D POLHELP^IBCNBEE,POLICY^IBCNBEE(IBBUFDA) G CEPOL
;
CELIG W @IOF
W ! D ELIG^IBCNBCD(IBBUFDA,IBPOLDA)
;
CMPQ D CLEAN^VALM10,INIT^IBCNBLP,HDR^IBCNBLP S VALMBCK="R" D UPDLN^IBCNBLL(IBBUFDA,"EDITED")
Q
;
VERIFY(IBBUFDA) ; verify a buffer entry
;
N DIR,DIRUT,X,Y,IBX,IBY Q:'$G(IBBUFDA)
D FULL^VALM1 S VALMBCK="R"
W ! D DISPBUF^IBCNBU1(IBBUFDA)
;
S IBX=$G(^IBA(355.33,IBBUFDA,0)),IBY="" I +$P(IBX,U,10) S IBY="Re-" W !!,"This entry already verified by ",$$EXPAND^IBTRE(355.33,.11,$P(IBX,U,11))," on ",$$FMTE^XLFDT($P(IBX,U,10)),"."
;
S DIR("?")="Enter Yes if the coverage and information in this Buffer entry has been verified to be accurate." W !!
S DIR(0)="YO",DIR("B")="N",DIR("A")=IBY_"Verify the coverage in this buffer entry"
D ^DIR
I Y=1 D
. ; WCW - 04/11/2003 Clear out IIV Status when manually verified
. D CLEAR^IBCNEUT4(IBBUFDA,.IIVERR,1) K IIVERR
. K IBX S IBX(.1)="NOW",IBX(.11)=DUZ D EDITSTF^IBCNBES(IBBUFDA,.IBX)
. D INIT^IBCNBLE,HDR^IBCNBLE S VALMBCK="R" D UPDLN^IBCNBLL(IBBUFDA,"EDITED") W " Coverage Verified ..." H 2
;
Q
;
REJECT(IBBUFDA,DIRUT) ; process a reject and then delete a buffer entry
; Output parameter DIRUT is optional and passed in by reference. This
; variable will be defined if the user enters a leading up-arrow,
; times out, or enters a null response. This is so the calling routine
; can detect if the user did something other than say Yes or No to
; this question.
;
N DIR,X,Y,IBX Q:'$G(IBBUFDA)
D FULL^VALM1 S VALMBCK="R"
W ! D DISPBUF^IBCNBU1(IBBUFDA)
W !!,"This action will delete all insurance and patient specific data from a buffer ",!,"entry without first saving that data to the insurance files, leaving a stub ",!,"entry for reporting purposes.",!
;
S IBX=$G(^IBA(355.33,IBBUFDA,0)) I +$P(IBX,U,10) W !!,"This entry has been verified by ",$$EXPAND^IBTRE(355.33,.11,$P(IBX,U,11))," on ",$$FMTE^XLFDT($P(IBX,U,10)),".",!!
;
S DIR("?")="Enter Yes to delete this buffer entry without saving any of it's data to the Insurance files."
S DIR(0)="YO",DIR("B")="N",DIR("A")="Reject this buffer entry (delete without saving to Insurance files)"
D ^DIR
I $D(DIRUT) G REJX
I Y=1 D REJECT^IBCNBAR(IBBUFDA) S VALMBCK="Q" D UPDLN^IBCNBLL(IBBUFDA,"REJECTED")
REJX ;
Q
;
ACCEPT(IBBUFDA) ; process a buffer entry for acceptance
;
Q:'$G(IBBUFDA)
N IBDA,IBINSDA,IBGRPDA,IBPOLDA,IBACCEPT S IBACCEPT=0
N IBBUFABORT S IBBUFABORT=0 ;IB*737/CKB
;
D FULL^VALM1
;
S IBDA=$$SEL^IBCNBLA("IBCNBLPX")
I $P(IBDA,U,4)'="",+$G(^IBA(355.33,+IBBUFDA,60))'=$P(IBDA,U,4) W !,"Buffer Patient doesn't match Policy Patient, can't continue." G ACCPTQ
I +$P(IBDA,U,3),'$P(IBDA,U,2) W !!,"Error: the selected policy has no associated plan. Can not continue." D WAIT^IBCNBUH G ACCPTQ
;
S IBINSDA=+IBDA,IBGRPDA=+$P(IBDA,U,2),IBPOLDA=+$P(IBDA,U,3)
S:'IBINSDA (IBGRPDA,IBPOLDA)=0 S:'IBGRPDA IBPOLDA=0
;
I 'IBINSDA,'$D(^XUSEC("IB INSURANCE COMPANY ADD",DUZ)) D G ACCPTQ
. W !!,"Sorry, but you do not have the required privileges to add",!,"new Insurance Companies."
. D WAIT^IBCNBUH
;
;IB*737/CKB - ensure that the buffer effective is populated (IBBUFABORT=2)
N BUFEFFDT S BUFEFFDT=$$GET1^DIQ(355.33,IBBUFDA_",",60.02,"I")
I BUFEFFDT="" S IBBUFABORT=2 G ACCPTQ
;
S IBACCEPT=$$ACCEPT^IBCNBAA(IBBUFDA,IBINSDA,IBGRPDA,IBPOLDA)
;
ACCPTQ ;IB*737/CKB - if the Buffer entry wasn't Accepted (see IBBUFABORT), display warning message and return to Buffer
I IBBUFABORT D Q
. I IBBUFABORT=1 W !,"*** Unable to process entry, if accepted it would corrupt the Effective Date of the policy ***"
. I IBBUFABORT=2 W !!,"*** Unable to process entry, the Effective Date is required ***"
. D PAUSE^VALM1
. S VALMBCK="Q"
S VALMBCK="R" I +IBACCEPT S VALMBCK="Q" D UPDLN^IBCNBLL(IBBUFDA,"ACCEPTED")
Q
;
RESP(BUFF) ; List Response Report for Trace # associated with this entry
; BUFF = buffer IEN
N NG,IBRSP,IBSTR,IBTRC,STOP,IBCNERTN,POP,IBCNESPC,IBOUT
; Reset to Full Screen Mode
D FULL^VALM1
S NG=0
I $G(BUFF)="" S NG=1
I 'NG S IBRSP=$O(^IBCN(365,"AF",BUFF,"")) I IBRSP="" S NG=1
I 'NG S IBSTR=$G(^IBCN(365,IBRSP,0)),IBTRC=$P(IBSTR,U,9) I IBTRC="" S NG=1
I NG W !!,"This entry does not have an associated eIV response." D PAUSE^VALM1 G RESPX
S STOP=0,IBCNERTN="IBCNERP1",IBCNESPC("TRCN")=IBTRC_U_IBRSP
S IBOUT=$$OUT^IBCNERP1() G:IBOUT']"" RESPX I IBOUT="E" W !,!,"To avoid undesired wrapping, please enter '0;256;999' at the 'DEVICE:' prompt.",! ; AWC/ IB*2.0*528
D R100^IBCNERP1
RESPX S VALMBCK="R"
Q
INPTTR(FILE,FLD,X) ; Does value X pass input transform for file, field?
N XCUTE
S XCUTE=$$GET1^DID(FILE,FLD,,"INPUT TRANSFORM")
X XCUTE
Q $D(X)
;
ICB(IBBUFDA) ;called by ICB to update eIV status flag (symbol) in the insurance buffer entry
;
N SYM,ERR
S SYM=$$GET1^DIQ(355.33,IBBUFDA,.12,"I") Q:'SYM
I $$SYMBOL^IBCNBLL(IBBUFDA)="*" Q ;don't update if manually verified
; Determine if Expand Entry is allowed to update the eIV Status
I '$P($G(^IBE(365.15,SYM,0)),U,3) Q
; If the current IIV Status allows updates by Expand Entry, then
; invoke the function that tries to find a valid payer
S ERR=$$INSERROR^IBCNEUT3("B",IBBUFDA,1)
; If no errors, then remove the eIV Status
I 'ERR S ERR=$$SIDERR^IBCNBLE1(IBBUFDA,$P(ERR,U,2))
I 'ERR D CLEAR^IBCNEUT4(IBBUFDA)
; If errors found, then update with the new IIV Status
I ERR D BUFF^IBCNEUT2(IBBUFDA,$P(ERR,U,1))
Q
;
ESC(IBBUFDA,IBKEYS) ; Escalate to user with ability to edit Insurance/Group data
N DIE,DR,DA,DIR,X,Y,IBX,CODE Q:'$G(IBBUFDA)
D FULL^VALM1 S VALMBCK="R"
W ! D DISPBUF^IBCNBU1(IBBUFDA)
I IBKEYS D G ESCX
. W !!,"This action can only be taken by users that do not have either the IB INSURANCE",!,"COMPANY EDIT security key or the IB GROUP PLAN EDIT security key.",!
. D PAUSE^VALM1
W !!,"This action will escalate the buffer entry to a level with the ability to edit",!,"insurance and/or group data.",!
;
S IBX=$G(^IBA(355.33,IBBUFDA,0)) I +$P(IBX,U,10) W !!,"This entry has been verified by ",$$EXPAND^IBTRE(355.33,.11,$P(IBX,U,11))," on ",$$FMTE^XLFDT($P(IBX,U,10)),".",!!
;
S DIR("?")="Enter Yes to escalate this buffer entry."
S DIR(0)="YO",DIR("B")="N",DIR("A")="Escalate this buffer entry"
D ^DIR
I $D(DIRUT) G ESCX
I Y=1 D
. S DIE=355.33,DA=IBBUFDA,CODE="E1"
. S DR=".12///^S X=CODE"
. D ^DIE
. S VALMBCK="Q" D UPDLN^IBCNBLL(IBBUFDA,"EDITED")
ESCX ;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNBLA1 11609 printed Apr 09, 2024@21:09:18 Page 2
IBCNBLA1 ;ALB/ARH - Ins Buffer: LM action calls (cont) ;1 Jun 97
+1 ;;2.0;INTEGRATED BILLING;**82,133,149,184,252,271,416,438,506,528,737**;21-MAR-94;Build 19
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
ADDBUF ; add a new buffer entry protocol
+1 NEW DIC,DIR,DIRUT,DUOUT,X,Y,IBIN,DFN,IBBUFDA,IBDATA,AMLIST,IBHELP
+2 DO FULL^VALM1
SET VALMBCK="R"
+3 ;
+4 ; Patient lookup
+5 SET DIC(0)="AEQM"
SET DIC="^DPT("
DO ^DIC
if Y'>0
QUIT
SET DFN=+Y
WRITE !
+6 ;
INS ; Insurance company lookup
+1 SET DIR("A")="Insurance Company"
SET DIR(0)="FO^1:30"
+2 SET DIR("?",1)="Please enter the name of the insurance company that provides coverage for this"
+3 SET DIR("?",2)="patient. This response is a free text response, however, a partial insurance"
+4 SET DIR("?")="company name look-up is available here."
+5 ; BHS - 10/15/03 - Removed quit condition when user enters a caret
+6 ; during the insurance lister and only sets IBIN
+7 ; when a valid selection is made
+8 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
SET IBIN=Y
SET Y=$$DICINS^IBCNBU1(Y,1,10)
IF Y'<0
IF Y'=0
SET IBIN=Y
+9 ;
+10 ; ESG - 6/17/02 - Usage of Auto Match file when adding a buffer entry
+11 ; - SDD 5.1.3
+12 ;
+13 ; BHS - 10/15/03 - Added condition to allow Auto Match lookup when user
+14 ; entered a caret during the insurance lister
+15 IF Y=0!(Y<0)
IF $$AMLOOK^IBCNEUT1(IBIN,1,.AMLIST)
SET Y=$$AMSEL^IBCNEUT1(.AMLIST)
IF Y'<0
IF Y'=0
SET IBIN=Y
+16 IF '$$INPTTR(355.33,20.01,$$UP^XLFSTR(IBIN))
Begin DoDot:1
+17 DO FIELD^DID(355.33,20.01,"","HELP-PROMPT","IBHELP")
+18 WRITE !?5,IBHELP("HELP-PROMPT")
QUIT
End DoDot:1
GOTO INS
+19 ;
+20 SET DIR(0)="Y"
SET DIR("A")="Add a new Insurance Buffer entry for this patient and company"
SET DIR("B")="YES"
WRITE !
DO ^DIR
KILL DIR
if Y'=1
QUIT
+21 ;
+22 SET IBDATA(20.01)=$$UP^XLFSTR(IBIN)
SET IBDATA(60.01)=DFN
+23 SET IBBUFDA=+$$ADDSTF^IBCNBES(1,DFN,.IBDATA)
KILL IBDATA
if 'IBBUFDA
QUIT
+24 ;
+25 IF '$$LOCK^IBCNBU1(IBBUFDA,1)
QUIT
+26 DO INSHELP^IBCNBEE
DO INS^IBCNBEE(IBBUFDA)
+27 DO GRPHELP^IBCNBEE
DO GRP^IBCNBEE(IBBUFDA)
+28 DO POLHELP^IBCNBEE
DO POLICY^IBCNBEE(IBBUFDA)
+29 ; symbol
DO BUFF^IBCNEUT2(IBBUFDA,+$$INSERROR^IBCNEUT3("B",IBBUFDA))
+30 DO UNLOCK^IBCNBU1(IBBUFDA)
+31 ;
+32 DO INIT^IBCNBLL
DO HDR^IBCNBLL
SET VALMBCK="R"
+33 QUIT
+34 ;
INSEDIT(IBBUFDA) ; edit the Insurance data of a buffer entry
+1 ;
+2 if '$GET(IBBUFDA)
QUIT
DO FULL^VALM1
+3 DO INSHELP^IBCNBEE
DO INS^IBCNBEE(IBBUFDA)
+4 ;
+5 DO CLEAN^VALM10
DO INIT^IBCNBLE
DO HDR^IBCNBLE
SET VALMBCK="R"
DO UPDLN^IBCNBLL(IBBUFDA,"EDITED")
+6 QUIT
+7 ;
GRPEDIT(IBBUFDA) ; edit the Group/Plan data of a buffer entry
+1 ;
+2 if '$GET(IBBUFDA)
QUIT
DO FULL^VALM1
+3 DO GRPHELP^IBCNBEE
DO GRP^IBCNBEE(IBBUFDA)
+4 ;
+5 DO CLEAN^VALM10
DO INIT^IBCNBLE
DO HDR^IBCNBLE
SET VALMBCK="R"
+6 QUIT
+7 ;
POLEDIT(IBBUFDA) ; edit the Subscriber Policy data of a buffer entry
+1 ;
+2 if '$GET(IBBUFDA)
QUIT
DO FULL^VALM1
+3 DO POLHELP^IBCNBEE
DO POLICY^IBCNBEE(IBBUFDA)
+4 ;
+5 DO CLEAN^VALM10
DO INIT^IBCNBLE
DO HDR^IBCNBLE
SET VALMBCK="R"
DO UPDLN^IBCNBLL(IBBUFDA,"EDITED")
+6 QUIT
+7 ;
ALLEDIT(IBBUFDA) ; edit All data of a buffer entry
+1 ;
+2 if '$GET(IBBUFDA)
QUIT
DO FULL^VALM1
+3 DO INSHELP^IBCNBEE
DO INS^IBCNBEE(IBBUFDA)
+4 DO GRPHELP^IBCNBEE
DO GRP^IBCNBEE(IBBUFDA)
+5 DO POLHELP^IBCNBEE
DO POLICY^IBCNBEE(IBBUFDA)
+6 ;
+7 DO CLEAN^VALM10
DO INIT^IBCNBLE
DO HDR^IBCNBLE
SET VALMBCK="R"
DO UPDLN^IBCNBLL(IBBUFDA,"EDITED")
+8 QUIT
+9 ;
CMPEDIT(IBBUFDA) ; display a buffer entry and an existing ins entry for comparison, allow edit of buffer data
+1 if '$GET(IBBUFDA)
QUIT
+2 NEW IBDA,IBPOLDA,IBGRPDA,IBINSDA,DIR,DIRUT,X,Y
+3 ;
+4 DO FULL^VALM1
+5 ;
+6 SET IBDA=$$SEL^IBCNBLA("IBCNBLPX")
IF 'IBDA
GOTO CMPQ
+7 IF $PIECE(IBDA,U,4)'=""
IF +$GET(^IBA(355.33,+IBBUFDA,60))'=$PIECE(IBDA,U,4)
WRITE !,"Buffer Patient doesn't match Policy Patient, can't continue."
GOTO CMPQ
+8 SET IBINSDA=+IBDA
SET IBGRPDA=+$PIECE(IBDA,U,2)
SET IBPOLDA=+$PIECE(IBDA,U,3)
+9 ;
CEINS WRITE @IOF
+1 IF 'IBINSDA
WRITE !,"No Insurance Company Selected for Comparison."
+2 WRITE !
DO INS^IBCNBCD(IBBUFDA,IBINSDA)
+3 SET DIR("?")="The Buffer entry's Insurance Company data may be edited or Return advances the display to the Group/Plan data."
SET DIR("??")="^D HELP^IBCNBUH,WAIT^IBCNBUH,INS^IBCNBCD("_IBBUFDA_","_IBINSDA_")"
+4 WRITE !
SET DIR(0)="FO"
SET DIR("A")="Enter 'E' to edit buffer data or Return to continue"
+5 DO ^DIR
KILL DIR
IF Y'=""
IF $DATA(DIRUT)
GOTO CMPQ
+6 IF Y'=""
IF "EEee"[Y
DO INSHELP^IBCNBEE
DO INS^IBCNBEE(IBBUFDA)
GOTO CEINS
+7 ;
CEGRP WRITE @IOF
+1 IF 'IBGRPDA
WRITE !,"No Insurance Group/Plan Selected for Comparison."
+2 IF +IBGRPDA
WRITE !,?14,"Patient is "_$SELECT(+IBPOLDA:"",1:"NOT ")_"a member of this Insurance Group/Plan",!
+3 WRITE !
DO GRP^IBCNBCD(IBBUFDA,IBGRPDA)
+4 SET DIR("?")="The Buffer entry's Group/Plan data may be edited or Return advances the display to the Patient Policy data."
SET DIR("??")="^D HELP^IBCNBUH,WAIT^IBCNBUH,GRP^IBCNBCD("_IBBUFDA_","_IBGRPDA_")"
+5 WRITE !
SET DIR(0)="FO"
SET DIR("A")="Enter 'E' to edit buffer data or Return to continue"
+6 DO ^DIR
KILL DIR
IF Y'=""
IF $DATA(DIRUT)
GOTO CMPQ
+7 IF Y'=""
IF "EEee"[Y
DO GRPHELP^IBCNBEE
DO GRP^IBCNBEE(IBBUFDA)
GOTO CEGRP
+8 ;
CEPOL WRITE @IOF
+1 IF 'IBPOLDA
WRITE !,"No Patient Policy Selected for Comparison."
+2 WRITE !
DO POLICY^IBCNBCD(IBBUFDA,IBPOLDA)
+3 SET DIR("?")="The Buffer entry's Patient Policy data may be edited or return to the screen display."
SET DIR("??")="^D HELP^IBCNBUH,WAIT^IBCNBUH,POLICY^IBCNBCD("_IBBUFDA_","_IBPOLDA_")"
+4 WRITE !
SET DIR(0)="FO"
SET DIR("A")="Enter 'E' to edit buffer data or Return to continue"
+5 DO ^DIR
KILL DIR
IF Y'=""
IF $DATA(DIRUT)
GOTO CMPQ
+6 IF Y'=""
IF "EEee"[Y
DO POLHELP^IBCNBEE
DO POLICY^IBCNBEE(IBBUFDA)
GOTO CEPOL
+7 ;
CELIG WRITE @IOF
+1 WRITE !
DO ELIG^IBCNBCD(IBBUFDA,IBPOLDA)
+2 ;
CMPQ DO CLEAN^VALM10
DO INIT^IBCNBLP
DO HDR^IBCNBLP
SET VALMBCK="R"
DO UPDLN^IBCNBLL(IBBUFDA,"EDITED")
+1 QUIT
+2 ;
VERIFY(IBBUFDA) ; verify a buffer entry
+1 ;
+2 NEW DIR,DIRUT,X,Y,IBX,IBY
if '$GET(IBBUFDA)
QUIT
+3 DO FULL^VALM1
SET VALMBCK="R"
+4 WRITE !
DO DISPBUF^IBCNBU1(IBBUFDA)
+5 ;
+6 SET IBX=$GET(^IBA(355.33,IBBUFDA,0))
SET IBY=""
IF +$PIECE(IBX,U,10)
SET IBY="Re-"
WRITE !!,"This entry already verified by ",$$EXPAND^IBTRE(355.33,.11,$PIECE(IBX,U,11))," on ",$$FMTE^XLFDT($PIECE(IBX,U,10)),"."
+7 ;
+8 SET DIR("?")="Enter Yes if the coverage and information in this Buffer entry has been verified to be accurate."
WRITE !!
+9 SET DIR(0)="YO"
SET DIR("B")="N"
SET DIR("A")=IBY_"Verify the coverage in this buffer entry"
+10 DO ^DIR
+11 IF Y=1
Begin DoDot:1
+12 ; WCW - 04/11/2003 Clear out IIV Status when manually verified
+13 DO CLEAR^IBCNEUT4(IBBUFDA,.IIVERR,1)
KILL IIVERR
+14 KILL IBX
SET IBX(.1)="NOW"
SET IBX(.11)=DUZ
DO EDITSTF^IBCNBES(IBBUFDA,.IBX)
+15 DO INIT^IBCNBLE
DO HDR^IBCNBLE
SET VALMBCK="R"
DO UPDLN^IBCNBLL(IBBUFDA,"EDITED")
WRITE " Coverage Verified ..."
HANG 2
End DoDot:1
+16 ;
+17 QUIT
+18 ;
REJECT(IBBUFDA,DIRUT) ; process a reject and then delete a buffer entry
+1 ; Output parameter DIRUT is optional and passed in by reference. This
+2 ; variable will be defined if the user enters a leading up-arrow,
+3 ; times out, or enters a null response. This is so the calling routine
+4 ; can detect if the user did something other than say Yes or No to
+5 ; this question.
+6 ;
+7 NEW DIR,X,Y,IBX
if '$GET(IBBUFDA)
QUIT
+8 DO FULL^VALM1
SET VALMBCK="R"
+9 WRITE !
DO DISPBUF^IBCNBU1(IBBUFDA)
+10 WRITE !!,"This action will delete all insurance and patient specific data from a buffer ",!,"entry without first saving that data to the insurance files, leaving a stub ",!,"entry for reporting purposes.",!
+11 ;
+12 SET IBX=$GET(^IBA(355.33,IBBUFDA,0))
IF +$PIECE(IBX,U,10)
WRITE !!,"This entry has been verified by ",$$EXPAND^IBTRE(355.33,.11,$PIECE(IBX,U,11))," on ",$$FMTE^XLFDT($PIECE(IBX,U,10)),".",!!
+13 ;
+14 SET DIR("?")="Enter Yes to delete this buffer entry without saving any of it's data to the Insurance files."
+15 SET DIR(0)="YO"
SET DIR("B")="N"
SET DIR("A")="Reject this buffer entry (delete without saving to Insurance files)"
+16 DO ^DIR
+17 IF $DATA(DIRUT)
GOTO REJX
+18 IF Y=1
DO REJECT^IBCNBAR(IBBUFDA)
SET VALMBCK="Q"
DO UPDLN^IBCNBLL(IBBUFDA,"REJECTED")
REJX ;
+1 QUIT
+2 ;
ACCEPT(IBBUFDA) ; process a buffer entry for acceptance
+1 ;
+2 if '$GET(IBBUFDA)
QUIT
+3 NEW IBDA,IBINSDA,IBGRPDA,IBPOLDA,IBACCEPT
SET IBACCEPT=0
+4 ;IB*737/CKB
NEW IBBUFABORT
SET IBBUFABORT=0
+5 ;
+6 DO FULL^VALM1
+7 ;
+8 SET IBDA=$$SEL^IBCNBLA("IBCNBLPX")
+9 IF $PIECE(IBDA,U,4)'=""
IF +$GET(^IBA(355.33,+IBBUFDA,60))'=$PIECE(IBDA,U,4)
WRITE !,"Buffer Patient doesn't match Policy Patient, can't continue."
GOTO ACCPTQ
+10 IF +$PIECE(IBDA,U,3)
IF '$PIECE(IBDA,U,2)
WRITE !!,"Error: the selected policy has no associated plan. Can not continue."
DO WAIT^IBCNBUH
GOTO ACCPTQ
+11 ;
+12 SET IBINSDA=+IBDA
SET IBGRPDA=+$PIECE(IBDA,U,2)
SET IBPOLDA=+$PIECE(IBDA,U,3)
+13 if 'IBINSDA
SET (IBGRPDA,IBPOLDA)=0
if 'IBGRPDA
SET IBPOLDA=0
+14 ;
+15 IF 'IBINSDA
IF '$DATA(^XUSEC("IB INSURANCE COMPANY ADD",DUZ))
Begin DoDot:1
+16 WRITE !!,"Sorry, but you do not have the required privileges to add",!,"new Insurance Companies."
+17 DO WAIT^IBCNBUH
End DoDot:1
GOTO ACCPTQ
+18 ;
+19 ;IB*737/CKB - ensure that the buffer effective is populated (IBBUFABORT=2)
+20 NEW BUFEFFDT
SET BUFEFFDT=$$GET1^DIQ(355.33,IBBUFDA_",",60.02,"I")
+21 IF BUFEFFDT=""
SET IBBUFABORT=2
GOTO ACCPTQ
+22 ;
+23 SET IBACCEPT=$$ACCEPT^IBCNBAA(IBBUFDA,IBINSDA,IBGRPDA,IBPOLDA)
+24 ;
ACCPTQ ;IB*737/CKB - if the Buffer entry wasn't Accepted (see IBBUFABORT), display warning message and return to Buffer
+1 IF IBBUFABORT
Begin DoDot:1
+2 IF IBBUFABORT=1
WRITE !,"*** Unable to process entry, if accepted it would corrupt the Effective Date of the policy ***"
+3 IF IBBUFABORT=2
WRITE !!,"*** Unable to process entry, the Effective Date is required ***"
+4 DO PAUSE^VALM1
+5 SET VALMBCK="Q"
End DoDot:1
QUIT
+6 SET VALMBCK="R"
IF +IBACCEPT
SET VALMBCK="Q"
DO UPDLN^IBCNBLL(IBBUFDA,"ACCEPTED")
+7 QUIT
+8 ;
RESP(BUFF) ; List Response Report for Trace # associated with this entry
+1 ; BUFF = buffer IEN
+2 NEW NG,IBRSP,IBSTR,IBTRC,STOP,IBCNERTN,POP,IBCNESPC,IBOUT
+3 ; Reset to Full Screen Mode
+4 DO FULL^VALM1
+5 SET NG=0
+6 IF $GET(BUFF)=""
SET NG=1
+7 IF 'NG
SET IBRSP=$ORDER(^IBCN(365,"AF",BUFF,""))
IF IBRSP=""
SET NG=1
+8 IF 'NG
SET IBSTR=$GET(^IBCN(365,IBRSP,0))
SET IBTRC=$PIECE(IBSTR,U,9)
IF IBTRC=""
SET NG=1
+9 IF NG
WRITE !!,"This entry does not have an associated eIV response."
DO PAUSE^VALM1
GOTO RESPX
+10 SET STOP=0
SET IBCNERTN="IBCNERP1"
SET IBCNESPC("TRCN")=IBTRC_U_IBRSP
+11 ; AWC/ IB*2.0*528
SET IBOUT=$$OUT^IBCNERP1()
if IBOUT']""
GOTO RESPX
IF IBOUT="E"
WRITE !,!,"To avoid undesired wrapping, please enter '0;256;999' at the 'DEVICE:' prompt.",!
+12 DO R100^IBCNERP1
RESPX SET VALMBCK="R"
+1 QUIT
INPTTR(FILE,FLD,X) ; Does value X pass input transform for file, field?
+1 NEW XCUTE
+2 SET XCUTE=$$GET1^DID(FILE,FLD,,"INPUT TRANSFORM")
+3 XECUTE XCUTE
+4 QUIT $DATA(X)
+5 ;
ICB(IBBUFDA) ;called by ICB to update eIV status flag (symbol) in the insurance buffer entry
+1 ;
+2 NEW SYM,ERR
+3 SET SYM=$$GET1^DIQ(355.33,IBBUFDA,.12,"I")
if 'SYM
QUIT
+4 ;don't update if manually verified
IF $$SYMBOL^IBCNBLL(IBBUFDA)="*"
QUIT
+5 ; Determine if Expand Entry is allowed to update the eIV Status
+6 IF '$PIECE($GET(^IBE(365.15,SYM,0)),U,3)
QUIT
+7 ; If the current IIV Status allows updates by Expand Entry, then
+8 ; invoke the function that tries to find a valid payer
+9 SET ERR=$$INSERROR^IBCNEUT3("B",IBBUFDA,1)
+10 ; If no errors, then remove the eIV Status
+11 IF 'ERR
SET ERR=$$SIDERR^IBCNBLE1(IBBUFDA,$PIECE(ERR,U,2))
+12 IF 'ERR
DO CLEAR^IBCNEUT4(IBBUFDA)
+13 ; If errors found, then update with the new IIV Status
+14 IF ERR
DO BUFF^IBCNEUT2(IBBUFDA,$PIECE(ERR,U,1))
+15 QUIT
+16 ;
ESC(IBBUFDA,IBKEYS) ; Escalate to user with ability to edit Insurance/Group data
+1 NEW DIE,DR,DA,DIR,X,Y,IBX,CODE
if '$GET(IBBUFDA)
QUIT
+2 DO FULL^VALM1
SET VALMBCK="R"
+3 WRITE !
DO DISPBUF^IBCNBU1(IBBUFDA)
+4 IF IBKEYS
Begin DoDot:1
+5 WRITE !!,"This action can only be taken by users that do not have either the IB INSURANCE",!,"COMPANY EDIT security key or the IB GROUP PLAN EDIT security key.",!
+6 DO PAUSE^VALM1
End DoDot:1
GOTO ESCX
+7 WRITE !!,"This action will escalate the buffer entry to a level with the ability to edit",!,"insurance and/or group data.",!
+8 ;
+9 SET IBX=$GET(^IBA(355.33,IBBUFDA,0))
IF +$PIECE(IBX,U,10)
WRITE !!,"This entry has been verified by ",$$EXPAND^IBTRE(355.33,.11,$PIECE(IBX,U,11))," on ",$$FMTE^XLFDT($PIECE(IBX,U,10)),".",!!
+10 ;
+11 SET DIR("?")="Enter Yes to escalate this buffer entry."
+12 SET DIR(0)="YO"
SET DIR("B")="N"
SET DIR("A")="Escalate this buffer entry"
+13 DO ^DIR
+14 IF $DATA(DIRUT)
GOTO ESCX
+15 IF Y=1
Begin DoDot:1
+16 SET DIE=355.33
SET DA=IBBUFDA
SET CODE="E1"
+17 SET DR=".12///^S X=CODE"
+18 DO ^DIE
+19 SET VALMBCK="Q"
DO UPDLN^IBCNBLL(IBBUFDA,"EDITED")
End DoDot:1
ESCX ;
+1 QUIT
