- IBCNSP01 ;ALB/AAS - INSURANCE MANAGEMENT - EXPANDED POLICY ; 05-MAR-1993
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- ;
- % D SUBSC,VER,RIDER
- Q
- ;
- SUBSC ; -- subscriber region
- N OFFSET,START
- S START=15,OFFSET=2
- D SET^IBCNSP(START,OFFSET," Subscriber Information ",IORVON,IORVOFF)
- S Y=$P(IBCDFND,"^",6),C=$P(^DD(2.312,6,0),"^",2) D Y^DIQ
- D SET^IBCNSP(START+1,OFFSET," Whose Insurance: "_Y)
- D SET^IBCNSP(START+2,OFFSET," Subscriber Name: "_$P(IBCDFND,"^",17))
- S Y=$P(IBCDFND,"^",16),C=$P(^DD(2.312,16,0),"^",2) D Y^DIQ
- D SET^IBCNSP(START+3,OFFSET," Relationship: "_Y)
- D SET^IBCNSP(START+4,OFFSET,"Insurance Number: "_$P(IBCDFND,"^",2))
- S Y=$P(IBCDFND,"^",20),C=$P(^DD(2.312,.2,0),"^",2) D Y^DIQ
- D SET^IBCNSP(START+5,OFFSET,"Coord. Benefits: "_Y)
- Q
- ;
- VER ; -- Entered/Verfied Region
- N OFFSET,START
- S START=22,OFFSET=2
- D SET^IBCNSP(START,OFFSET," User Information ",IORVON,IORVOFF)
- I IBCDFND1="" D SET^IBCNSP(START+1,OFFSET,"No User Information") G VERQ
- D SET^IBCNSP(START+1,OFFSET," Entered By: "_$E($P($G(^VA(200,+$P(IBCDFND1,"^",2),0)),"^",1),1,20))
- D SET^IBCNSP(START+2,OFFSET," Entered On: "_$$DAT1^IBOUTL(+IBCDFND1))
- D SET^IBCNSP(START+3,OFFSET,"Last Verified By: "_$E($P($G(^VA(200,+$P(IBCDFND1,"^",4),0)),"^",1),1,20))
- D SET^IBCNSP(START+4,OFFSET,"Last Verified On: "_$$DAT1^IBOUTL(+$P(IBCDFND1,"^",3)))
- D SET^IBCNSP(START+5,OFFSET," Last Updated By: "_$E($P($G(^VA(200,+$P(IBCDFND1,"^",6),0)),"^",1),1,20))
- D SET^IBCNSP(START+6,OFFSET," Last Updated On: "_$$DAT1^IBOUTL(+$P(IBCDFND1,"^",5)))
- VERQ Q
- ;
- RIDER ; -- Personal policy riders
- N OFFSET,START,IBI,IBL
- S START=34+$G(IBLCNT),OFFSET=2
- D SET^IBCNSP(START,OFFSET," Personal Riders ",IORVON,IORVOFF)
- 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)) D
- .S IBL=$G(IBL)+1
- .D SET^IBCNSP(START+IBL,OFFSET," Rider #"_IBL_": "_$$EXPAND^IBTRE(355.7,.01,IBPRD))
- Q
- ;
- AI ; -- Add ins. verification entry
- ; called from ai^ibcnsp1
- ;N X,Y,I,J,DA,DR,DIC,DIE,DR,DD,DO,VA,VAIN,VAERR,IBQUIT,IBXIFN,IBTRN,DUOUT,IBX,IBQUIT,DTOUT
- ;Q:'$G(DFN)
- ;Q:'$G(IBCDFN) S IBQUIT=0
- ;
- ; -- see if current inpatient
- D INP^VADPT I +VAIN(1) D
- .S IBTRN=$O(^IBT(356,"AD",+VAIN(1),0))
- ;
- S IBXIFN=$O(^IBE(356.11,"ACODE",85,0))
- ;
- ; -- if not tracking id allow selecting
- I '$G(IBTRN) D G:IBQUIT AIQ
- .W !,"You can now enter a contact and relate it to a Claims Tracking Admission entry."
- .S DIC("A")="Select RELATED ADMISSION DATE: "
- .S DIC="^IBT(356,",DIC(0)="AEQ",D="ADFN"_DFN,DIC("S")="I $P(^(0),U,5)"
- .D IX^DIC K DA,DR,DIC,DIE I $D(DUOUT)!($D(DTOUT)) S IBQUIT=1 Q
- .I +Y>1 S IBTRN=+Y
- ;
- 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.",!
- ;
- ; -- select date
- 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
- I IBOK D G:IBQUIT AIQ
- .S DIC="^IBT(356.2,",DIC("A")="Select Contact Date: "
- .S X="??",DIC(0)="EQ",DIC("S")="I $P($G(^(1)),U,5)=IBCDFN,$P(^(0),U,4)=IBXIFN" ;,DLAYGO=356.2
- .S D="ADFN"_DFN
- .D IX^DIC K DIC,DR,DA,DIE,D I $D(DUOUT)!($D(DTOUT)) S IBQUIT=1
- ;
- S DIC="^IBT(356.2,",DIC("A")="Select Contact Date: ",DIC("B")="TODAY"
- S DIC("DR")=".02////"_$G(IBTRN)_";.04////"_IBXIFN_";.05////"_DFN_";.19////1;1.01///NOW;1.02////"_DUZ_";1.05////"_IBCDFN
- 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
- D ^DIC K DIC
- I $D(DTOUT)!($D(DUOUT))!(+Y<1) G AIQ
- S IBTRC=+Y
- 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
- ;
- ; -- edit ins ver type
- D EDIT^IBTRCD1("[IBT INS VERIFICATION]",1)
- AIQ Q
- IBCNSP01 ;ALB/AAS - INSURANCE MANAGEMENT - EXPANDED POLICY ; 05-MAR-1993
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- +4 ;
- % DO SUBSC
- DO VER
- DO RIDER
- +1 QUIT
- +2 ;
- SUBSC ; -- subscriber region
- +1 NEW OFFSET,START
- +2 SET START=15
- SET OFFSET=2
- +3 DO SET^IBCNSP(START,OFFSET," Subscriber Information ",IORVON,IORVOFF)
- +4 SET Y=$PIECE(IBCDFND,"^",6)
- SET C=$PIECE(^DD(2.312,6,0),"^",2)
- DO Y^DIQ
- +5 DO SET^IBCNSP(START+1,OFFSET," Whose Insurance: "_Y)
- +6 DO SET^IBCNSP(START+2,OFFSET," Subscriber Name: "_$PIECE(IBCDFND,"^",17))
- +7 SET Y=$PIECE(IBCDFND,"^",16)
- SET C=$PIECE(^DD(2.312,16,0),"^",2)
- DO Y^DIQ
- +8 DO SET^IBCNSP(START+3,OFFSET," Relationship: "_Y)
- +9 DO SET^IBCNSP(START+4,OFFSET,"Insurance Number: "_$PIECE(IBCDFND,"^",2))
- +10 SET Y=$PIECE(IBCDFND,"^",20)
- SET C=$PIECE(^DD(2.312,.2,0),"^",2)
- DO Y^DIQ
- +11 DO SET^IBCNSP(START+5,OFFSET,"Coord. Benefits: "_Y)
- +12 QUIT
- +13 ;
- VER ; -- Entered/Verfied Region
- +1 NEW OFFSET,START
- +2 SET START=22
- SET OFFSET=2
- +3 DO SET^IBCNSP(START,OFFSET," User Information ",IORVON,IORVOFF)
- +4 IF IBCDFND1=""
- DO SET^IBCNSP(START+1,OFFSET,"No User Information")
- GOTO VERQ
- +5 DO SET^IBCNSP(START+1,OFFSET," Entered By: "_$EXTRACT($PIECE($GET(^VA(200,+$PIECE(IBCDFND1,"^",2),0)),"^",1),1,20))
- +6 DO SET^IBCNSP(START+2,OFFSET," Entered On: "_$$DAT1^IBOUTL(+IBCDFND1))
- +7 DO SET^IBCNSP(START+3,OFFSET,"Last Verified By: "_$EXTRACT($PIECE($GET(^VA(200,+$PIECE(IBCDFND1,"^",4),0)),"^",1),1,20))
- +8 DO SET^IBCNSP(START+4,OFFSET,"Last Verified On: "_$$DAT1^IBOUTL(+$PIECE(IBCDFND1,"^",3)))
- +9 DO SET^IBCNSP(START+5,OFFSET," Last Updated By: "_$EXTRACT($PIECE($GET(^VA(200,+$PIECE(IBCDFND1,"^",6),0)),"^",1),1,20))
- +10 DO SET^IBCNSP(START+6,OFFSET," Last Updated On: "_$$DAT1^IBOUTL(+$PIECE(IBCDFND1,"^",5)))
- VERQ QUIT
- +1 ;
- RIDER ; -- Personal policy riders
- +1 NEW OFFSET,START,IBI,IBL
- +2 SET START=34+$GET(IBLCNT)
- SET OFFSET=2
- +3 DO SET^IBCNSP(START,OFFSET," Personal Riders ",IORVON,IORVOFF)
- +4 SET IBI=""
- FOR
- SET IBI=$ORDER(^IBA(355.7,"APP",DFN,IBCDFN,IBI))
- IF 'IBI
- QUIT
- SET IBPR=$ORDER(^(IBI,0))
- SET IBPRD=+$GET(^IBA(355.7,IBPR,0))
- Begin DoDot:1
- +5 SET IBL=$GET(IBL)+1
- +6 DO SET^IBCNSP(START+IBL,OFFSET," Rider #"_IBL_": "_$$EXPAND^IBTRE(355.7,.01,IBPRD))
- End DoDot:1
- +7 QUIT
- +8 ;
- AI ; -- Add ins. verification entry
- +1 ; called from ai^ibcnsp1
- +2 ;N X,Y,I,J,DA,DR,DIC,DIE,DR,DD,DO,VA,VAIN,VAERR,IBQUIT,IBXIFN,IBTRN,DUOUT,IBX,IBQUIT,DTOUT
- +3 ;Q:'$G(DFN)
- +4 ;Q:'$G(IBCDFN) S IBQUIT=0
- +5 ;
- +6 ; -- see if current inpatient
- +7 DO INP^VADPT
- IF +VAIN(1)
- Begin DoDot:1
- +8 SET IBTRN=$ORDER(^IBT(356,"AD",+VAIN(1),0))
- End DoDot:1
- +9 ;
- +10 SET IBXIFN=$ORDER(^IBE(356.11,"ACODE",85,0))
- +11 ;
- +12 ; -- if not tracking id allow selecting
- +13 IF '$GET(IBTRN)
- Begin DoDot:1
- +14 WRITE !,"You can now enter a contact and relate it to a Claims Tracking Admission entry."
- +15 SET DIC("A")="Select RELATED ADMISSION DATE: "
- +16 SET DIC="^IBT(356,"
- SET DIC(0)="AEQ"
- SET D="ADFN"_DFN
- SET DIC("S")="I $P(^(0),U,5)"
- +17 DO IX^DIC
- KILL DA,DR,DIC,DIE
- IF $DATA(DUOUT)!($DATA(DTOUT))
- SET IBQUIT=1
- QUIT
- +18 IF +Y>1
- SET IBTRN=+Y
- End DoDot:1
- IF IBQUIT
- GOTO AIQ
- +19 ;
- +20 IF '$GET(IBTRN)
- WRITE !!,"Warning: This contact is not associated with any care in Claims Tracking.",!,"You may only edit or view this contact using this action.",!
- +21 ;
- +22 ; -- select date
- +23 SET IBOK=0
- SET IBI=0
- FOR
- SET IBI=$ORDER(^IBT(356.2,"D",DFN,IBI))
- IF 'IBI
- QUIT
- IF $PIECE($GET(^IBT(356.2,+IBI,0)),"^",4)=IBXIFN
- IF $PIECE($GET(^(1)),"^",5)=IBCDFN
- SET IBOK=1
- +24 IF IBOK
- Begin DoDot:1
- +25 SET DIC="^IBT(356.2,"
- SET DIC("A")="Select Contact Date: "
- +26 ;,DLAYGO=356.2
- SET X="??"
- SET DIC(0)="EQ"
- SET DIC("S")="I $P($G(^(1)),U,5)=IBCDFN,$P(^(0),U,4)=IBXIFN"
- +27 SET D="ADFN"_DFN
- +28 DO IX^DIC
- KILL DIC,DR,DA,DIE,D
- IF $DATA(DUOUT)!($DATA(DTOUT))
- SET IBQUIT=1
- End DoDot:1
- IF IBQUIT
- GOTO AIQ
- +29 ;
- +30 SET DIC="^IBT(356.2,"
- SET DIC("A")="Select Contact Date: "
- SET DIC("B")="TODAY"
- +31 SET DIC("DR")=".02////"_$GET(IBTRN)_";.04////"_IBXIFN_";.05////"_DFN_";.19////1;1.01///NOW;1.02////"_DUZ_";1.05////"_IBCDFN
- +32 SET DIC(0)="AEQL"
- SET DIC("S")="I $P(^(0),U,5)=DFN,$P($G(^(1)),U,5)=IBCDFN,$P(^(0),U,4)=IBXIFN"
- SET DLAYGO=356.2
- +33 DO ^DIC
- KILL DIC
- +34 IF $DATA(DTOUT)!($DATA(DUOUT))!(+Y<1)
- GOTO AIQ
- +35 SET IBTRC=+Y
- +36 IF $GET(IBTRC)
- IF $GET(IBTRN)
- IF '$PIECE(^IBT(356.2,+IBTRC,0),"^",2)
- SET DA=IBTRC
- SET DIE="^IBT(356.2,"
- SET DR=".02////"_$GET(IBTRN)
- DO ^DIE
- +37 ;
- +38 ; -- edit ins ver type
- +39 DO EDIT^IBTRCD1("[IBT INS VERIFICATION]",1)
- AIQ QUIT
