source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBTRCD1.m@ 1638

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

initial load of WorldVistAEHR
File size: 4.8 KB
RevLine 
[613]1IBTRCD1 ;ALB/AAS/BGA - CLAIMS TRACKING INS ACTION EDIT ; 11/8/06 9:34am
2 ;;2.0;INTEGRATED BILLING;**10,359**;21-MAR-94;Build 9
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5% G ^IBTRC
6 ;
7QE ; -- Quick edit
8 N IBXX,VALMY,DA,DR,DIC,DIE
9 D QE1^IBTRC1
10 D BLD^IBTRCD
11 S VALMBCK="R"
12 Q
13 ;
14NX(IBTMPNM,BLD) ; -- edit next template
15 N IBXX,VALMY
16 D EN^VALM(IBTMPNM)
17 I '$D(IBFASTXT) D:'$G(BLD) BLD^IBTRCD
18 I IBTMPNM="IBCNS VIEW PAT INS" D:$G(BLD)=1 BLD^IBTRE ;REBUILD LIST
19 S VALMBCK="R"
20 Q
21 ;
22EDIT(DR,BLD) ; -- edit entry point for claims tracking reviews
23 ; -- Input IBTEMP = template name or dr string
24 ; BLD = any non-zero value if calling routine is doing own
25 ; rebuild
26 ;
27 N IBDIF,DA,DIC,DIE,DIR,X,Y,IBTLST
28 D FULL^VALM1 W !
29 D SAVE
30 S DIE="^IBT(356.2,",DA=IBTRC
31 L +^IBT(356.2,+IBTRC):5 I '$T D LOCKED G EDITQ
32 D ^DIE K DA,DR,DIC,DIE
33 I '$D(IBCON) D CON K IBCON
34 D COMP
35 I IBDIF=1 D UPDATE
36 L -^IBT(356.2,+IBTRC)
37 D BLD^IBTRCD:'$G(BLD)
38EDITQ K ^TMP($J,"IBT")
39 S VALMBCK="R"
40 Q
41 ;
42SAVE ; -- Save the global before editing
43 K ^TMP($J,"IBT")
44 S ^TMP($J,"IBT",356.2,IBTRC,0)=$G(^IBT(356.2,IBTRC,0))
45 S ^TMP($J,"IBT",356.2,IBTRC,1)=$G(^IBT(356.2,IBTRC,1))
46 S ^TMP($J,"IBT",356.2,IBTRC,11,0)=$G(^IBT(356.2,IBTRC,11,0))
47 S ^TMP($J,"IBT",356.2,IBTRC,12,0)=$G(^IBT(356.2,IBTRC,12,0))
48 S ^TMP($J,"IBT",356.2,IBTRC,13,0)=$G(^IBT(356.2,IBTRC,13,0))
49 Q
50 ;
51COMP ; -- Compare before editing with globals
52 S IBDIF=0
53 I $G(^IBT(356.2,IBTRC,0))'=$G(^TMP($J,"IBT",356.2,IBTRC,0)) S IBDIF=1 Q
54 I $G(^IBT(356.2,IBTRC,1))'=$G(^TMP($J,"IBT",356.2,IBTRC,1)) S IBDIF=1 Q
55 I $G(^IBT(356.2,IBTRC,11,0))'=$G(^TMP($J,"IBT",356.2,IBTRC,11,0)) S IBDIF=1 Q
56 I $G(^IBT(356.2,IBTRC,12,0))'=$G(^TMP($J,"IBT",356.2,IBTRC,12,0)) S IBDIF=1 Q
57 I $G(^IBT(356.2,IBTRC,13,0))'=$G(^TMP($J,"IBT",356.2,IBTRC,13,0)) S IBDIF=1 Q
58 Q
59 ;
60UPDATE ; -- enter date and user if editing has taken place
61 ; entry locked during edit lock not needed here
62 S DIE="^IBT(356.2,",DA=IBTRC
63 S DR="1.03///NOW;1.04////"_DUZ
64 D ^DIE K DA,DR,DIC,DIE
65 Q
66 ;
67LOCKED ; -- write locked message
68 Q:$D(ZTQUEUED)
69 W !!,"Sorry, another user currently editing this entry."
70 W !,"Try again later."
71 D PAUSE^VALM1
72 Q
73 ;
74CON ; -- consistency checker for insurance reviews
75 N I,J,X,Y,DA,DR,DIC,DIE,IBI,IBDEL,IBACTION
76 S IBCON=1 Q:'$D(^IBT(356.2,IBTRC,0))
77 S IBACTION=$P($G(^IBE(356.7,+$P(^IBT(356.2,IBTRC,0),"^",11),0)),"^",3)
78 I $G(IBACTION)="" S IBACTION=99
79 ;
80 ; -- if action and type the same okay, check nxt rv. dates
81 I $P($G(^IBT(356.2,IBTRC,0)),"^",4)=$P($G(^TMP($J,"IBT",356.2,IBTRC,0)),"^",4),$P($G(^IBT(356.2,IBTRC,0)),"^",11)=$P($G(^TMP($J,"IBT",356.2,IBTRC,0)),"^",11) G NXRV
82 ;
83 ; -- if action different
84 I $P($G(^TMP($J,"IBT",356.2,IBTRC,0)),"^",11)="" Q ; no previous action
85 I $P($G(^IBT(356.2,IBTRC,0)),"^",11)'=$P($G(^TMP($J,"IBT",356.2,IBTRC,0)),"^",11) D
86 .S DR=$P($T(@(IBACTION)),";;",2,99)
87 .I DR'="" D EDIT(DR,1)
88 .I IBACTION'=10 S $P(^IBT(356.2,IBTRC,0),"^",12,13)="^"
89 .I IBACTION'=20 S $P(^IBT(356.2,IBTRC,0),"^",15,16)="^"
90 .W !,"WARNING: I detected you changed the Action on this review and deleted",!,"data associated with the previous action." H 3
91 .Q
92 ; -- if not denial and denial reasons delete
93 I $O(^IBT(356.2,IBTRC,12,0)),$G(IBACTION)'=20 D
94 .S IBI=0 F S IBI=$O(^IBT(356.2,IBTRC,12,IBI)) Q:'IBI S DA=IBI,DA(1)=IBTRC,DIK="^IBT(356.2,"_IBTRC_",12," D ^DIK
95 ;
96 ; -- if not penalty and penalty reasons delete
97 I $O(^IBT(356.2,IBTRC,13,0)),$G(IBACTION)'=30 D
98 .S IBI=0 F S IBI=$O(^IBT(356.2,IBTRC,13,IBI)) Q:'IBI S DA=IBI,DA(1)=IBTRC,DIK="^IBT(356.2,"_IBTRC_",13," D ^DIK
99 .Q
100 ;
101NXRV ; -- check Next Review Dates
102 N IBI0,IBIX
103 I '$D(IBTRN) N IBTRN S IBTRN=$P($G(^IBT(356.2,+$G(IBTRC),0)),"^",2)
104 Q:'$G(IBTRN)
105 S IBI=0 F S IBI=$O(^IBT(356.2,"C",IBTRN,IBI)) Q:'IBI D
106 .I $P($G(^IBT(356.2,IBI,0)),"^",24) D
107 ..S IBI0=$G(^(0))
108 ..S IBI(IBI)=$$DAT1^IBOUTL($P(IBI0,U,24))_"^"_$P($G(^DIC(36,+$P(IBI0,U,8),0)),U,1)_"^"_$P($G(^IBE(356.11,+$P(IBI0,U,4),0)),U,3)
109 ..Q
110 .Q
111 I $O(IBI(0)) D ASKDEL I IBDEL D
112 .I $P(^IBT(356.2,IBTRC,0),U,24)!$O(IBI(+$O(IBI(0)))) D
113 ..W !!,?3,"WARNING: This patient has the following multiple Next Review Dates: "
114 ..W !!!,?5,"REVIEW",?18,"INSURANCE COMPANY",?45,"TYPE OF CONTACT",?65,"NEXT REV. DATE"
115 ..W !,?5,$TR($J(" ",IOM-5)," ","=")
116 ..S IBIX=0 F S IBIX=$O(IBI(IBIX)) Q:'IBIX D
117 ...W !,?5,$$DAT1^IBOUTL(+^IBT(356.2,IBIX,0)),?18,$E($P(IBI(IBIX),U,2),1,23),?45,$P(IBI(IBIX),U,3),?65,$P(IBI(IBIX),U,1)
118 ...Q
119 ..W !,?5,$TR($J(" ",IOM-5)," ","=") S DIR("A")="Press RETURN to continue" D PAUSE^IBOUTL Q
120 Q
121 ;
122ASKDEL ; -- ask if okay to delete next review dates
123 S IBDEL=1
124 Q
125 ;
12610 ;;1.07///@;.2///@;.21///@
12720 ;;.14///@;1.08///@;.2///@;21///@;.28///@
12830 ;;.14///@;1.07///@;1.08///@;.2///@;21///@;.28///@
12940 ;;.14///@;1.07///@;1.08///@;21///@;.28///@
13050 ;;.14///@;1.07///@;1.08///@;.2///@;.28///@
13199 ;;.14///@;1.07///@;1.08///@;.2///@;21///@;.28///@
Note: See TracBrowser for help on using the repository browser.