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 Dec 13, 2024@02:17:51 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
