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

IBCNBLA1.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ADDBUF ; add a new buffer entry protocol
  1. N DIC,DIR,DIRUT,DUOUT,X,Y,IBIN,DFN,IBBUFDA,IBDATA,AMLIST,IBHELP
  1. D FULL^VALM1 S VALMBCK="R"
  1. ;
  1. ; Patient lookup
  1. S DIC(0)="AEQM",DIC="^DPT(" D ^DIC Q:Y'>0 S DFN=+Y W !
  1. ;
  1. INS ; Insurance company lookup
  1. S DIR("A")="Insurance Company",DIR(0)="FO^1:30"
  1. S DIR("?",1)="Please enter the name of the insurance company that provides coverage for this"
  1. S DIR("?",2)="patient. This response is a free text response, however, a partial insurance"
  1. S DIR("?")="company name look-up is available here."
  1. ; BHS - 10/15/03 - Removed quit condition when user enters a caret
  1. ; during the insurance lister and only sets IBIN
  1. ; when a valid selection is made
  1. D ^DIR K DIR Q:$D(DIRUT) S IBIN=Y,Y=$$DICINS^IBCNBU1(Y,1,10) I Y'<0,Y'=0 S IBIN=Y
  1. ;
  1. ; ESG - 6/17/02 - Usage of Auto Match file when adding a buffer entry
  1. ; - SDD 5.1.3
  1. ;
  1. ; BHS - 10/15/03 - Added condition to allow Auto Match lookup when user
  1. ; entered a caret during the insurance lister
  1. I Y=0!(Y<0),$$AMLOOK^IBCNEUT1(IBIN,1,.AMLIST) S Y=$$AMSEL^IBCNEUT1(.AMLIST) I Y'<0,Y'=0 S IBIN=Y
  1. I '$$INPTTR(355.33,20.01,$$UP^XLFSTR(IBIN)) D G INS
  1. . D FIELD^DID(355.33,20.01,"","HELP-PROMPT","IBHELP")
  1. . W !?5,IBHELP("HELP-PROMPT") Q
  1. ;
  1. 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
  1. ;
  1. S IBDATA(20.01)=$$UP^XLFSTR(IBIN),IBDATA(60.01)=DFN
  1. S IBBUFDA=+$$ADDSTF^IBCNBES(1,DFN,.IBDATA) K IBDATA Q:'IBBUFDA
  1. ;
  1. I '$$LOCK^IBCNBU1(IBBUFDA,1) Q
  1. D INSHELP^IBCNBEE,INS^IBCNBEE(IBBUFDA)
  1. D GRPHELP^IBCNBEE,GRP^IBCNBEE(IBBUFDA)
  1. D POLHELP^IBCNBEE,POLICY^IBCNBEE(IBBUFDA)
  1. D BUFF^IBCNEUT2(IBBUFDA,+$$INSERROR^IBCNEUT3("B",IBBUFDA)) ; symbol
  1. D UNLOCK^IBCNBU1(IBBUFDA)
  1. ;
  1. D INIT^IBCNBLL,HDR^IBCNBLL S VALMBCK="R"
  1. Q
  1. ;
  1. INSEDIT(IBBUFDA) ; edit the Insurance data of a buffer entry
  1. ;
  1. Q:'$G(IBBUFDA) D FULL^VALM1
  1. D INSHELP^IBCNBEE,INS^IBCNBEE(IBBUFDA)
  1. ;
  1. D CLEAN^VALM10,INIT^IBCNBLE,HDR^IBCNBLE S VALMBCK="R" D UPDLN^IBCNBLL(IBBUFDA,"EDITED")
  1. Q
  1. ;
  1. GRPEDIT(IBBUFDA) ; edit the Group/Plan data of a buffer entry
  1. ;
  1. Q:'$G(IBBUFDA) D FULL^VALM1
  1. D GRPHELP^IBCNBEE,GRP^IBCNBEE(IBBUFDA)
  1. ;
  1. D CLEAN^VALM10,INIT^IBCNBLE,HDR^IBCNBLE S VALMBCK="R"
  1. Q
  1. ;
  1. POLEDIT(IBBUFDA) ; edit the Subscriber Policy data of a buffer entry
  1. ;
  1. Q:'$G(IBBUFDA) D FULL^VALM1
  1. D POLHELP^IBCNBEE,POLICY^IBCNBEE(IBBUFDA)
  1. ;
  1. D CLEAN^VALM10,INIT^IBCNBLE,HDR^IBCNBLE S VALMBCK="R" D UPDLN^IBCNBLL(IBBUFDA,"EDITED")
  1. Q
  1. ;
  1. ALLEDIT(IBBUFDA) ; edit All data of a buffer entry
  1. ;
  1. Q:'$G(IBBUFDA) D FULL^VALM1
  1. D INSHELP^IBCNBEE,INS^IBCNBEE(IBBUFDA)
  1. D GRPHELP^IBCNBEE,GRP^IBCNBEE(IBBUFDA)
  1. D POLHELP^IBCNBEE,POLICY^IBCNBEE(IBBUFDA)
  1. ;
  1. D CLEAN^VALM10,INIT^IBCNBLE,HDR^IBCNBLE S VALMBCK="R" D UPDLN^IBCNBLL(IBBUFDA,"EDITED")
  1. Q
  1. ;
  1. CMPEDIT(IBBUFDA) ; display a buffer entry and an existing ins entry for comparison, allow edit of buffer data
  1. Q:'$G(IBBUFDA)
  1. N IBDA,IBPOLDA,IBGRPDA,IBINSDA,DIR,DIRUT,X,Y
  1. ;
  1. D FULL^VALM1
  1. ;
  1. S IBDA=$$SEL^IBCNBLA("IBCNBLPX") I 'IBDA G CMPQ
  1. 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
  1. S IBINSDA=+IBDA,IBGRPDA=+$P(IBDA,U,2),IBPOLDA=+$P(IBDA,U,3)
  1. ;
  1. CEINS W @IOF
  1. I 'IBINSDA W !,"No Insurance Company Selected for Comparison."
  1. W ! D INS^IBCNBCD(IBBUFDA,IBINSDA)
  1. 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_")"
  1. W ! S DIR(0)="FO",DIR("A")="Enter 'E' to edit buffer data or Return to continue"
  1. D ^DIR K DIR I Y'="",$D(DIRUT) G CMPQ
  1. I Y'="","EEee"[Y D INSHELP^IBCNBEE,INS^IBCNBEE(IBBUFDA) G CEINS
  1. ;
  1. CEGRP W @IOF
  1. I 'IBGRPDA W !,"No Insurance Group/Plan Selected for Comparison."
  1. I +IBGRPDA W !,?14,"Patient is "_$S(+IBPOLDA:"",1:"NOT ")_"a member of this Insurance Group/Plan",!
  1. W ! D GRP^IBCNBCD(IBBUFDA,IBGRPDA)
  1. 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_")"
  1. W ! S DIR(0)="FO",DIR("A")="Enter 'E' to edit buffer data or Return to continue"
  1. D ^DIR K DIR I Y'="",$D(DIRUT) G CMPQ
  1. I Y'="","EEee"[Y D GRPHELP^IBCNBEE,GRP^IBCNBEE(IBBUFDA) G CEGRP
  1. ;
  1. CEPOL W @IOF
  1. I 'IBPOLDA W !,"No Patient Policy Selected for Comparison."
  1. W ! D POLICY^IBCNBCD(IBBUFDA,IBPOLDA)
  1. 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_")"
  1. W ! S DIR(0)="FO",DIR("A")="Enter 'E' to edit buffer data or Return to continue"
  1. D ^DIR K DIR I Y'="",$D(DIRUT) G CMPQ
  1. I Y'="","EEee"[Y D POLHELP^IBCNBEE,POLICY^IBCNBEE(IBBUFDA) G CEPOL
  1. ;
  1. CELIG W @IOF
  1. W ! D ELIG^IBCNBCD(IBBUFDA,IBPOLDA)
  1. ;
  1. CMPQ D CLEAN^VALM10,INIT^IBCNBLP,HDR^IBCNBLP S VALMBCK="R" D UPDLN^IBCNBLL(IBBUFDA,"EDITED")
  1. Q
  1. ;
  1. VERIFY(IBBUFDA) ; verify a buffer entry
  1. ;
  1. N DIR,DIRUT,X,Y,IBX,IBY Q:'$G(IBBUFDA)
  1. D FULL^VALM1 S VALMBCK="R"
  1. W ! D DISPBUF^IBCNBU1(IBBUFDA)
  1. ;
  1. 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)),"."
  1. ;
  1. S DIR("?")="Enter Yes if the coverage and information in this Buffer entry has been verified to be accurate." W !!
  1. S DIR(0)="YO",DIR("B")="N",DIR("A")=IBY_"Verify the coverage in this buffer entry"
  1. D ^DIR
  1. I Y=1 D
  1. . ; WCW - 04/11/2003 Clear out IIV Status when manually verified
  1. . D CLEAR^IBCNEUT4(IBBUFDA,.IIVERR,1) K IIVERR
  1. . K IBX S IBX(.1)="NOW",IBX(.11)=DUZ D EDITSTF^IBCNBES(IBBUFDA,.IBX)
  1. . D INIT^IBCNBLE,HDR^IBCNBLE S VALMBCK="R" D UPDLN^IBCNBLL(IBBUFDA,"EDITED") W " Coverage Verified ..." H 2
  1. ;
  1. Q
  1. ;
  1. REJECT(IBBUFDA,DIRUT) ; process a reject and then delete a buffer entry
  1. ; Output parameter DIRUT is optional and passed in by reference. This
  1. ; variable will be defined if the user enters a leading up-arrow,
  1. ; times out, or enters a null response. This is so the calling routine
  1. ; can detect if the user did something other than say Yes or No to
  1. ; this question.
  1. ;
  1. N DIR,X,Y,IBX Q:'$G(IBBUFDA)
  1. D FULL^VALM1 S VALMBCK="R"
  1. W ! D DISPBUF^IBCNBU1(IBBUFDA)
  1. 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.",!
  1. ;
  1. 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)),".",!!
  1. ;
  1. S DIR("?")="Enter Yes to delete this buffer entry without saving any of it's data to the Insurance files."
  1. S DIR(0)="YO",DIR("B")="N",DIR("A")="Reject this buffer entry (delete without saving to Insurance files)"
  1. D ^DIR
  1. I $D(DIRUT) G REJX
  1. I Y=1 D REJECT^IBCNBAR(IBBUFDA) S VALMBCK="Q" D UPDLN^IBCNBLL(IBBUFDA,"REJECTED")
  1. REJX ;
  1. Q
  1. ;
  1. ACCEPT(IBBUFDA) ; process a buffer entry for acceptance
  1. ;
  1. Q:'$G(IBBUFDA)
  1. N IBDA,IBINSDA,IBGRPDA,IBPOLDA,IBACCEPT S IBACCEPT=0
  1. N IBBUFABORT S IBBUFABORT=0 ;IB*737/CKB
  1. ;
  1. D FULL^VALM1
  1. ;
  1. S IBDA=$$SEL^IBCNBLA("IBCNBLPX")
  1. 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
  1. 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
  1. ;
  1. S IBINSDA=+IBDA,IBGRPDA=+$P(IBDA,U,2),IBPOLDA=+$P(IBDA,U,3)
  1. S:'IBINSDA (IBGRPDA,IBPOLDA)=0 S:'IBGRPDA IBPOLDA=0
  1. ;
  1. I 'IBINSDA,'$D(^XUSEC("IB INSURANCE COMPANY ADD",DUZ)) D G ACCPTQ
  1. . W !!,"Sorry, but you do not have the required privileges to add",!,"new Insurance Companies."
  1. . D WAIT^IBCNBUH
  1. ;
  1. ;IB*737/CKB - ensure that the buffer effective is populated (IBBUFABORT=2)
  1. N BUFEFFDT S BUFEFFDT=$$GET1^DIQ(355.33,IBBUFDA_",",60.02,"I")
  1. I BUFEFFDT="" S IBBUFABORT=2 G ACCPTQ
  1. ;
  1. S IBACCEPT=$$ACCEPT^IBCNBAA(IBBUFDA,IBINSDA,IBGRPDA,IBPOLDA)
  1. ;
  1. ACCPTQ ;IB*737/CKB - if the Buffer entry wasn't Accepted (see IBBUFABORT), display warning message and return to Buffer
  1. I IBBUFABORT D Q
  1. . I IBBUFABORT=1 W !,"*** Unable to process entry, if accepted it would corrupt the Effective Date of the policy ***"
  1. . I IBBUFABORT=2 W !!,"*** Unable to process entry, the Effective Date is required ***"
  1. . D PAUSE^VALM1
  1. . S VALMBCK="Q"
  1. S VALMBCK="R" I +IBACCEPT S VALMBCK="Q" D UPDLN^IBCNBLL(IBBUFDA,"ACCEPTED")
  1. Q
  1. ;
  1. RESP(BUFF) ; List Response Report for Trace # associated with this entry
  1. ; BUFF = buffer IEN
  1. N NG,IBRSP,IBSTR,IBTRC,STOP,IBCNERTN,POP,IBCNESPC,IBOUT
  1. ; Reset to Full Screen Mode
  1. D FULL^VALM1
  1. S NG=0
  1. I $G(BUFF)="" S NG=1
  1. I 'NG S IBRSP=$O(^IBCN(365,"AF",BUFF,"")) I IBRSP="" S NG=1
  1. I 'NG S IBSTR=$G(^IBCN(365,IBRSP,0)),IBTRC=$P(IBSTR,U,9) I IBTRC="" S NG=1
  1. I NG W !!,"This entry does not have an associated eIV response." D PAUSE^VALM1 G RESPX
  1. S STOP=0,IBCNERTN="IBCNERP1",IBCNESPC("TRCN")=IBTRC_U_IBRSP
  1. 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
  1. D R100^IBCNERP1
  1. RESPX S VALMBCK="R"
  1. Q
  1. INPTTR(FILE,FLD,X) ; Does value X pass input transform for file, field?
  1. N XCUTE
  1. S XCUTE=$$GET1^DID(FILE,FLD,,"INPUT TRANSFORM")
  1. X XCUTE
  1. Q $D(X)
  1. ;
  1. ICB(IBBUFDA) ;called by ICB to update eIV status flag (symbol) in the insurance buffer entry
  1. ;
  1. N SYM,ERR
  1. S SYM=$$GET1^DIQ(355.33,IBBUFDA,.12,"I") Q:'SYM
  1. I $$SYMBOL^IBCNBLL(IBBUFDA)="*" Q ;don't update if manually verified
  1. ; Determine if Expand Entry is allowed to update the eIV Status
  1. I '$P($G(^IBE(365.15,SYM,0)),U,3) Q
  1. ; If the current IIV Status allows updates by Expand Entry, then
  1. ; invoke the function that tries to find a valid payer
  1. S ERR=$$INSERROR^IBCNEUT3("B",IBBUFDA,1)
  1. ; If no errors, then remove the eIV Status
  1. I 'ERR S ERR=$$SIDERR^IBCNBLE1(IBBUFDA,$P(ERR,U,2))
  1. I 'ERR D CLEAR^IBCNEUT4(IBBUFDA)
  1. ; If errors found, then update with the new IIV Status
  1. I ERR D BUFF^IBCNEUT2(IBBUFDA,$P(ERR,U,1))
  1. Q
  1. ;
  1. ESC(IBBUFDA,IBKEYS) ; Escalate to user with ability to edit Insurance/Group data
  1. N DIE,DR,DA,DIR,X,Y,IBX,CODE Q:'$G(IBBUFDA)
  1. D FULL^VALM1 S VALMBCK="R"
  1. W ! D DISPBUF^IBCNBU1(IBBUFDA)
  1. I IBKEYS D G ESCX
  1. . 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.",!
  1. . D PAUSE^VALM1
  1. W !!,"This action will escalate the buffer entry to a level with the ability to edit",!,"insurance and/or group data.",!
  1. ;
  1. 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)),".",!!
  1. ;
  1. S DIR("?")="Enter Yes to escalate this buffer entry."
  1. S DIR(0)="YO",DIR("B")="N",DIR("A")="Escalate this buffer entry"
  1. D ^DIR
  1. I $D(DIRUT) G ESCX
  1. I Y=1 D
  1. . S DIE=355.33,DA=IBBUFDA,CODE="E1"
  1. . S DR=".12///^S X=CODE"
  1. . D ^DIE
  1. . S VALMBCK="Q" D UPDLN^IBCNBLL(IBBUFDA,"EDITED")
  1. ESCX ;
  1. Q