Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCNSP02

IBCNSP02.m

Go to the documentation of this file.
  1. IBCNSP02 ;ALB/AAS - INSURANCE MANAGEMENT - EXPANDED POLICY ; 05-MAR-1993
  1. ;;2.0;INTEGRATED BILLING;**582**;21-MAR-94;Build 77
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. AI ; -- Add ins. verification entry
  1. ; called from ai^ibcnsp1
  1. ;IB*582/TAZ - Insurance Contact information no longer entered here.
  1. G AIQ
  1. ;
  1. N X,Y,I,J,DA,DR,DIC,DIE,DR,DD,DO,VA,VAIN,VAERR,IBQUIT,IBXIFN,IBTRN,DUOUT,IBX,IBQUIT,DTOUT,IBA
  1. Q:'$G(DFN)
  1. Q:'$G(IBCDFN) S IBQUIT=0
  1. ;
  1. ; -- see if current inpatient
  1. ;D INP^VADPT I +VAIN(1) D
  1. S IBA=+$G(^DPT(DFN,.105)) I +IBA S IBTRN=$O(^IBT(356,"AD",+IBA,0))
  1. ;
  1. S IBXIFN=$O(^IBE(356.11,"ACODE",85,0))
  1. ;
  1. ; -- if not tracking id allow selecting
  1. I '$G(IBTRN) D G:IBQUIT AIQ
  1. .W !,"You can now enter a contact and relate it to a Claims Tracking Admission entry."
  1. .S DIC("A")="Select RELATED ADMISSION DATE: "
  1. .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)"
  1. .D IX^DIC K DA,DR,DIC,DIE I $D(DUOUT)!($D(DTOUT)) S IBQUIT=1 Q
  1. .I +Y>1 S IBTRN=+Y
  1. ;
  1. ;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.",!
  1. ;
  1. ; -- select date
  1. 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
  1. I IBOK D G:IBQUIT AIQ
  1. .S DIC="^IBT(356.2,",DIC("A")="Select Contact Date: "
  1. .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
  1. .S D="ADFN"_DFN
  1. .D IX^DIC K DIC,DR,DA,DIE,D I $D(DUOUT)!($D(DTOUT)) S IBQUIT=1
  1. ;
  1. S DIC="^IBT(356.2,",DIC("A")="Select Contact Date: ",DIC("B")="TODAY"
  1. S DIC("DR")=".02////"_$G(IBTRN)_";.04////"_IBXIFN_";.05////"_DFN_";.19////1;1.01///NOW;1.02////"_DUZ_";1.05////"_IBCDFN
  1. 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
  1. D ^DIC K DIC
  1. I $D(DTOUT)!($D(DUOUT))!(+Y<1) G AIQ
  1. S IBTRC=+Y I '$G(IBTRN),$P(^IBT(356.2,+IBTRC,0),"^",2) S IBTRN=$P(^(0),"^",2)
  1. ;
  1. 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
  1. ;
  1. 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
  1. ;
  1. ; -- edit ins ver type
  1. D EDIT^IBTRCD1("[IBT INS VERIFICATION]",1)
  1. AIQ Q
  1. ;
  1. AIP(IBTRC) ; -- ask if want to print a worksheet
  1. N DIR,DIRUT,DTOUT,DUOUT,IBW,IBCTHDR
  1. I '$D(IBTRN) N IBTRN S IBTRN=$P($G(^IBT(356.2,+$G(IBTRC),0)),"^",2)
  1. I '$D(DFN) N DFN S DFN=$P($G(^IBT(356,+$G(IBTRN),0)),"^",2)
  1. Q:'$G(DFN)!('$G(IBTRN))
  1. W ! S DIR(0)="SOBA^C:CT SUMMARY;W:WORKSHEET;B:BOTH;N:NONE"
  1. S DIR("A")="Print [C]T Summary [W]ork Sheet (UR) [N]one [B]oth: "
  1. S DIR("B")="NONE"
  1. S DIR("?")="You may choose print a UR work sheet, a summary from claims tracking (of this episode), both or nothing."
  1. D ^DIR K DIR
  1. S IBW=Y I "CWB"'[Y!($D(DIRUT)) G AIPQ
  1. S %ZIS="QM" D ^%ZIS G:POP AIPQ
  1. 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
  1. U IO
  1. AIPDQ ; entry point from taskman
  1. I IBW="C"!(IBW="B") S IBCTHDR="Claims Tracking Summary" D ONE^IBTOBI W @IOF
  1. I IBW="W"!(IBW="B") D DQ^IBTRC4
  1. ;
  1. END I $D(ZTQUEUED) S ZTREQ="@" Q
  1. D ^%ZISC
  1. 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
  1. D KVAR^VADPT
  1. AIPQ Q