- 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/IBCNSP1.m
r613 r623 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 1 IBCNSP1 ;ALB/AAS - INSURANCE MANAGEMENT - policy actions ; 22-OCT-92 2 ;;2.0;INTEGRATED BILLING;**6,28,40,43,52,85,103,361**;21-MAR-94;Build 9 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 % G EN^IBCNSP 6 ; 7 EA ; -- Edit all 8 N IBCDFN,IBTRC,IBTRN 9 D FULL^VALM1 W !! 10 S IBCDFN=$P($G(IBPPOL),"^",4) I 'IBCDFN W !!,"Can't identify the policy!" G EAQ 11 S IBCNSEH=1 D PAT^IBCNSEH 12 ; 13 D BEFORE^IBCNSEVT 14 D PATPOL^IBCNSM32(IBCDFN) 15 D AFTER^IBCNSEVT,^IBCNSEVT 16 ; 17 ; -- edit policy data 18 D POL^IBCNSEH 19 D EDPOL^IBCNSM3(IBCDFN) 20 ; 21 W !! D AI 22 ; 23 EAQ D:$G(IBTRC) AIP^IBCNSP02(IBTRC) 24 D BLD^IBCNSP 25 S VALMBCK="R" 26 Q 27 ; 28 AB ; -- Annual Benefits 29 S X=+$P($G(IBPPOL),"^",4),IBCNS=+$G(^DPT(DFN,.312,X,0)),IBCPOL=+$P($G(^(0)),"^",18) 30 I 'IBCPOL W !!,"Can't identify the plan!" S VALMBCK="" G ABQ 31 D FULL^VALM1 W !! 32 D EN^VALM("IBCNS ANNUAL BENEFITS") 33 S VALMBCK="R" 34 ABQ Q 35 ; 36 BU ; -- Benefits Used 37 S IBCDFN=+$P($G(IBPPOL),"^",4),IBCNS=+$G(^DPT(DFN,.312,IBCDFN,0)),IBCPOL=+$P($G(^(0)),"^",18) 38 I 'IBCPOL W !!,"Can't identify the plan!" S VALMBCK="" G BUQ 39 D FULL^VALM1 W !! 40 D EN^VALM("IBCNS BENEFITS USED BY DATE") 41 S VALMBCK="R" 42 BUQ Q 43 ; 44 IT ; -- edit insurance type info from patient policy and plan edit 45 D FULL^VALM1 W !! 46 N IBCDFN 47 S IBCDFN=+$P($G(IBPPOL),"^",4),IBCPOL=+$P($G(^DPT(DFN,.312,IBCDFN,0)),"^",18) 48 I 'IBCPOL W !!,"Can't identify the plan!" S VALMBCK="" G ITQ 49 D ITEDIT(IBCPOL,IBCDFN) 50 ITQ S VALMBCK="R" Q 51 ; 52 IT1 ; -- edit insurance type info from patient policy 53 D ITEDIT(IBCPOL) 54 S VALMBCK="R" 55 Q 56 ; 57 ITEDIT(IBCPOL,IBCDFN) ;Edit insurance type info once you have plan (IBCPOL) 58 ; IBCDFN = the ifn of the policy multiple for pt in ^DPT, node .312 59 ; only defined for editing via patient policy 60 G:'$G(IBCPOL) ITEDITQ 61 D SAVE^IBCNSP3(IBCPOL) 62 L +^IBA(355.3,+IBCPOL):5 I '$T D LOCKED^IBTRCD1 G ITEDITQ 63 I $G(IBCDFN) S IBCNSEH=+$G(^IBE(350.9,1,4)) D POL^IBCNSEH 64 I $P($G(^IBA(355.3,IBCPOL,0)),"^",11) W !?2,*7,"Please note that this plan is inactive!",! 65 S DA=IBCPOL,DIE="^IBA(355.3,",DR=".05;.12;.06;.07;.08" 66 D ^DIE K DIC,DIE,DA,DR 67 D COMP^IBCNSP3(IBCPOL) 68 I IBDIF D UPDATE^IBCNSP3(IBCPOL) D:$G(IBCDFN) UPDATPT^IBCNSP3(DFN,IBCDFN),BLD^IBCNSP D:'$G(IBCDFN) INIT^IBCNSC4 69 L -^IBA(355.3,+IBCPOL) 70 ITEDITQ Q 71 ; 72 ED ; -- Edit effective dates 73 D FULL^VALM1 W !! 74 N IBDIF,DA,DR,DIE,DIC 75 D BEFORE^IBCNSEVT 76 D SAVEPT^IBCNSP3(DFN,IBCDFN) 77 L +^DPT(DFN,.312,+$P($G(IBPPOL),"^",4)):5 I '$T D LOCKED^IBTRCD1 G EDQ 78 D VARS^IBCNSP3 79 S DR="8;3;1.09//;3.04" 80 D ^DIE K DIC,DIE,DA,DR 81 D COMPPT^IBCNSP3(DFN,IBCDFN) I IBDIF D UPDATPT^IBCNSP3(DFN,IBCDFN),AFTER^IBCNSEVT,^IBCNSEVT,BLD^IBCNSP 82 L -^DPT(DFN,.312,+$P($G(IBPPOL),"^",4)) 83 EDQ S VALMBCK="R" Q 84 ; 85 VC ; -- Verify Coverage 86 D FULL^VALM1 W !! 87 D VFY^IBCNSM2 88 D BLD^IBCNSP 89 S VALMBCK="R" Q 90 ; 91 SU ; -- Subscriber Update 92 D FULL^VALM1 W !! 93 ;Patch 40 94 N IBDIF,DA,DR,DIC,DIE,DGSENFLG 95 S DGSENFLG=1 96 D SAVEPT^IBCNSP3(DFN,IBCDFN) 97 D VARS^IBCNSP3 98 L +^DPT(DFN,.312,+$P($G(IBPPOL),"^",4)):5 I '$T D LOCKED^IBTRCD1 G SUQ 99 S DR="6;S IBAD=X;K X I '$$VET^IBCNSU1() S Y=""@10"";17///^S X=$P(^DPT(DFN,0),U);16///^S X=""01""" 100 S DR=DR_";S Y=""@20"";@10;17;16//^S X=$S(IBAD=""s"":""02"",1:"""");@20;1;.2;4.01;4.02;3.01;3.12;3.02;3.03;3.05:3.11" 101 D ^DIE K DIC,DIE,DA,DR 102 D COMPPT^IBCNSP3(DFN,IBCDFN) 103 I IBDIF D UPDATPT^IBCNSP3(DFN,IBCDFN),BLD^IBCNSP 104 L -^DPT(DFN,.312,+$P($G(IBPPOL),"^",4)) 105 SUQ S VALMBCK="R" Q 106 ; 107 IC ; -- Insurance Contact Information 108 D FULL^VALM1 W !! 109 N IBDIF,DA,DR,DIC,DIE,IBTRC,DIR,DUOUT,DTOUT,DIRUT,IBTRN 110 D AI 111 D:$G(IBTRC) AIP^IBCNSP02(IBTRC),BLD^IBCNSP 112 S VALMBCK="R" Q 113 Q 114 AI ; -- Add ins. verification entry 115 N X,Y,I,J,DA,DR,DIC,DIE,DR,DD,DO,VA,VAIN,VAERR,IBQUIT,IBXIFN,IBTRN,DUOUT,IBX,IBQUIT,DTOUT 116 Q:'$G(DFN) 117 Q:'$G(IBCDFN) S IBQUIT=0 118 D AI^IBCNSP02 119 Q
Note:
See TracChangeset
for help on using the changeset viewer.
