- Timestamp:
- Dec 4, 2009, 8:26:01 PM (14 years ago)
- Location:
- FOIAVistA/tag/r
- Files:
-
- 1 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
FOIAVistA/tag/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNSP2.m
r628 r636 1 1 IBCNSP2 ;ALB/AAS - PATIENT INSURANCE INTERFACE FOR REGISTRATION ;21-JUNE-93 2 ;;2.0;INTEGRATED BILLING;**6,28,75,82,155 ,371**;21-MAR-94;Build 573 ;;Per VHA Directive 2004-038, this routine should not be modified.2 ;;2.0;INTEGRATED BILLING;**6,28,75,82,155**;21-MAR-94 3 ;;Per VHA Directive 10-93-142, this routine should not be modified. 4 4 ; 5 5 % ; … … 22 22 ; 23 23 I '$$ASKCOVD(DFN,.IBCOV,.IBCOVP) S IBQUIT=1 G REGQ 24 ; -- of covered by ins but none currently active so indicate 25 ;S IBCOV=$P($G(^DPT(DFN,.31)),"^",11) 26 ;I IBCOV="Y",'$$INSURED^IBCNS1(DFN) W !!,"Covered By Health Insurance indicates 'YES' but none currently Active.",!,"Please Review!",!! 27 ; 28 ;; -- ask if covered by insuracnce 29 ;S DIE="^DPT(",DR=".3192",DA=DFN D ^DIE K DIC,DIE,DA,DR 30 ;S IBCOVP=$P($G(^DPT(DFN,.31)),"^",11) 31 ;I $D(Y)!($D(DTOUT)) S IBQUIT=1 G REGQ 32 ;I $P($G(^DPT(DFN,.31)),"^",11)'="Y",'$$INSURED^IBCNS1(DFN) S IBQUIT=1 G REGQ 24 33 ; 25 34 R1 S (IBNEW,IBNEWP,IBQUIT)=0 … … 52 61 ; -- edit patient ins. data 53 62 S IBREG=1 G:$G(IBQUIT) REGQ 54 D PAT^IBCNSEH,PATPOL^IBCNSM32(IBCDFN) ,UPDCLM(+$G(IBIFN),DFN,IBCDFN)63 D PAT^IBCNSEH,PATPOL^IBCNSM32(IBCDFN) 55 64 ; 56 65 ; -- edit policy specific data if new or have key … … 75 84 ; 76 85 FEE ; -- fee entry point to add patient insurance. 86 ;N IBFEE S IBFEE=1 D REG 77 87 D FEE^IBCNBME(DFN) 78 88 Q … … 87 97 I 'IBMCR,$$WNRBILL^IBEFUNC(IBIFN) S DGRVRCAL=1 88 98 K IBCNRTN 89 Q90 ;91 UPDCLM(IBIFN,DFN,IBCDFN) ; Update the claim's insurance nodes when edits are made92 ; to the patient insurance file.93 ; This procedure is called when a claim is being edited from IB billing94 ; screen#3 and also when the patient insurance is being edited directly.95 ;96 I '$G(IBIFN)!'$G(DFN)!'$G(IBCDFN) Q ; missing something97 I $P($G(^DGCR(399,IBIFN,0)),U,2)'=DFN Q ; mismatch of claim and DFN98 I $P($G(^DGCR(399,IBIFN,0)),U,13)'=1 Q ; claim not editable99 I '$D(^DPT(DFN,.312,IBCDFN,0)) Q ; missing pat ins data100 NEW X,Z,NODE101 S X=IBCDFN102 F Z=1:1:3 I $P($G(^DGCR(399,IBIFN,"M")),U,11+Z)=IBCDFN D Q103 . S NODE="I"_Z104 . D IX^IBCNS2(IBIFN,NODE)105 . Q106 99 Q 107 100 ;
Note:
See TracChangeset
for help on using the changeset viewer.