- 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/IBCNSP01.m
r628 r636 1 IBCNSP01 ;ALB/AAS - INSURANCE MANAGEMENT - EXPANDED POLICY ; 05-MAR-19932 ;;2.0;INTEGRATED BILLING;**43,52,85,251 ,371,377**;21-MAR-94;Build 233 ;;Per VHA Directive 2004-038, this routine should not be modified.1 IBCNSP01 ;ALB/AAS - INSURANCE MANAGEMENT - EXPANDED POLICY ; 05-MAR-1993 2 ;;2.0;INTEGRATED BILLING;**43,52,85,251**;21-MAR-94 3 ;;Per VHA Directive 10-93-142, this routine should not be modified. 4 4 ; 5 5 ; … … 9 9 SUBSC ; -- subscriber region 10 10 N OFFSET,START 11 S START= 24,OFFSET=211 S START=19,OFFSET=2 12 12 D SET^IBCNSP(START,OFFSET," Subscriber Information ",IORVON,IORVOFF) 13 13 S Y=$P(IBCDFND,"^",6),C=$P(^DD(2.312,6,0),"^",2) D Y^DIQ 14 14 D SET^IBCNSP(START+1,OFFSET," Whose Insurance: "_Y) 15 15 D SET^IBCNSP(START+2,OFFSET," Subscriber Name: "_$P(IBCDFND,"^",17)) 16 S Y=$P(IBCDFND 4,"^",3),C=$P(^DD(2.312,4.03,0),"^",2) D Y^DIQ16 S Y=$P(IBCDFND,"^",16),C=$P(^DD(2.312,16,0),"^",2) D Y^DIQ 17 17 D SET^IBCNSP(START+3,OFFSET," Relationship: "_Y) 18 D SET^IBCNSP(START+4,OFFSET," Primary ID: "_$P(IBCDFND,"^",2))18 D SET^IBCNSP(START+4,OFFSET,"Insurance Number: "_$P(IBCDFND,"^",2)) 19 19 S Y=$P(IBCDFND,"^",20),C=$P(^DD(2.312,.2,0),"^",2) D Y^DIQ 20 20 D SET^IBCNSP(START+5,OFFSET,"Coord. Benefits: "_Y) … … 25 25 VER ; -- Entered/Verfied Region 26 26 N OFFSET,START 27 S START= $O(^TMP("IBCNSVP",$J,""),-1)+1,OFFSET=228 S IB1ST("VERIFY")=START27 S START=41+$G(IBLCNT),OFFSET=2 28 I '$D(@VALMAR@(START-1)) D SET^IBCNSP(START-1,OFFSET," ") 29 29 D SET^IBCNSP(START,OFFSET," User Information ",IORVON,IORVOFF) 30 I IBCDFND1="" D SET^IBCNSP(START+1,OFFSET,"No User Information") G VERQ 30 31 D SET^IBCNSP(START+1,OFFSET," Entered By: "_$E($P($G(^VA(200,+$P(IBCDFND1,"^",2),0)),"^",1),1,20)) 31 32 D SET^IBCNSP(START+2,OFFSET," Entered On: "_$$DAT1^IBOUTL(+IBCDFND1)) … … 34 35 D SET^IBCNSP(START+5,OFFSET," Last Updated By: "_$E($P($G(^VA(200,+$P(IBCDFND1,"^",6),0)),"^",1),1,20)) 35 36 D SET^IBCNSP(START+6,OFFSET," Last Updated On: "_$$DAT1^IBOUTL(+$P(IBCDFND1,"^",5))) 36 D SET^IBCNSP(START+7,2," ") ; 2 blank lines to end section37 D SET^IBCNSP(START+8,2," ")38 37 VERQ Q 39 ;40 ID ; Subscriber and patient primary and secondary ID's and qualifiers41 NEW START,OFFSET,IBL,G,PCE,QUAL,QUAL142 S G=IBCDFND543 S (START,IBL)=$O(^TMP("IBCNSVP",$J,""),-1)+1,OFFSET=244 S IB1ST("ID")=START45 D SET^IBCNSP(START,OFFSET," Insurance Company ID Numbers (use Subscriber Update Action) ",IORVON,IORVOFF)46 S IBL=IBL+147 D SET^IBCNSP(IBL,OFFSET," Subscriber Primary ID: "_$P(IBCDFND,U,2))48 ;49 F PCE=3,5,7 D ; subscriber secondary IDs50 . I $P(G,U,PCE)="" Q ; no secondary ID#51 . S QUAL=$P(G,U,PCE-1) ; internal qualifier code52 . S QUAL1=$S(QUAL="23":"Client#",QUAL="IG":"Ins. Policy#",QUAL="SY":"SSN",1:"Unknown")53 . S IBL=IBL+154 . D SET^IBCNSP(IBL,OFFSET,"Subscriber Secondary ID: "_$P(G,U,PCE))55 . D SET^IBCNSP(IBL,52,"ID Qual: "_QUAL_" ("_QUAL1_")")56 . Q57 ;58 ; patient=subscriber so skip over patient ID# display59 I +$P(IBCDFND,U,16)=1 G ID160 ;61 S IBL=IBL+1 D SET^IBCNSP(IBL,2," ") ; blank line62 S IBL=IBL+163 D SET^IBCNSP(IBL,OFFSET," Patient Primary ID: "_$P(G,U,1))64 ;65 F PCE=9,11,13 D ; patient secondary IDs66 . I $P(G,U,PCE)="" Q ; no secondary ID#67 . S QUAL=$P(G,U,PCE-1) ; internal qualifier code68 . S QUAL1=$S(QUAL="23":"Client#",QUAL="IG":"Ins. Policy#",QUAL="SY":"SSN",1:"Unknown")69 . S IBL=IBL+170 . D SET^IBCNSP(IBL,OFFSET," Patient Secondary ID: "_$P(G,U,PCE))71 . D SET^IBCNSP(IBL,52,"ID Qual: "_QUAL_" ("_QUAL1_")")72 . Q73 ;74 ID1 ; end of section - 2 blank lines75 S IBL=IBL+1 D SET^IBCNSP(IBL,2," ")76 S IBL=IBL+1 D SET^IBCNSP(IBL,2," ")77 IDQ ;78 Q79 38 ; 80 39 RIDER ; -- Personal policy riders 81 40 N OFFSET,START,IBI,IBL,IBPR,IBPRD 82 S START=$O(^TMP("IBCNSVP",$J,""),-1)+1,OFFSET=2,IBL=0 41 S START=53+$G(IBLCNT),OFFSET=2,IBL=0 42 I '$D(@VALMAR@(START-1)) D SET^IBCNSP(START-1,OFFSET," ") 83 43 D SET^IBCNSP(START,OFFSET," Personal Riders ",IORVON,IORVOFF) 84 44 S IBI="" F S IBI=$O(^IBA(355.7,"APP",DFN,IBCDFN,IBI)) Q:'IBI S IBPR=$O(^(IBI,0)),IBPRD=+$G(^IBA(355.7,IBPR,0)),IBL=IBL+1 D 85 . D SET^IBCNSP(START+IBL,OFFSET," Rider #"_IBL_": "_$$EXPAND^IBTRE(355.7,.01,IBPRD)) 86 . Q 87 S IBL=IBL+1 D SET^IBCNSP(START+IBL,OFFSET," ") 88 S IBL=IBL+1 D SET^IBCNSP(START+IBL,OFFSET," ") 45 .D SET^IBCNSP(START+IBL,OFFSET," Rider #"_IBL_": "_$$EXPAND^IBTRE(355.7,.01,IBPRD)) 46 S IBLCNT=$G(IBLCNT)+IBL 89 47 Q 90 48 ; 91 49 AI ; -- Add ins. verification entry 92 50 ; called from ai^ibcnsp1 51 ;N X,Y,I,J,DA,DR,DIC,DIE,DR,DD,DO,VA,VAIN,VAERR,IBQUIT,IBXIFN,IBTRN,DUOUT,IBX,IBQUIT,DTOUT 52 ;Q:'$G(DFN) 53 ;Q:'$G(IBCDFN) S IBQUIT=0 93 54 ; 94 55 ; -- see if current inpatient
Note:
See TracChangeset
for help on using the changeset viewer.