- 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/IBCNSP01.m
r613 r623 1 IBCNSP01 ;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 ; 9 SUBSC ; -- 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 ; 25 VER ; -- 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," ") 38 VERQ Q 39 ; 40 ID ; 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 ; 74 ID1 ; 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," ") 77 IDQ ; 78 Q 79 ; 80 RIDER ; -- 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 ; 91 AI ; -- 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) 128 AIQ Q 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 ; 5 ; 6 % D SUBSC,RIDER 7 Q 8 ; 9 SUBSC ; -- subscriber region 10 N OFFSET,START 11 S START=19,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(IBCDFND,"^",16),C=$P(^DD(2.312,16,0),"^",2) D Y^DIQ 17 D SET^IBCNSP(START+3,OFFSET," Relationship: "_Y) 18 D SET^IBCNSP(START+4,OFFSET,"Insurance Number: "_$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 ; 25 VER ; -- Entered/Verfied Region 26 N OFFSET,START 27 S START=41+$G(IBLCNT),OFFSET=2 28 I '$D(@VALMAR@(START-1)) D SET^IBCNSP(START-1,OFFSET," ") 29 D SET^IBCNSP(START,OFFSET," User Information ",IORVON,IORVOFF) 30 I IBCDFND1="" D SET^IBCNSP(START+1,OFFSET,"No User Information") G VERQ 31 D SET^IBCNSP(START+1,OFFSET," Entered By: "_$E($P($G(^VA(200,+$P(IBCDFND1,"^",2),0)),"^",1),1,20)) 32 D SET^IBCNSP(START+2,OFFSET," Entered On: "_$$DAT1^IBOUTL(+IBCDFND1)) 33 D SET^IBCNSP(START+3,OFFSET,"Last Verified By: "_$E($P($G(^VA(200,+$P(IBCDFND1,"^",4),0)),"^",1),1,20)) 34 D SET^IBCNSP(START+4,OFFSET,"Last Verified On: "_$$DAT1^IBOUTL(+$P(IBCDFND1,"^",3))) 35 D SET^IBCNSP(START+5,OFFSET," Last Updated By: "_$E($P($G(^VA(200,+$P(IBCDFND1,"^",6),0)),"^",1),1,20)) 36 D SET^IBCNSP(START+6,OFFSET," Last Updated On: "_$$DAT1^IBOUTL(+$P(IBCDFND1,"^",5))) 37 VERQ Q 38 ; 39 RIDER ; -- Personal policy riders 40 N OFFSET,START,IBI,IBL,IBPR,IBPRD 41 S START=53+$G(IBLCNT),OFFSET=2,IBL=0 42 I '$D(@VALMAR@(START-1)) D SET^IBCNSP(START-1,OFFSET," ") 43 D SET^IBCNSP(START,OFFSET," Personal Riders ",IORVON,IORVOFF) 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 45 .D SET^IBCNSP(START+IBL,OFFSET," Rider #"_IBL_": "_$$EXPAND^IBTRE(355.7,.01,IBPRD)) 46 S IBLCNT=$G(IBLCNT)+IBL 47 Q 48 ; 49 AI ; -- Add ins. verification entry 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 54 ; 55 ; -- see if current inpatient 56 D INP^VADPT I +VAIN(1) D 57 .S IBTRN=$O(^IBT(356,"AD",+VAIN(1),0)) 58 ; 59 S IBXIFN=$O(^IBE(356.11,"ACODE",85,0)) 60 ; 61 ; -- if not tracking id allow selecting 62 I '$G(IBTRN) D G:IBQUIT AIQ 63 .W !,"You can now enter a contact and relate it to a Claims Tracking Admission entry." 64 .S DIC("A")="Select RELATED ADMISSION DATE: " 65 .S DIC="^IBT(356,",DIC(0)="AEQ",D="ADFN"_DFN,DIC("S")="I $P(^(0),U,5)" 66 .D IX^DIC K DA,DR,DIC,DIE I $D(DUOUT)!($D(DTOUT)) S IBQUIT=1 Q 67 .I +Y>1 S IBTRN=+Y 68 ; 69 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.",! 70 ; 71 ; -- select date 72 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 73 I IBOK D G:IBQUIT AIQ 74 .S DIC="^IBT(356.2,",DIC("A")="Select Contact Date: " 75 .S X="??",DIC(0)="EQ",DIC("S")="I $P($G(^(1)),U,5)=IBCDFN,$P(^(0),U,4)=IBXIFN" ;,DLAYGO=356.2 76 .S D="ADFN"_DFN 77 .D IX^DIC K DIC,DR,DA,DIE,D I $D(DUOUT)!($D(DTOUT)) S IBQUIT=1 78 ; 79 S DIC="^IBT(356.2,",DIC("A")="Select Contact Date: ",DIC("B")="TODAY" 80 S DIC("DR")=".02////"_$G(IBTRN)_";.04////"_IBXIFN_";.05////"_DFN_";.19////1;1.01///NOW;1.02////"_DUZ_";1.05////"_IBCDFN 81 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 82 D ^DIC K DIC 83 I $D(DTOUT)!($D(DUOUT))!(+Y<1) G AIQ 84 S IBTRC=+Y 85 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 86 ; 87 ; -- edit ins ver type 88 D EDIT^IBTRCD1("[IBT INS VERIFICATION]",1) 89 AIQ Q
Note:
See TracChangeset
for help on using the changeset viewer.
