- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNBEE.m
r613 r623 1 IBCNBEE 2 ;;2.0;INTEGRATED BILLING;**82,184,252,251,356,361,371,377**;21-MAR-94;Build 23 3 4 5 ADD(IBSOURCE) 6 7 8 9 10 11 12 13 STATUS(IBBUFDA,STATUS,NC,NG,NP) 14 15 16 17 18 19 20 21 22 23 INS(IBBUFDA,FLDS) 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 GRP(IBBUFDA,FLDS) 44 45 46 47 48 49 50 51 52 POLICY(IBBUFDA,FLDS) 53 54 55 56 57 58 59 60 61 62 63 64 ESGHP(IBBUFDA) 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 DELEMP(IBBUFDA) 93 94 95 96 97 98 INSHELP 99 100 101 GRPHELP 102 103 104 105 106 107 POLHELP 108 109 110 111 112 113 114 115 116 INSNAME(IBBUFDA) 117 118 119 120 121 122 123 124 125 126 127 128 129 CHECK(IBBUFDA) 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 CHECKQ 152 153 MRINS 154 155 156 MRGRP 157 158 159 MRPOL ; Patient Policy fields asked of MCCR users in the Buffer Process options (all buffer policy fields except ESGHP,60.05,60.0660.02-61.01160 ;;60.02;60.03;60.14PT. RELATIONSHIP TO INSURED;S IBZZ=X;60.04T;I IBZZ'="18" S Y="@111";60.07///1;60.08///@;60.09///@;62.01///@;S Y="@112";@111;60.07;60.08;60.13;62.01T;@112;60.1:60.12;.03;61.01161 162 OTINS 163 164 165 OTGRP 166 167 168 OTPOL ; Patient Policy fields asked of non-MCCR users entering buffer data from options outside IB (60.02-60.08)169 ;;60.02;60.03;60.14PT. RELATIONSHIP TO INSURED;S IBZZ=X;60.04T;I IBZZ'="18" S Y="@111";60.07///1;60.08///@;60.09///@;62.01///@;S Y="@112";@111;60.07;60.08;60.13;62.01T;@1121 IBCNBEE ;ALB/ARH-Ins Buffer: add/edit existing entries in buffer ;1 Jun 97 2 ;;2.0;INTEGRATED BILLING;**82,184,252,251,356,361**;21-MAR-94;Build 9 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 ADD(IBSOURCE) ; add a new buffer file entry (#355.33), sets only status (0) node data 6 N IBARR,IBERR,IBIFN,IBX I '$G(IBSOURCE) S IBSOURCE=1 7 ; 8 S IBARR(355.33,"+1,",.01)="NOW",IBARR(355.33,"+1,",.03)=IBSOURCE 9 D UPDATE^DIE("E","IBARR","IBIFN","IBERR") 10 S IBX=+$G(IBIFN(1)) I $D(IBERR) S $P(IBX,U,2)=$G(IBERR("DIERR",1,"TEXT",1)) 11 Q IBX 12 ; 13 STATUS(IBBUFDA,STATUS,NC,NG,NP) ; edit the status node 14 ; 15 N IBX,IBARR,IBIFN Q:'$G(IBBUFDA) S IBIFN=IBBUFDA_"," 16 D CHK^DIE(355.33,.04,"",$G(STATUS),.IBX) Q:IBX="^" 17 ; 18 S IBARR(355.33,IBIFN,.04)=STATUS I STATUS="R" S (NC,NG,NP)=0 19 S IBARR(355.33,IBIFN,.07)=+$G(NC),IBARR(355.33,IBIFN,.08)=+$G(NG),IBARR(355.33,IBIFN,.09)=+$G(NP) 20 D FILE^DIE("E","IBARR") 21 Q 22 ; 23 INS(IBBUFDA,FLDS) ; edit the insurance company portion of a buffer file entry 24 ; 25 N DIC,DIE,DA,DR,X,Y,IBCNEXT1 26 I $P($G(^IBA(355.33,+$G(IBBUFDA),0)),U,4)'="E" Q 27 I $G(FLDS)="" S FLDS="MR" 28 ; 29 ; ESG - 6/18/02 - SDD 5.1.4 - Usage of Auto Match when editing 30 ; - the insurance company name in the buffer. Also added an 31 ; - input transform (see below) to clean up the data coming in. 32 ; - fetch the current buffer ins co name 33 ; 34 I FLDS="MR" S IBCNEXT1=$P($G(^IBA(355.33,IBBUFDA,20)),U,1) 35 ; 36 S DR=$P($T(@(FLDS_"INS")+1),";;",2,9999) Q:DR="" 37 ; 38 I FLDS="MR" Q:$$INSNAME(IBBUFDA)<0 S DR=$P($T(@(FLDS_"INS")+1),";;",2,9999),DR=$P(DR,";",2,99999) 39 ; 40 S DIE="^IBA(355.33,",DA=IBBUFDA D ^DIE K DIE,DA,DR 41 Q 42 ; 43 GRP(IBBUFDA,FLDS) ; edit the group/plan portion of the buffer file entry 44 ; 45 N DIC,DIE,DA,DR,X,Y I $P($G(^IBA(355.33,+$G(IBBUFDA),0)),U,4)'="E" Q 46 I $G(FLDS)="" S FLDS="MR" 47 ; 48 S DR=$P($T(@(FLDS_"GRP")+1),";;",2,9999) Q:DR="" 49 S DIE="^IBA(355.33,",DA=IBBUFDA D ^DIE K DIE,DA,DR 50 Q 51 ; 52 POLICY(IBBUFDA,FLDS) ; edit the patient policy portion of the buffer file entry 53 ; 54 N DIC,DIE,DA,DR,X,Y,IBZZ I $P($G(^IBA(355.33,+$G(IBBUFDA),0)),U,4)'="E" Q 55 I $G(FLDS)="" S FLDS="MR" 56 ; 57 S DR=$P($T(@(FLDS_"POL")+1),";;",2,9999) Q:DR="" 58 S DIE="^IBA(355.33,",DA=IBBUFDA 59 S DIE("NO^")="BACKOUTOK" D ^DIE K DIE,DA,DR Q:$D(Y) 60 ; 61 I FLDS="MR" D ESGHP(IBBUFDA) 62 Q 63 ; 64 ESGHP(IBBUFDA) ; sponsoring employer information 65 N DIR,DIRUT,DUOUT,DTOUT,VAOA,VAERR,VA,DFN,IB60,IBE,IBEMPST,IBREL 66 ; 67 ; if insured is patient or spouse, ask if insured's current employer is the plan's sponsoring employer, if yes auto stuff it 68 I +$G(^IBA(355.33,IBBUFDA,61)) W ! S IB60=$G(^IBA(355.33,IBBUFDA,60)) D Q:$D(DIRUT) 69 . ; sponsoring employer is current employer? 70 . S DFN=+IB60,IBREL=$P(IB60,U,6),VAOA("A")=$S(IBREL="01":5,IBREL="02":6,1:"") I 'DFN!(VAOA("A")="") Q 71 . D OAD^VADPT I $G(VAOA(9))="" Q 72 . S DIR("?")="Enter Yes if this plan is sponsored by the "_$S(IBREL="01":"patient's",1:"spouse's")_" current employer." 73 . S DIR("?",1)="Entering Yes will result in the "_$S(IBREL="01":"patient's",1:"spouse's")_" current employer data being",DIR("?",2)="added to the policy as the Sponsoring Employer data.",DIR("?",3)="" 74 . S DIR("A")="Current Employer "_VAOA(9)_" Sponsors this Plan",DIR("B")="No",DIR(0)="Y" D ^DIR W ! I Y'=1 Q 75 . ; 76 . D DELEMP(IBBUFDA) ; delete any data already contained in these fields 77 . ; 78 . ; if the insured's current employer sponsors the plan then stuff that employer's address into the buffer 79 . S IBE=$S(IBREL="01":.311,1:.25),IBEMPST=$P($G(^DPT(DFN,IBE)),U,15) 80 . S DR="61.02///"_VAOA(9)_";61.03///"_IBEMPST_";61.06///"_$E(VAOA(1),1,30)_";61.07///"_$E(VAOA(2),1,30) 81 . S DR=DR_";61.08///"_$E(VAOA(3),1,30)_";61.09///"_$E(VAOA(4),1,20)_";61.1////"_$P(VAOA(5),U,1) 82 . S DR=DR_";61.11////"_$P(VAOA(11),U,1)_";61.12///"_$E(VAOA(8),1,15) 83 . S DIE="^IBA(355.33,",DA=IBBUFDA D ^DIE K DIE,DA,DR 84 ; 85 ; if employer sponsored plan, edit buffer entry's sponsoring employer info 86 I +$G(^IBA(355.33,IBBUFDA,61)) S DR="61.02:61.12",DIE="^IBA(355.33,",DA=IBBUFDA D ^DIE K DIE,DA,DR 87 ; 88 ; if not employer sponsored plan, delete any existing sponsoring employer data 89 I $D(^IBA(355.33,IBBUFDA,61)),'$G(^IBA(355.33,IBBUFDA,61)) D DELEMP(IBBUFDA) 90 Q 91 ; 92 DELEMP(IBBUFDA) ; delete sponsoring employer data 93 N DIC,DIE,DA,DR,X,Y Q:'$D(^IBA(355.33,+$G(IBBUFDA),61)) 94 S DR="61.02///@;61.03///@;61.04///@;61.05///@;61.06///@;61.07///@;61.08///@;61.09///@;61.10///@;61.11///@;61.12///@" 95 S DIE="^IBA(355.33,",DA=IBBUFDA D ^DIE K DIE,DA,DR 96 Q 97 ; 98 INSHELP ; 99 W !!,"------------------------ INSURANCE COMPANY INFORMATION -------------------------",! 100 Q 101 GRPHELP ; 102 W !!,"---------------------------- GROUP/PLAN INFORMATION ----------------------------" 103 W !," The following data defines a specific Group or Plan provided by an Insurance " 104 W !," Company. This may be either a group plan with many potential members or an " 105 W !," individual plan with a single member.",! 106 Q 107 POLHELP ; 108 W !!,"---------------------- POLICY AND SUBSCRIBER INFORMATION -----------------------" 109 W !," The following data defines the subscriber specific policy information for a " 110 W !," particular Insurance Plan. The subscriber, the insured, and the policy holder " 111 W !," all refer to the person who is a member of the plan and therefore holds the " 112 W !," policy. The patient must be covered under the plan but may not be the policy" 113 W !," holder.",! 114 Q 115 ; 116 INSNAME(IBBUFDA) ; Reset insurance company name 117 N DR,DIE,DA,Y,X,IBX,IBNEW,IBNAME 118 S IBX=-1 119 S DR=20.01,DIE="^IBA(355.33,",DA=IBBUFDA 120 D ^DIE 121 I '$D(Y) S IBNEW=$$CHECK(IBBUFDA) 122 I +$G(IBNEW)'<0,$G(IBNEW)'=0,$D(IBNEW) S DR=$P(DR,";",1)_"////"_IBNEW S DIE="^IBA(355.33,",DA=IBBUFDA D ^DIE K DIE,DA,DR I '$D(Y) S IBX=0 123 ; BHS - 10/15/03 - If user entered a caret during $$CHECK still set 124 ; return value to 0 so the user can edit the other 125 ; INS fields 126 I $G(IBNEW)=0!($G(IBNEW)=-1) S IBX=0 127 Q IBX 128 ; 129 CHECK(IBBUFDA) ; Select Insurance Company Name and Automatch 130 ; Buffer file (#355.33), field# 20.01. 131 ; ESG - 6/18/02 - SDD 5.1.4 - Usage of Auto Match when editing the 132 ; insurance company name. Also, display the insurance company 133 ; name lookup/lister and the Auto Match lookup/lister. 134 ; 135 NEW IBNEW,IBNAME,AMLIST 136 ; 137 S IBNEW=0,IBNAME=$P($G(^IBA(355.33,$G(IBBUFDA),20)),U,1) 138 I IBNAME="" G CHECKQ 139 ; 140 ; Perform an insurance company lookup/lister 141 ; BHS - 10/15/03 - Removed quits when user enters a caret to quit the 142 ; the ins lister or Auto Match lister 143 S IBNEW=$$DICINS^IBCNBU1(IBNAME,1,10) 144 I IBNEW=0!(IBNEW<0) D 145 . I '$$AMLOOK^IBCNEUT1(IBNAME,1,.AMLIST) Q 146 . S IBNEW=$$AMSEL^IBCNEUT1(.AMLIST) 147 ; 148 ; user chose a valid insurance company - possible Auto Match add 149 I IBNEW'<0,IBNEW'=0 D AMADD^IBCNEUT6(X,IBCNEXT1) 150 ; 151 CHECKQ Q IBNEW 152 ; 153 MRINS ; Insurance Company fields asked of MCCR users in the Buffer Process options (all buffer ins fields 20.01-21.06) 154 ;;20.01;20.05;20.02:20.04;21.01;I X="" S Y="@111";21.02;I X="" S Y="@111";21.03;@111;21.04:21.06 155 ; 156 MRGRP ; Group/Plan fields asked of MCCR users in the Buffer Process options (all buffer grp fields 40.01-40.09) ;;Daou/EEN adding BIN and PCN (40.1,40.11) 157 ;;40.01:40.03;40.1;40.11;40.09;40.04:40.08 158 ; 159 MRPOL ; Patient Policy fields asked of MCCR users in the Buffer Process options (all buffer policy fields except ESGHP 60.02-61.01 160 ;;60.02;60.03;60.05;60.06//^S X=$S(X="v":"01",X="s":"02",1:"");S IBZZ=X;60.04;I IBZZ'="01" S Y="@111";60.07///1;60.08///@;60.09///@;S Y="@112";@111;60.07:60.09;60.13;@112;60.1:60.12;.03;61.01 161 ; 162 OTINS ; Insurance Company fields asked of non-MCCR users entering buffer data from options outside IB (20.01-20.04,21.01-21.06) 163 ;;20.01:20.04;21.01;I X="" S Y="@111";21.02;I X="" S Y="@111";21.03;@111;21.04:21.06 164 ; 165 OTGRP ; Group/Plan fields asked of non-MCCR users entering buffer data from options outside IB (40.02,40.03,40.09) ;;Daou/EEN-adding BIN & PCN (40.1,40.11) 166 ;;40.02;40.03;40.1;40.11;40.09 167 ; 168 OTPOL ; Patient Policy fields asked of non-MCCR users entering buffer data from options outside IB (60.02-60.09) 169 ;;60.02;60.03;60.05;60.06//^S X=$S(X="v":"01",X="s":"02",1:"");S IBZZ=X;60.04;I IBZZ'="01" S Y="@111";60.07///1;60.08///@;60.09///@;S Y="@112";@111;60.07:60.09;60.13;@112
Note:
See TracChangeset
for help on using the changeset viewer.
