| [613] | 1 | IBCNBAA ;ALB/ARH-Ins Buffer: process Accept set-up ;1 Jun 97
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**82,184,246**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ;
|
|---|
| 6 | ACCEPT(IBBUFDA,IBINSDA,IBGRPDA,IBPOLDA) ; process a buffer entry for acceptance then save in Insurance files
|
|---|
| 7 | ; 1) for Insurance Company, Group/Plan and Policy sets of data:
|
|---|
| 8 | ; a) display the set of buffer data and corresponding existing selected ins data
|
|---|
| 9 | ; b) if ins record exists confirm with user that it is the correct one to use
|
|---|
| 10 | ; c) if ins record exists user selects method of saving to ins record: Merge/Overwrite/Replace/No Change/Individually Accept(skip blanks)
|
|---|
| 11 | ; d) if new record needs to be created get user confirmation
|
|---|
| 12 | ; 2) display the actions that will be taken
|
|---|
| 13 | ; 3) user confirms that is correct
|
|---|
| 14 | ; 4) data moved into insurance files, new records created if needed or edit existing ones
|
|---|
| 15 | ; 5) complete some general functions that are executed whenever insurance is entered/edited
|
|---|
| 16 | ; 6) allow user to view buffer entry and new/updated insurance records
|
|---|
| 17 | ; 7) buffer ins/group/policy data deleted
|
|---|
| 18 | ; 8) buffer entry status updated
|
|---|
| 19 | ;
|
|---|
| 20 | N DFN,IBX,IBHELP,IBNEWINS,IBNEWGRP,IBNEWPOL,IBMVINS,IBMVGRP,IBMVPOL,IBACCPT,DIR,X,Y,DIRUT,IBDONE S IBDONE=0
|
|---|
| 21 | K ^TMP($J,"IB BUFFER SELECTED") ; initialize selection file
|
|---|
| 22 | S IBINSDA=+$G(IBINSDA),IBGRPDA=+$G(IBGRPDA),IBPOLDA=+$G(IBPOLDA),(IBNEWINS,IBNEWGRP,IBNEWPOL,IBMVINS,IBMVGRP,IBMVPOL)=0
|
|---|
| 23 | S DFN=+$G(^IBA(355.33,+$G(IBBUFDA),60)) I 'DFN G ACCPTQ
|
|---|
| 24 | I +IBINSDA,+IBGRPDA,'IBPOLDA S IBPOLDA=$$PTGRP^IBCNBU1(DFN,IBINSDA,IBGRPDA) ; pateint already member of plan
|
|---|
| 25 | ;
|
|---|
| 26 | I $P($G(^IBA(355.33,$G(IBBUFDA),0)),U,4)'="E" G ACCPTQ
|
|---|
| 27 | I +IBINSDA,$G(^DIC(36,IBINSDA,0))="" G ACCPTQ
|
|---|
| 28 | I +IBGRPDA,+$G(^IBA(355.3,IBGRPDA,0))'=IBINSDA G ACCPTQ
|
|---|
| 29 | I +IBGRPDA S IBX=$G(^IBA(355.3,IBGRPDA,0)) I $P(IBX,U,2)=0,+$P(IBX,U,10),$P(IBX,U,10)'=DFN G ACCPTQ
|
|---|
| 30 | I +IBPOLDA,+$G(^DPT(DFN,.312,IBPOLDA,0))'=IBINSDA G ACCPTQ
|
|---|
| 31 | I +IBPOLDA,$P($G(^DPT(DFN,.312,IBPOLDA,0)),U,18)'=IBGRPDA G ACCPTQ
|
|---|
| 32 | ;
|
|---|
| 33 | ACINS ;
|
|---|
| 34 | W @IOF S IBHELP=",INS^IBCNBCD("_IBBUFDA_","_IBINSDA_")"
|
|---|
| 35 | D INS^IBCNBCD(IBBUFDA,IBINSDA)
|
|---|
| 36 | I +IBINSDA S IBACCPT=$$MATCH("INSURANCE COMPANY") S:'IBACCPT (IBINSDA,IBGRPDA,IBPOLDA)=0 I $D(DIRUT) G ACCPTQ
|
|---|
| 37 | I +IBINSDA S IBMVINS=$$MOVE("INSURANCE COMPANY",IBHELP) I $D(DIRUT)!(IBMVINS="") G ACCPTQ
|
|---|
| 38 | I 'IBINSDA S IBNEWINS=$$NEW("INSURANCE COMPANY"),IBMVINS=3,(IBGRPDA,IBPOLDA)=0 I 'IBNEWINS G ACCPTQ
|
|---|
| 39 | ;
|
|---|
| 40 | I +IBMVINS=4 D INS^IBCNBAC(IBBUFDA,IBINSDA,1) ; Ind. Accept-Skip Blanks
|
|---|
| 41 | ;
|
|---|
| 42 | ACGRP ;
|
|---|
| 43 | W @IOF S IBHELP=",GRP^IBCNBCD("_IBBUFDA_","_IBGRPDA_")"
|
|---|
| 44 | I +IBGRPDA W !,?14,"Patient is "_$S(+IBPOLDA:"",1:"NOT ")_"a member of this Insurance Group/Plan",!
|
|---|
| 45 | D GRP^IBCNBCD(IBBUFDA,IBGRPDA)
|
|---|
| 46 | I +IBGRPDA S IBACCPT=$$MATCH("GROUP/PLAN") S:'IBACCPT (IBGRPDA,IBPOLDA)=0 I $D(DIRUT) G ACCPTQ
|
|---|
| 47 | I +IBGRPDA S IBMVGRP=$$MOVE("GROUP/PLAN",IBHELP) I $D(DIRUT)!(IBMVGRP="") G ACCPTQ
|
|---|
| 48 | I 'IBGRPDA S IBNEWGRP=$$NEW("GROUP/PLAN"),IBMVGRP=3,IBPOLDA=0 I 'IBNEWGRP G ACCPTQ
|
|---|
| 49 | ;
|
|---|
| 50 | I +IBMVGRP=4 D GRP^IBCNBAC(IBBUFDA,IBGRPDA,1) ; Ind. Accept-Skip Blanks
|
|---|
| 51 | ;
|
|---|
| 52 | ACPOL ;
|
|---|
| 53 | W @IOF S IBHELP=",POLICY^IBCNBCD("_IBBUFDA_","_IBPOLDA_")"
|
|---|
| 54 | I 'IBPOLDA W !,"This will be a New policy for this group and patient.",!
|
|---|
| 55 | D POLICY^IBCNBCD(IBBUFDA,IBPOLDA)
|
|---|
| 56 | I +IBPOLDA S IBACCPT=$$MATCH("PATIENT POLICY") S:'IBACCPT IBPOLDA=0 I $D(DIRUT) G ACCPTQ
|
|---|
| 57 | I +IBPOLDA S IBMVPOL=$$MOVE("PATIENT POLICY",IBHELP) I $D(DIRUT)!(IBMVPOL="") G ACCPTQ
|
|---|
| 58 | I 'IBPOLDA S IBNEWPOL=$$NEW("PATIENT POLICY"),IBMVPOL=3 I 'IBNEWPOL G ACCPTQ
|
|---|
| 59 | ;
|
|---|
| 60 | I +IBMVPOL=4 D POLICY^IBCNBAC(IBBUFDA,IBPOLDA,1) ; Ind. Accept-Skip Blanks
|
|---|
| 61 | ;
|
|---|
| 62 | CHECK ; display changes that will be made and ask user for confirmation
|
|---|
| 63 | W @IOF
|
|---|
| 64 | ;
|
|---|
| 65 | I +IBINSDA S IBX="The Buffer data will "_$P(IBMVINS,U,2)_" the existing Insurance Company data."
|
|---|
| 66 | I +IBINSDA,'IBMVINS S IBX="There will be "_$P(IBMVINS,U,2)_" to the existing Insurance Company data."
|
|---|
| 67 | I 'IBINSDA S IBX=$P(^IBA(355.33,IBBUFDA,20),U,1)_" will be added as a NEW Insurance Company."
|
|---|
| 68 | W !!,$G(IORVON)_"STEP 1: Insurance Company"_$J("",55)_$G(IORVOFF) W !,IBX
|
|---|
| 69 | ;
|
|---|
| 70 | I +IBGRPDA S IBX="The Buffer data will "_$P(IBMVGRP,U,2)_" the existing Group/Plan data."
|
|---|
| 71 | I +IBGRPDA,'IBMVGRP S IBX="There will be "_$P(IBMVGRP,U,2)_" to the existing Group/Plan data."
|
|---|
| 72 | I 'IBGRPDA S IBX="A NEW Group Plan will be added to this Insurance Company."
|
|---|
| 73 | W !!,$G(IORVON)_"STEP 2: Group/Plan"_$J("",62)_$G(IORVOFF) W !,IBX
|
|---|
| 74 | ;
|
|---|
| 75 | I +IBPOLDA S IBX="The Buffer data will "_$P(IBMVPOL,U,2)_" the existing Policy data."
|
|---|
| 76 | I +IBPOLDA,'IBMVPOL S IBX="There will be "_$P(IBMVPOL,U,2)_" to the existing Policy data."
|
|---|
| 77 | I 'IBPOLDA S IBX="A NEW Patient Policy will be added for this patient and this Group/Plan."
|
|---|
| 78 | W !!,$G(IORVON)_"STEP 3: Patient Policy"_$J("",58)_$G(IORVOFF) W !,IBX
|
|---|
| 79 | ;
|
|---|
| 80 | I +IBINSDA,$P(IBMVINS,U,1)=0,+IBGRPDA,$P(IBMVGRP,U,1)=0,+IBPOLDA,$P(IBMVPOL,U,1)=0 W !!!,"This would result in No Change to the existing Insurance data. Process aborted." D WAIT G ACCPTQ
|
|---|
| 81 | ;
|
|---|
| 82 | I '$$OK G ACCPTQ
|
|---|
| 83 | ;
|
|---|
| 84 | PROCESS ; process all changes selected by user, add/edit insurance files based on buffer data, cleanup, ...
|
|---|
| 85 | ;
|
|---|
| 86 | D ACCEPT^IBCNBAR(IBBUFDA,DFN,IBINSDA,IBGRPDA,IBPOLDA,IBMVINS,IBMVGRP,IBMVPOL,IBNEWINS,IBNEWGRP,IBNEWPOL)
|
|---|
| 87 | S IBDONE=1
|
|---|
| 88 | ;
|
|---|
| 89 | ACCPTQ K ^TMP($J,"IB BUFFER SELECTED") ; cleanup selection file
|
|---|
| 90 | Q IBDONE
|
|---|
| 91 | ;
|
|---|
| 92 | ;
|
|---|
| 93 | ;
|
|---|
| 94 | MATCH(IBDESC) ; ask the user if the buffer entry is a match with the selected insurance file entry
|
|---|
| 95 | ; returns 1 if there is a match, 0 otherwise
|
|---|
| 96 | N DIR,X,Y,IBX S IBX=0
|
|---|
| 97 | S DIR("?")="Enter Yes if this existing "_IBDESC_" corresponds to the buffer entry "_IBDESC_". Enter No to add new "_IBDESC_"."
|
|---|
| 98 | S DIR("?",1)="Entering Yes will match this existing "_IBDESC_" with the buffer entry,"
|
|---|
| 99 | S DIR("?",2)="no new "_IBDESC_" will be created. Any existing "_IBDESC_" data"
|
|---|
| 100 | S DIR("?",3)="changes based on the Buffer data will be applied to this "_IBDESC_"."
|
|---|
| 101 | S DIR("?",4)="Enter No to create a new "_IBDESC_" if the Buffer entry's "
|
|---|
| 102 | S DIR("?",5)=IBDESC_" data does not match any existing "_IBDESC_".",DIR("?",6)=""
|
|---|
| 103 | ;
|
|---|
| 104 | W ! S DIR(0)="YO",DIR("A")="Is this the correct "_IBDESC_" to match with this Buffer entry" D ^DIR I Y=1 S IBX=1
|
|---|
| 105 | Q IBX
|
|---|
| 106 | ;
|
|---|
| 107 | MOVE(IBDESC,IBHELP) ; ask the user what method they want to use to transfer buffer data to the insurance files
|
|---|
| 108 | ; returns 1^merge, 2^overwrite, 3^replace, 4^individually accept (skip blanks),
|
|---|
| 109 | ; 0^no change,
|
|---|
| 110 | ; or "" if none of the methods was chosen
|
|---|
| 111 | N DIR,X,Y,IBX S IBX=""
|
|---|
| 112 | S DIR("?")="^D HELP^IBCNBUH,WAIT^IBCNBAA"_$G(IBHELP),DIR("??")="^D HELP2^IBCNBUH,WAIT^IBCNBAA"_$G(IBHELP)
|
|---|
| 113 | S DIR("A")="Select the method to update the "_IBDESC
|
|---|
| 114 | ; DAOU/BHS - 08/28/2002 - Added INDIVIDUALLY ACCEPT methods
|
|---|
| 115 | W ! S DIR(0)="SOB^M:MERGE;O:OVERWRITE;R:REPLACE;N:NO CHANGE;I:INDIVIDUALLY ACCEPT (SKIP BLANKS)" D ^DIR
|
|---|
| 116 | S IBX=$S(Y="M":1,Y="O":2,Y="R":3,Y="I":4,Y="N":0,1:"") I IBX'="" S IBX=IBX_U_$G(Y(0))_$S(+IBX=1:" with",1:"")
|
|---|
| 117 | Q IBX
|
|---|
| 118 | ;
|
|---|
| 119 | NEW(IBDESC) ; ask user if they want to add a new entry to the insurance files (36, 355.3, or 2.312)
|
|---|
| 120 | ; returns 1 if Yes create a new entry, 0 otherwise
|
|---|
| 121 | N DIR,X,Y,IBX S IBX=0
|
|---|
| 122 | I IBDESC="INSURANCE COMPANY",'$D(^XUSEC("IB INSURANCE COMPANY ADD",DUZ)) W !!,"Sorry, but you do not have the required privileges to add",!,"new Insurance Companies." D WAIT G NEWQ
|
|---|
| 123 | ;
|
|---|
| 124 | S DIR("?")="Enter Yes to create a new "_IBDESC_". Enter No to stop this process."
|
|---|
| 125 | S DIR("?",1)="Enter Yes to create a new "_IBDESC_" in the Insurance files for"
|
|---|
| 126 | S DIR("?",2)="this Buffer entry only if no existing "_IBDESC_" could be found"
|
|---|
| 127 | S DIR("?",3)="that matches this buffer entry.",DIR("?",4)=""
|
|---|
| 128 | W ! S DIR(0)="YO",DIR("A")="No "_IBDESC_" Selected, Add a New "_IBDESC D ^DIR I +Y=1 S IBX=1
|
|---|
| 129 | NEWQ Q IBX
|
|---|
| 130 | ;
|
|---|
| 131 | OK() ; ask the user if the buffer data should be moved to the insurance files
|
|---|
| 132 | ; returns 1 if yes, 0 otherwise
|
|---|
| 133 | N DIR,X,Y,IBX S IBX=0 W !!!
|
|---|
| 134 | S DIR("?")="Enter Yes to accept/verify the buffer data and move it to the insurance files. Enter No to stop this process."
|
|---|
| 135 | S DIR("?",1)="Entering Yes will cause several things to happen:"
|
|---|
| 136 | S DIR("?",2)=" 1 - the above changes will be completed and the Insurance files updated with"
|
|---|
| 137 | S DIR("?",3)=" the buffer data."
|
|---|
| 138 | S DIR("?",4)=" 2 - the Insurance entries modified or added will be flagged as verified."
|
|---|
| 139 | S DIR("?",5)=" 3 - most of the insurance and patient related information in the buffer entry"
|
|---|
| 140 | S DIR("?",6)=" will be deleted, leaving only a stub entry for reporting purposes.",DIR("?",7)=""
|
|---|
| 141 | S DIR(0)="YO",DIR("A")="Is this Correct, update the existing Insurance files now" D ^DIR I Y=1 S IBX=1
|
|---|
| 142 | Q IBX
|
|---|
| 143 | ;
|
|---|
| 144 | WAIT N DIR,DIRUT,DUOUT,DTOUT,X,Y W !! S DIR(0)="E",DIR("A")="Enter RETURN to continue" D ^DIR W !!
|
|---|
| 145 | Q
|
|---|
