- IBCNSP02 ;ALB/AAS - INSURANCE MANAGEMENT - EXPANDED POLICY ; 05-MAR-1993
- ;;2.0;INTEGRATED BILLING;**582**;21-MAR-94;Build 77
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- AI ; -- Add ins. verification entry
- ; called from ai^ibcnsp1
- ;IB*582/TAZ - Insurance Contact information no longer entered here.
- G AIQ
- ;
- N X,Y,I,J,DA,DR,DIC,DIE,DR,DD,DO,VA,VAIN,VAERR,IBQUIT,IBXIFN,IBTRN,DUOUT,IBX,IBQUIT,DTOUT,IBA
- Q:'$G(DFN)
- Q:'$G(IBCDFN) S IBQUIT=0
- ;
- ; -- see if current inpatient
- ;D INP^VADPT I +VAIN(1) D
- S IBA=+$G(^DPT(DFN,.105)) I +IBA S IBTRN=$O(^IBT(356,"AD",+IBA,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),$P(^(0),U,2)=DFN,$P(^(0),U,20)"
- .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(^(0),U,5)=DFN,$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(IBTRN),$P(^IBT(356.2,+IBTRC,0),"^",2) S IBTRN=$P(^(0),"^",2)
- ;
- 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.",! K IBTRN
- ;
- 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
- ;
- AIP(IBTRC) ; -- ask if want to print a worksheet
- N DIR,DIRUT,DTOUT,DUOUT,IBW,IBCTHDR
- I '$D(IBTRN) N IBTRN S IBTRN=$P($G(^IBT(356.2,+$G(IBTRC),0)),"^",2)
- I '$D(DFN) N DFN S DFN=$P($G(^IBT(356,+$G(IBTRN),0)),"^",2)
- Q:'$G(DFN)!('$G(IBTRN))
- W ! S DIR(0)="SOBA^C:CT SUMMARY;W:WORKSHEET;B:BOTH;N:NONE"
- S DIR("A")="Print [C]T Summary [W]ork Sheet (UR) [N]one [B]oth: "
- S DIR("B")="NONE"
- S DIR("?")="You may choose print a UR work sheet, a summary from claims tracking (of this episode), both or nothing."
- D ^DIR K DIR
- S IBW=Y I "CWB"'[Y!($D(DIRUT)) G AIPQ
- S %ZIS="QM" D ^%ZIS G:POP AIPQ
- I $D(IO("Q")) S ZTRTN="AIPDQ^IBCNSP02",ZTSAVE("IB*")="",ZTSAVE("DFN")="",ZTDESC="IB - Print UR from Ins review" D ^%ZTLOAD D HOME^%ZIS G AIPQ
- U IO
- AIPDQ ; entry point from taskman
- I IBW="C"!(IBW="B") S IBCTHDR="Claims Tracking Summary" D ONE^IBTOBI W @IOF
- I IBW="W"!(IBW="B") D DQ^IBTRC4
- ;
- END I $D(ZTQUEUED) S ZTREQ="@" Q
- D ^%ZISC
- K I,J,X,Y,%ZIS,VA,IBTRND,IBTRND1,IBPAG,IBHDT,IBDISDT,IBETYP,IBQUIT,IBTAG,DIRUT,DUOUT,IBCNT,IBI,IBJ,IBNAR,IBTNOD,IBTRCD1,IBTRTP,IBDA
- D KVAR^VADPT
- AIPQ Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNSP02 3591 printed Feb 18, 2025@23:44:15 Page 2
- IBCNSP02 ;ALB/AAS - INSURANCE MANAGEMENT - EXPANDED POLICY ; 05-MAR-1993
- +1 ;;2.0;INTEGRATED BILLING;**582**;21-MAR-94;Build 77
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- AI ; -- Add ins. verification entry
- +1 ; called from ai^ibcnsp1
- +2 ;IB*582/TAZ - Insurance Contact information no longer entered here.
- +3 GOTO AIQ
- +4 ;
- +5 NEW X,Y,I,J,DA,DR,DIC,DIE,DR,DD,DO,VA,VAIN,VAERR,IBQUIT,IBXIFN,IBTRN,DUOUT,IBX,IBQUIT,DTOUT,IBA
- +6 if '$GET(DFN)
- QUIT
- +7 if '$GET(IBCDFN)
- QUIT
- SET IBQUIT=0
- +8 ;
- +9 ; -- see if current inpatient
- +10 ;D INP^VADPT I +VAIN(1) D
- +11 SET IBA=+$GET(^DPT(DFN,.105))
- IF +IBA
- SET IBTRN=$ORDER(^IBT(356,"AD",+IBA,0))
- +12 ;
- +13 SET IBXIFN=$ORDER(^IBE(356.11,"ACODE",85,0))
- +14 ;
- +15 ; -- if not tracking id allow selecting
- +16 IF '$GET(IBTRN)
- Begin DoDot:1
- +17 WRITE !,"You can now enter a contact and relate it to a Claims Tracking Admission entry."
- +18 SET DIC("A")="Select RELATED ADMISSION DATE: "
- +19 SET DIC="^IBT(356,"
- SET DIC(0)="AEQ"
- SET D="ADFN"_DFN
- SET DIC("S")="I $P(^(0),U,5),$P(^(0),U,2)=DFN,$P(^(0),U,20)"
- +20 DO IX^DIC
- KILL DA,DR,DIC,DIE
- IF $DATA(DUOUT)!($DATA(DTOUT))
- SET IBQUIT=1
- QUIT
- +21 IF +Y>1
- SET IBTRN=+Y
- End DoDot:1
- if IBQUIT
- GOTO AIQ
- +22 ;
- +23 ;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.",!
- +24 ;
- +25 ; -- select date
- +26 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
- +27 IF IBOK
- Begin DoDot:1
- +28 SET DIC="^IBT(356.2,"
- SET DIC("A")="Select Contact Date: "
- +29 ;,DLAYGO=356.2
- SET X="??"
- SET DIC(0)="EQ"
- SET DIC("S")="I $P(^(0),U,5)=DFN,$P($G(^(1)),U,5)=IBCDFN,$P(^(0),U,4)=IBXIFN"
- +30 SET D="ADFN"_DFN
- +31 DO IX^DIC
- KILL DIC,DR,DA,DIE,D
- IF $DATA(DUOUT)!($DATA(DTOUT))
- SET IBQUIT=1
- End DoDot:1
- if IBQUIT
- GOTO AIQ
- +32 ;
- +33 SET DIC="^IBT(356.2,"
- SET DIC("A")="Select Contact Date: "
- SET DIC("B")="TODAY"
- +34 SET DIC("DR")=".02////"_$GET(IBTRN)_";.04////"_IBXIFN_";.05////"_DFN_";.19////1;1.01///NOW;1.02////"_DUZ_";1.05////"_IBCDFN
- +35 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
- +36 DO ^DIC
- KILL DIC
- +37 IF $DATA(DTOUT)!($DATA(DUOUT))!(+Y<1)
- GOTO AIQ
- +38 SET IBTRC=+Y
- IF '$GET(IBTRN)
- IF $PIECE(^IBT(356.2,+IBTRC,0),"^",2)
- SET IBTRN=$PIECE(^(0),"^",2)
- +39 ;
- +40 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.",!
- KILL IBTRN
- +41 ;
- +42 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
- +43 ;
- +44 ; -- edit ins ver type
- +45 DO EDIT^IBTRCD1("[IBT INS VERIFICATION]",1)
- AIQ QUIT
- +1 ;
- AIP(IBTRC) ; -- ask if want to print a worksheet
- +1 NEW DIR,DIRUT,DTOUT,DUOUT,IBW,IBCTHDR
- +2 IF '$DATA(IBTRN)
- NEW IBTRN
- SET IBTRN=$PIECE($GET(^IBT(356.2,+$GET(IBTRC),0)),"^",2)
- +3 IF '$DATA(DFN)
- NEW DFN
- SET DFN=$PIECE($GET(^IBT(356,+$GET(IBTRN),0)),"^",2)
- +4 if '$GET(DFN)!('$GET(IBTRN))
- QUIT
- +5 WRITE !
- SET DIR(0)="SOBA^C:CT SUMMARY;W:WORKSHEET;B:BOTH;N:NONE"
- +6 SET DIR("A")="Print [C]T Summary [W]ork Sheet (UR) [N]one [B]oth: "
- +7 SET DIR("B")="NONE"
- +8 SET DIR("?")="You may choose print a UR work sheet, a summary from claims tracking (of this episode), both or nothing."
- +9 DO ^DIR
- KILL DIR
- +10 SET IBW=Y
- IF "CWB"'[Y!($DATA(DIRUT))
- GOTO AIPQ
- +11 SET %ZIS="QM"
- DO ^%ZIS
- if POP
- GOTO AIPQ
- +12 IF $DATA(IO("Q"))
- SET ZTRTN="AIPDQ^IBCNSP02"
- SET ZTSAVE("IB*")=""
- SET ZTSAVE("DFN")=""
- SET ZTDESC="IB - Print UR from Ins review"
- DO ^%ZTLOAD
- DO HOME^%ZIS
- GOTO AIPQ
- +13 USE IO
- AIPDQ ; entry point from taskman
- +1 IF IBW="C"!(IBW="B")
- SET IBCTHDR="Claims Tracking Summary"
- DO ONE^IBTOBI
- WRITE @IOF
- +2 IF IBW="W"!(IBW="B")
- DO DQ^IBTRC4
- +3 ;
- END IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- QUIT
- +1 DO ^%ZISC
- +2 KILL I,J,X,Y,%ZIS,VA,IBTRND,IBTRND1,IBPAG,IBHDT,IBDISDT,IBETYP,IBQUIT,IBTAG,DIRUT,DUOUT,IBCNT,IBI,IBJ,IBNAR,IBTNOD,IBTRCD1,IBTRTP,IBDA
- +3 DO KVAR^VADPT
- AIPQ QUIT