source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNSP02.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.4 KB
Line 
1IBCNSP02 ;ALB/AAS - INSURANCE MANAGEMENT - EXPANDED POLICY ; 05-MAR-1993
2 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5AI ; -- Add ins. verification entry
6 ; called from ai^ibcnsp1
7 N X,Y,I,J,DA,DR,DIC,DIE,DR,DD,DO,VA,VAIN,VAERR,IBQUIT,IBXIFN,IBTRN,DUOUT,IBX,IBQUIT,DTOUT,IBA
8 Q:'$G(DFN)
9 Q:'$G(IBCDFN) S IBQUIT=0
10 ;
11 ; -- see if current inpatient
12 ;D INP^VADPT I +VAIN(1) D
13 S IBA=+$G(^DPT(DFN,.105)) I +IBA S IBTRN=$O(^IBT(356,"AD",+IBA,0))
14 ;
15 S IBXIFN=$O(^IBE(356.11,"ACODE",85,0))
16 ;
17 ; -- if not tracking id allow selecting
18 I '$G(IBTRN) D G:IBQUIT AIQ
19 .W !,"You can now enter a contact and relate it to a Claims Tracking Admission entry."
20 .S DIC("A")="Select RELATED ADMISSION DATE: "
21 .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)"
22 .D IX^DIC K DA,DR,DIC,DIE I $D(DUOUT)!($D(DTOUT)) S IBQUIT=1 Q
23 .I +Y>1 S IBTRN=+Y
24 ;
25 ;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.",!
26 ;
27 ; -- select date
28 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
29 I IBOK D G:IBQUIT AIQ
30 .S DIC="^IBT(356.2,",DIC("A")="Select Contact Date: "
31 .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
32 .S D="ADFN"_DFN
33 .D IX^DIC K DIC,DR,DA,DIE,D I $D(DUOUT)!($D(DTOUT)) S IBQUIT=1
34 ;
35 S DIC="^IBT(356.2,",DIC("A")="Select Contact Date: ",DIC("B")="TODAY"
36 S DIC("DR")=".02////"_$G(IBTRN)_";.04////"_IBXIFN_";.05////"_DFN_";.19////1;1.01///NOW;1.02////"_DUZ_";1.05////"_IBCDFN
37 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
38 D ^DIC K DIC
39 I $D(DTOUT)!($D(DUOUT))!(+Y<1) G AIQ
40 S IBTRC=+Y I '$G(IBTRN),$P(^IBT(356.2,+IBTRC,0),"^",2) S IBTRN=$P(^(0),"^",2)
41 ;
42 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
43 ;
44 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
45 ;
46 ; -- edit ins ver type
47 D EDIT^IBTRCD1("[IBT INS VERIFICATION]",1)
48AIQ Q
49 ;
50AIP(IBTRC) ; -- ask if want to print a worksheet
51 N DIR,DIRUT,DTOUT,DUOUT,IBW,IBCTHDR
52 I '$D(IBTRN) N IBTRN S IBTRN=$P($G(^IBT(356.2,+$G(IBTRC),0)),"^",2)
53 I '$D(DFN) N DFN S DFN=$P($G(^IBT(356,+$G(IBTRN),0)),"^",2)
54 Q:'$G(DFN)!('$G(IBTRN))
55 W ! S DIR(0)="SOBA^C:CT SUMMARY;W:WORKSHEET;B:BOTH;N:NONE"
56 S DIR("A")="Print [C]T Summary [W]ork Sheet (UR) [N]one [B]oth: "
57 S DIR("B")="NONE"
58 S DIR("?")="You may choose print a UR work sheet, a summary from claims tracking (of this episode), both or nothing."
59 D ^DIR K DIR
60 S IBW=Y I "CWB"'[Y!($D(DIRUT)) G AIPQ
61 S %ZIS="QM" D ^%ZIS G:POP AIPQ
62 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
63 U IO
64AIPDQ ; entry point from taskman
65 I IBW="C"!(IBW="B") S IBCTHDR="Claims Tracking Summary" D ONE^IBTOBI W @IOF
66 I IBW="W"!(IBW="B") D DQ^IBTRC4
67 ;
68END I $D(ZTQUEUED) S ZTREQ="@" Q
69 D ^%ZISC
70 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
71 D KVAR^VADPT
72AIPQ Q
Note: See TracBrowser for help on using the repository browser.