- 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 Feb 18, 2025@23:40:24 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