source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNSP01.m@ 619

Last change on this file since 619 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 5.4 KB
RevLine 
[613]1IBCNSP01 ;ALB/AAS - INSURANCE MANAGEMENT - EXPANDED POLICY ;05-MAR-1993
2 ;;2.0;INTEGRATED BILLING;**43,52,85,251,371,377**;21-MAR-94;Build 23
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ;
6% D SUBSC,RIDER
7 Q
8 ;
9SUBSC ; -- subscriber region
10 N OFFSET,START
11 S START=24,OFFSET=2
12 D SET^IBCNSP(START,OFFSET," Subscriber Information ",IORVON,IORVOFF)
13 S Y=$P(IBCDFND,"^",6),C=$P(^DD(2.312,6,0),"^",2) D Y^DIQ
14 D SET^IBCNSP(START+1,OFFSET," Whose Insurance: "_Y)
15 D SET^IBCNSP(START+2,OFFSET," Subscriber Name: "_$P(IBCDFND,"^",17))
16 S Y=$P(IBCDFND4,"^",3),C=$P(^DD(2.312,4.03,0),"^",2) D Y^DIQ
17 D SET^IBCNSP(START+3,OFFSET," Relationship: "_Y)
18 D SET^IBCNSP(START+4,OFFSET," Primary ID: "_$P(IBCDFND,"^",2))
19 S Y=$P(IBCDFND,"^",20),C=$P(^DD(2.312,.2,0),"^",2) D Y^DIQ
20 D SET^IBCNSP(START+5,OFFSET,"Coord. Benefits: "_Y)
21 D SET^IBCNSP(START+6,OFFSET,"Primary Provider: "_$P(IBCDFND4,"^",1))
22 D SET^IBCNSP(START+7,OFFSET," Prim Prov Phone: "_$P(IBCDFND4,"^",2))
23 Q
24 ;
25VER ; -- Entered/Verfied Region
26 N OFFSET,START
27 S START=$O(^TMP("IBCNSVP",$J,""),-1)+1,OFFSET=2
28 S IB1ST("VERIFY")=START
29 D SET^IBCNSP(START,OFFSET," User Information ",IORVON,IORVOFF)
30 D SET^IBCNSP(START+1,OFFSET," Entered By: "_$E($P($G(^VA(200,+$P(IBCDFND1,"^",2),0)),"^",1),1,20))
31 D SET^IBCNSP(START+2,OFFSET," Entered On: "_$$DAT1^IBOUTL(+IBCDFND1))
32 D SET^IBCNSP(START+3,OFFSET,"Last Verified By: "_$E($P($G(^VA(200,+$P(IBCDFND1,"^",4),0)),"^",1),1,20))
33 D SET^IBCNSP(START+4,OFFSET,"Last Verified On: "_$$DAT1^IBOUTL(+$P(IBCDFND1,"^",3)))
34 D SET^IBCNSP(START+5,OFFSET," Last Updated By: "_$E($P($G(^VA(200,+$P(IBCDFND1,"^",6),0)),"^",1),1,20))
35 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 section
37 D SET^IBCNSP(START+8,2," ")
38VERQ Q
39 ;
40ID ; Subscriber and patient primary and secondary ID's and qualifiers
41 NEW START,OFFSET,IBL,G,PCE,QUAL,QUAL1
42 S G=IBCDFND5
43 S (START,IBL)=$O(^TMP("IBCNSVP",$J,""),-1)+1,OFFSET=2
44 S IB1ST("ID")=START
45 D SET^IBCNSP(START,OFFSET," Insurance Company ID Numbers (use Subscriber Update Action) ",IORVON,IORVOFF)
46 S IBL=IBL+1
47 D SET^IBCNSP(IBL,OFFSET," Subscriber Primary ID: "_$P(IBCDFND,U,2))
48 ;
49 F PCE=3,5,7 D ; subscriber secondary IDs
50 . I $P(G,U,PCE)="" Q ; no secondary ID#
51 . S QUAL=$P(G,U,PCE-1) ; internal qualifier code
52 . S QUAL1=$S(QUAL="23":"Client#",QUAL="IG":"Ins. Policy#",QUAL="SY":"SSN",1:"Unknown")
53 . S IBL=IBL+1
54 . D SET^IBCNSP(IBL,OFFSET,"Subscriber Secondary ID: "_$P(G,U,PCE))
55 . D SET^IBCNSP(IBL,52,"ID Qual: "_QUAL_" ("_QUAL1_")")
56 . Q
57 ;
58 ; patient=subscriber so skip over patient ID# display
59 I +$P(IBCDFND,U,16)=1 G ID1
60 ;
61 S IBL=IBL+1 D SET^IBCNSP(IBL,2," ") ; blank line
62 S IBL=IBL+1
63 D SET^IBCNSP(IBL,OFFSET," Patient Primary ID: "_$P(G,U,1))
64 ;
65 F PCE=9,11,13 D ; patient secondary IDs
66 . I $P(G,U,PCE)="" Q ; no secondary ID#
67 . S QUAL=$P(G,U,PCE-1) ; internal qualifier code
68 . S QUAL1=$S(QUAL="23":"Client#",QUAL="IG":"Ins. Policy#",QUAL="SY":"SSN",1:"Unknown")
69 . S IBL=IBL+1
70 . D SET^IBCNSP(IBL,OFFSET," Patient Secondary ID: "_$P(G,U,PCE))
71 . D SET^IBCNSP(IBL,52,"ID Qual: "_QUAL_" ("_QUAL1_")")
72 . Q
73 ;
74ID1 ; end of section - 2 blank lines
75 S IBL=IBL+1 D SET^IBCNSP(IBL,2," ")
76 S IBL=IBL+1 D SET^IBCNSP(IBL,2," ")
77IDQ ;
78 Q
79 ;
80RIDER ; -- Personal policy riders
81 N OFFSET,START,IBI,IBL,IBPR,IBPRD
82 S START=$O(^TMP("IBCNSVP",$J,""),-1)+1,OFFSET=2,IBL=0
83 D SET^IBCNSP(START,OFFSET," Personal Riders ",IORVON,IORVOFF)
84 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," ")
89 Q
90 ;
91AI ; -- Add ins. verification entry
92 ; called from ai^ibcnsp1
93 ;
94 ; -- see if current inpatient
95 D INP^VADPT I +VAIN(1) D
96 .S IBTRN=$O(^IBT(356,"AD",+VAIN(1),0))
97 ;
98 S IBXIFN=$O(^IBE(356.11,"ACODE",85,0))
99 ;
100 ; -- if not tracking id allow selecting
101 I '$G(IBTRN) D G:IBQUIT AIQ
102 .W !,"You can now enter a contact and relate it to a Claims Tracking Admission entry."
103 .S DIC("A")="Select RELATED ADMISSION DATE: "
104 .S DIC="^IBT(356,",DIC(0)="AEQ",D="ADFN"_DFN,DIC("S")="I $P(^(0),U,5)"
105 .D IX^DIC K DA,DR,DIC,DIE I $D(DUOUT)!($D(DTOUT)) S IBQUIT=1 Q
106 .I +Y>1 S IBTRN=+Y
107 ;
108 I '$G(IBTRN) W !!,"Warning: This contact is not associated with any care in Claims Tracking.",!,"You may only edit or view this contact using this action.",!
109 ;
110 ; -- select date
111 S IBOK=0,IBI=0 F S IBI=$O(^IBT(356.2,"D",DFN,IBI)) Q:'IBI I $P($G(^IBT(356.2,+IBI,0)),"^",4)=IBXIFN,$P($G(^(1)),"^",5)=IBCDFN S IBOK=1
112 I IBOK D G:IBQUIT AIQ
113 .S DIC="^IBT(356.2,",DIC("A")="Select Contact Date: "
114 .S X="??",DIC(0)="EQ",DIC("S")="I $P($G(^(1)),U,5)=IBCDFN,$P(^(0),U,4)=IBXIFN" ;,DLAYGO=356.2
115 .S D="ADFN"_DFN
116 .D IX^DIC K DIC,DR,DA,DIE,D I $D(DUOUT)!($D(DTOUT)) S IBQUIT=1
117 ;
118 S DIC="^IBT(356.2,",DIC("A")="Select Contact Date: ",DIC("B")="TODAY"
119 S DIC("DR")=".02////"_$G(IBTRN)_";.04////"_IBXIFN_";.05////"_DFN_";.19////1;1.01///NOW;1.02////"_DUZ_";1.05////"_IBCDFN
120 S DIC(0)="AEQL",DIC("S")="I $P(^(0),U,5)=DFN,$P($G(^(1)),U,5)=IBCDFN,$P(^(0),U,4)=IBXIFN",DLAYGO=356.2
121 D ^DIC K DIC
122 I $D(DTOUT)!($D(DUOUT))!(+Y<1) G AIQ
123 S IBTRC=+Y
124 I $G(IBTRC),$G(IBTRN),'$P(^IBT(356.2,+IBTRC,0),"^",2) S DA=IBTRC,DIE="^IBT(356.2,",DR=".02////"_$G(IBTRN) D ^DIE
125 ;
126 ; -- edit ins ver type
127 D EDIT^IBTRCD1("[IBT INS VERIFICATION]",1)
128AIQ Q
Note: See TracBrowser for help on using the repository browser.