| 1 | IBCNSP1 ;ALB/AAS - INSURANCE MANAGEMENT - policy actions ;22-OCT-92
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**6,28,40,43,52,85,103,361,371,377**;21-MAR-94;Build 23
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;;ICR#5002 for read of ^DIE input template data
|
|---|
| 5 | ;
|
|---|
| 6 | % G EN^IBCNSP
|
|---|
| 7 | ;
|
|---|
| 8 | EA ; -- Edit all
|
|---|
| 9 | N IBCDFN,IBTRC,IBTRN
|
|---|
| 10 | D FULL^VALM1 W !!
|
|---|
| 11 | S IBCDFN=$P($G(IBPPOL),"^",4) I 'IBCDFN W !!,"Can't identify the policy!" G EAQ
|
|---|
| 12 | S IBCNSEH=1 D PAT^IBCNSEH
|
|---|
| 13 | ;
|
|---|
| 14 | D BEFORE^IBCNSEVT
|
|---|
| 15 | D PATPOL^IBCNSM32(IBCDFN)
|
|---|
| 16 | D AFTER^IBCNSEVT,^IBCNSEVT
|
|---|
| 17 | ;
|
|---|
| 18 | ; -- edit policy data
|
|---|
| 19 | D POL^IBCNSEH
|
|---|
| 20 | D EDPOL^IBCNSM3(IBCDFN)
|
|---|
| 21 | ;
|
|---|
| 22 | W !! D AI
|
|---|
| 23 | ;
|
|---|
| 24 | EAQ D:$G(IBTRC) AIP^IBCNSP02(IBTRC)
|
|---|
| 25 | D BLD^IBCNSP
|
|---|
| 26 | S VALMBCK="R"
|
|---|
| 27 | Q
|
|---|
| 28 | ;
|
|---|
| 29 | AB ; -- Annual Benefits
|
|---|
| 30 | S X=+$P($G(IBPPOL),"^",4),IBCNS=+$G(^DPT(DFN,.312,X,0)),IBCPOL=+$P($G(^(0)),"^",18)
|
|---|
| 31 | I 'IBCPOL W !!,"Can't identify the plan!" S VALMBCK="" G ABQ
|
|---|
| 32 | D FULL^VALM1 W !!
|
|---|
| 33 | D EN^VALM("IBCNS ANNUAL BENEFITS")
|
|---|
| 34 | S VALMBCK="R"
|
|---|
| 35 | ABQ Q
|
|---|
| 36 | ;
|
|---|
| 37 | BU ; -- Benefits Used
|
|---|
| 38 | S IBCDFN=+$P($G(IBPPOL),"^",4),IBCNS=+$G(^DPT(DFN,.312,IBCDFN,0)),IBCPOL=+$P($G(^(0)),"^",18)
|
|---|
| 39 | I 'IBCPOL W !!,"Can't identify the plan!" S VALMBCK="" G BUQ
|
|---|
| 40 | D FULL^VALM1 W !!
|
|---|
| 41 | D EN^VALM("IBCNS BENEFITS USED BY DATE")
|
|---|
| 42 | S VALMBCK="R"
|
|---|
| 43 | BUQ Q
|
|---|
| 44 | ;
|
|---|
| 45 | IT ; -- edit insurance type info from patient policy and plan edit
|
|---|
| 46 | D FULL^VALM1 W !!
|
|---|
| 47 | N IBCDFN
|
|---|
| 48 | S IBCDFN=+$P($G(IBPPOL),"^",4),IBCPOL=+$P($G(^DPT(DFN,.312,IBCDFN,0)),"^",18)
|
|---|
| 49 | I 'IBCPOL W !!,"Can't identify the plan!" S VALMBCK="" G ITQ
|
|---|
| 50 | D ITEDIT(IBCPOL,IBCDFN)
|
|---|
| 51 | ITQ S VALMBCK="R" Q
|
|---|
| 52 | ;
|
|---|
| 53 | IT1 ; -- edit insurance type info from patient policy
|
|---|
| 54 | D ITEDIT(IBCPOL)
|
|---|
| 55 | S VALMBCK="R"
|
|---|
| 56 | Q
|
|---|
| 57 | ;
|
|---|
| 58 | ITEDIT(IBCPOL,IBCDFN) ;Edit insurance type info once you have plan (IBCPOL)
|
|---|
| 59 | ; IBCDFN = the ifn of the policy multiple for pt in ^DPT, node .312
|
|---|
| 60 | ; only defined for editing via patient policy
|
|---|
| 61 | G:'$G(IBCPOL) ITEDITQ
|
|---|
| 62 | D SAVE^IBCNSP3(IBCPOL)
|
|---|
| 63 | L +^IBA(355.3,+IBCPOL):5 I '$T D LOCKED^IBTRCD1 G ITEDITQ
|
|---|
| 64 | I $G(IBCDFN) S IBCNSEH=+$G(^IBE(350.9,1,4)) D POL^IBCNSEH
|
|---|
| 65 | I $P($G(^IBA(355.3,IBCPOL,0)),"^",11) W !?2,*7,"Please note that this plan is inactive!",!
|
|---|
| 66 | S DA=IBCPOL,DIE="^IBA(355.3,",DR=".05;.12;.06;.07;.08"
|
|---|
| 67 | D ^DIE K DIC,DIE,DA,DR
|
|---|
| 68 | D COMP^IBCNSP3(IBCPOL)
|
|---|
| 69 | I IBDIF D UPDATE^IBCNSP3(IBCPOL) D:$G(IBCDFN) UPDATPT^IBCNSP3(DFN,IBCDFN),BLD^IBCNSP D:'$G(IBCDFN) INIT^IBCNSC4
|
|---|
| 70 | L -^IBA(355.3,+IBCPOL)
|
|---|
| 71 | ITEDITQ Q
|
|---|
| 72 | ;
|
|---|
| 73 | ED ; -- Edit effective dates
|
|---|
| 74 | D FULL^VALM1 W !!
|
|---|
| 75 | N IBDIF,DA,DR,DIE,DIC
|
|---|
| 76 | D BEFORE^IBCNSEVT
|
|---|
| 77 | D SAVEPT^IBCNSP3(DFN,IBCDFN)
|
|---|
| 78 | L +^DPT(DFN,.312,+$P($G(IBPPOL),"^",4)):5 I '$T D LOCKED^IBTRCD1 G EDQ
|
|---|
| 79 | D VARS^IBCNSP3
|
|---|
| 80 | S DR="8;3;1.09//;3.04"
|
|---|
| 81 | D ^DIE K DIC,DIE,DA,DR
|
|---|
| 82 | D COMPPT^IBCNSP3(DFN,IBCDFN) I IBDIF D UPDATPT^IBCNSP3(DFN,IBCDFN),UPDCLM(DFN,IBCDFN),AFTER^IBCNSEVT,^IBCNSEVT,BLD^IBCNSP
|
|---|
| 83 | L -^DPT(DFN,.312,+$P($G(IBPPOL),"^",4))
|
|---|
| 84 | EDQ S VALMBCK="R" Q
|
|---|
| 85 | ;
|
|---|
| 86 | VC ; -- Verify Coverage
|
|---|
| 87 | D FULL^VALM1 W !!
|
|---|
| 88 | D VFY^IBCNSM2
|
|---|
| 89 | D BLD^IBCNSP
|
|---|
| 90 | S VALMBCK="R" Q
|
|---|
| 91 | ;
|
|---|
| 92 | SU ; -- Subscriber Update
|
|---|
| 93 | D FULL^VALM1 W !!
|
|---|
| 94 | ;Patch 40
|
|---|
| 95 | N IBDIF,DA,DR,DIC,DIE,DGSENFLG
|
|---|
| 96 | S DGSENFLG=1
|
|---|
| 97 | D SAVEPT^IBCNSP3(DFN,IBCDFN)
|
|---|
| 98 | D VARS^IBCNSP3
|
|---|
| 99 | L +^DPT(DFN,.312,+$P($G(IBPPOL),"^",4)):5 I '$T D LOCKED^IBTRCD1 G SUQ
|
|---|
| 100 | ;
|
|---|
| 101 | D EDIT(DFN,IBCDFN) ; IB*371 - edit pat ins 2.312 subfile fields
|
|---|
| 102 | ;
|
|---|
| 103 | D COMPPT^IBCNSP3(DFN,IBCDFN)
|
|---|
| 104 | I IBDIF D UPDATPT^IBCNSP3(DFN,IBCDFN),BLD^IBCNSP
|
|---|
| 105 | L -^DPT(DFN,.312,+$P($G(IBPPOL),"^",4))
|
|---|
| 106 | SUQ S VALMBCK="R" Q
|
|---|
| 107 | ;
|
|---|
| 108 | IC ; -- Insurance Contact Information
|
|---|
| 109 | D FULL^VALM1 W !!
|
|---|
| 110 | N IBDIF,DA,DR,DIC,DIE,IBTRC,DIR,DUOUT,DTOUT,DIRUT,IBTRN
|
|---|
| 111 | D AI
|
|---|
| 112 | D:$G(IBTRC) AIP^IBCNSP02(IBTRC),BLD^IBCNSP
|
|---|
| 113 | S VALMBCK="R" Q
|
|---|
| 114 | Q
|
|---|
| 115 | AI ; -- Add ins. verification entry
|
|---|
| 116 | N X,Y,I,J,DA,DR,DIC,DIE,DR,DD,DO,VA,VAIN,VAERR,IBQUIT,IBXIFN,IBTRN,DUOUT,IBX,IBQUIT,DTOUT
|
|---|
| 117 | Q:'$G(DFN)
|
|---|
| 118 | Q:'$G(IBCDFN) S IBQUIT=0
|
|---|
| 119 | D AI^IBCNSP02
|
|---|
| 120 | Q
|
|---|
| 121 | ;
|
|---|
| 122 | PIDEF(IBREL,FLD,IBDFN,SPDEF) ; Function to return patient file defaults
|
|---|
| 123 | ; Called from input template IBCN PATIENT INSURANCE
|
|---|
| 124 | ; IBREL = value from 2.312,4.03 field (PT. RELATIONSHIP - HIPAA)
|
|---|
| 125 | ; FLD = field# in file 2.312
|
|---|
| 126 | ; IBDFN = patient ien to file 2
|
|---|
| 127 | ; SPDEF = spouse default flag =1 if this field should be defaulted
|
|---|
| 128 | ; when the spouse is the policy holder
|
|---|
| 129 | ;
|
|---|
| 130 | ; The purpose is to provide a default value for the field when the
|
|---|
| 131 | ; patient and the ins. subscriber are the same.
|
|---|
| 132 | ;
|
|---|
| 133 | NEW VAL
|
|---|
| 134 | S VAL=""
|
|---|
| 135 | I +$G(IBREL)'=1,+$G(IBREL)'=18 G PIDEFX ; patient not the insured or spouse, get out
|
|---|
| 136 | I +$G(IBREL)=1,'$G(SPDEF) G PIDEFX ; not a field for spouse default
|
|---|
| 137 | I '$G(FLD) G PIDEFX ; no field# passed in
|
|---|
| 138 | I '$G(IBDFN) G PIDEFX ; no patient passed in
|
|---|
| 139 | ;
|
|---|
| 140 | ; Build the patient demographics area
|
|---|
| 141 | I '$D(^UTILITY("VADM",$J)) D
|
|---|
| 142 | . N VAHOW,DFN,VADM
|
|---|
| 143 | . S VAHOW=2,DFN=IBDFN D DEM^VADPT
|
|---|
| 144 | . Q
|
|---|
| 145 | ;
|
|---|
| 146 | ; Build the patient address area
|
|---|
| 147 | I '$D(^UTILITY("VAPA",$J)) D
|
|---|
| 148 | . N VAHOW,DFN,VAPA
|
|---|
| 149 | . S VAHOW=2,DFN=IBDFN,VAPA("P")="" D ADD^VADPT
|
|---|
| 150 | . Q
|
|---|
| 151 | ;
|
|---|
| 152 | I FLD=17 S VAL=$P($G(^UTILITY("VADM",$J,1)),U,1) G PIDEFX ; Name
|
|---|
| 153 | I FLD=3.01 S VAL=$$FMTE^XLFDT($P($G(^UTILITY("VADM",$J,3)),U,1),"5Z") G PIDEFX ; Date of Birth
|
|---|
| 154 | I FLD=3.02 S VAL=$$EXTERNAL^DILFD(2,.325,,$P($G(^DPT(IBDFN,.32)),U,5)) G PIDEFX ; Branch
|
|---|
| 155 | I FLD=3.05 S VAL=$P($G(^UTILITY("VADM",$J,2)),U,2) G PIDEFX ; SSN
|
|---|
| 156 | I FLD=3.06 S VAL=$P($G(^UTILITY("VAPA",$J,1)),U,1) G PIDEFX ; Street Address 1
|
|---|
| 157 | I FLD=3.07 S VAL=$P($G(^UTILITY("VAPA",$J,2)),U,1) G PIDEFX ; Street Address 2
|
|---|
| 158 | I FLD=3.08 S VAL=$P($G(^UTILITY("VAPA",$J,4)),U,1) G PIDEFX ; City
|
|---|
| 159 | I FLD=3.09 S VAL=$P($G(^UTILITY("VAPA",$J,5)),U,2) G PIDEFX ; State
|
|---|
| 160 | I FLD=3.1 S VAL=$P($G(^UTILITY("VAPA",$J,11)),U,2) G PIDEFX ; Zipcode
|
|---|
| 161 | I FLD=3.11 S VAL=$P($G(^UTILITY("VAPA",$J,8)),U,1) G PIDEFX ; Phone#
|
|---|
| 162 | I FLD=3.12 S VAL=$P($G(^UTILITY("VADM",$J,5)),U,2) G PIDEFX ; Sex
|
|---|
| 163 | PIDEFX ;
|
|---|
| 164 | Q VAL
|
|---|
| 165 | ;
|
|---|
| 166 | ASK(QUES,DEFLT) ; Function to ask Yes/No Question
|
|---|
| 167 | ; Returns 1 (yes), 0 (no, up-arrow, or timeout)
|
|---|
| 168 | NEW X,Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT
|
|---|
| 169 | S DIR(0)="Y",DIR("A")=$G(QUES)
|
|---|
| 170 | S DIR("B")=$S($G(DEFLT):"Yes",1:"No")
|
|---|
| 171 | W ! D ^DIR W:Y !
|
|---|
| 172 | I $D(DIRUT) S Y=0
|
|---|
| 173 | ASKX ;
|
|---|
| 174 | Q Y
|
|---|
| 175 | ;
|
|---|
| 176 | EDIT(IBDFN,IBCDFN,IBQUIT) ; Main call to edit data in 2.312 pat ins subfile
|
|---|
| 177 | ; IBDFN - patient DFN
|
|---|
| 178 | ; IBCDFN - ien for patient insurance policy in subfile 2.312
|
|---|
| 179 | ; IBQUIT - Output variable. Pass by reference. Will be set to 1 if
|
|---|
| 180 | ; the user entered an up-arrow, timed-out, or deleted the
|
|---|
| 181 | ; 2.312 subfile entry by entering "@" at the .01 field
|
|---|
| 182 | ;
|
|---|
| 183 | NEW DA,DR,DIE,IBZ,IBY,X,Y,DTOUT
|
|---|
| 184 | NEW IDS,SUB,PAT,PCE,SUB1,PAT1
|
|---|
| 185 | S DA(1)=+$G(IBDFN) ; patient IEN
|
|---|
| 186 | S DA=+$G(IBCDFN) ; patient insurance IEN
|
|---|
| 187 | I 'DA!'DA(1) G EDITX
|
|---|
| 188 | S DIE="^DPT("_IBDFN_",.312,"
|
|---|
| 189 | ;
|
|---|
| 190 | ; Find the input template IEN for the [IBCN PATIENT INSURANCE] template
|
|---|
| 191 | S IBY=+$$FIND1^DIC(.402,,"X","IBCN PATIENT INSURANCE")
|
|---|
| 192 | I 'IBY G EDITX
|
|---|
| 193 | ;
|
|---|
| 194 | ; Build the DR array/string - ICR# 5002
|
|---|
| 195 | M DR(1)=^DIE(IBY,"DR",2)
|
|---|
| 196 | S DR=$G(DR(1,2.312))
|
|---|
| 197 | I DR="" G EDITX
|
|---|
| 198 | ;
|
|---|
| 199 | S $P(^DIE(IBY,0),U,7)=DT ; see TEM+2^DIE ICR# 5002
|
|---|
| 200 | ;
|
|---|
| 201 | D ^DIE ; edit subfile data
|
|---|
| 202 | ;
|
|---|
| 203 | ; If the user entered an up-arrow, or timed-out, or deleted the entry,
|
|---|
| 204 | ; then set the output variable IBQUIT
|
|---|
| 205 | I $D(Y)!$D(DTOUT)!'$D(DA) S IBQUIT=1
|
|---|
| 206 | ;
|
|---|
| 207 | F IBZ="VADM","VAPA" K ^UTILITY(IBZ,$J) ; cleanup scratch global
|
|---|
| 208 | ;
|
|---|
| 209 | D UPDCLM(IBDFN,IBCDFN) ; update editable claims
|
|---|
| 210 | ;
|
|---|
| 211 | ; Cleanup any problems in the secondary ID area
|
|---|
| 212 | S IDS=$G(^DPT(IBDFN,.312,IBCDFN,5)) ; whole 5 node
|
|---|
| 213 | S (SUB,PAT)=""
|
|---|
| 214 | F PCE=3:1:8 S $P(SUB,U,PCE)=$P(IDS,U,PCE-1) ; subscriber sec ID/qual
|
|---|
| 215 | F PCE=3:1:8 S $P(PAT,U,PCE)=$P(IDS,U,PCE+5) ; patient sec ID/qual
|
|---|
| 216 | ; SUB and PAT are 8-piece strings with pieces 1 and 2 being nil
|
|---|
| 217 | S SUB1=$$SCRUB^IBCEF21(SUB) ; scrub 8-piece string
|
|---|
| 218 | S PAT1=$$SCRUB^IBCEF21(PAT) ; scrub 8-piece string
|
|---|
| 219 | I SUB'=SUB1 S $P(^DPT(IBDFN,.312,IBCDFN,5),U,2,7)=$P(SUB1,U,3,8)
|
|---|
| 220 | I PAT'=PAT1 S $P(^DPT(IBDFN,.312,IBCDFN,5),U,8,13)=$P(PAT1,U,3,8)
|
|---|
| 221 | ;
|
|---|
| 222 | EDITX ;
|
|---|
| 223 | Q
|
|---|
| 224 | ;
|
|---|
| 225 | UPDCLM(IBDFN,IBCDFN) ; Update the Insurance nodes of claims that are still editable
|
|---|
| 226 | NEW IBIFN
|
|---|
| 227 | S IBIFN=0 F S IBIFN=$O(^DGCR(399,"C",IBDFN,IBIFN)) Q:'IBIFN D UPDCLM^IBCNSP2(IBIFN,IBDFN,IBCDFN)
|
|---|
| 228 | ;
|
|---|
| 229 | UPDCLMX ;
|
|---|
| 230 | Q
|
|---|
| 231 | ;
|
|---|
| 232 | PRELCNV(CODE,FLG) ; conversion between X12, NCPDP and VistA pt. relationship codes
|
|---|
| 233 | ; CODE - code for pt. relationship to convert
|
|---|
| 234 | ; FLG - 0 for X12 -> VistA conversion, 1 for VistA -> X12 conversion, 2 - for VistA -> NCPDP conversion
|
|---|
| 235 | ; returns converted code for pt. relationship, or null if no match found
|
|---|
| 236 | N I,RES,VSTR,X12STR
|
|---|
| 237 | S VSTR="01^02^03^08^11^15^32^33^34^35^36"
|
|---|
| 238 | S X12STR="18^01^19^20^39^41^32^33^29^53^G8"
|
|---|
| 239 | S RES=""
|
|---|
| 240 | I FLG=0 F I=1:1:11 S:$P(X12STR,U,I)=CODE RES=$P(VSTR,U,I) Q:RES'=""
|
|---|
| 241 | I FLG=1 F I=1:1:11 S:$P(VSTR,U,I)=CODE RES=$P(X12STR,U,I) Q:RES'=""
|
|---|
| 242 | I FLG=2,+CODE>0 S RES=$S(+CODE>3:"04",1:CODE)
|
|---|
| 243 | Q RES
|
|---|
