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

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

initial load of WorldVistAEHR

File size: 2.9 KB
RevLine 
[613]1IBTRED1 ;ALB/AAS - CLAIMS TRACKING EDIT ; 06-JUL-93
2 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5% G ^IBTRE
6 ;
7NX(IBTMPNM) ; -- edit next template
8 N IBXX,VALMY,IBTRV,IBTRC
9 D EN^VALM(IBTMPNM)
10 I '$D(IBFASTXT) D BLD^IBTRED
11 S VALMBCK="R"
12 Q
13 ;
14EDIT(IBTEMP,BLD) ; -- edit entry point for claims tracking
15 ; -- Input IBTEMP = template name or dr string
16 ; BLD = any non-zero value if calling routine is doing own
17 ; rebuild
18 ;
19 D FULL^VALM1 W !
20 L +^IBT(356,+IBTRN):5 I '$T D LOCKED^IBTRCD1 G EDITQ
21 D SAVE
22 S DIE="^IBT(356,",DA=IBTRN
23 S DR=IBTEMP
24 D ^DIE K DA,DR,DIC,DIE
25 D COMP
26 I IBDIF=1 D UPDATE,BLD^IBTRED:'$G(BLD)
27 L -^IBT(356,+IBTRN)
28EDITQ K ^TMP($J,"IBT")
29 S VALMBCK="R"
30 Q
31 ;
32SAVE ; -- Save the global before editing
33 K ^TMP($J,"IBT")
34 S ^TMP($J,"IBT",356,IBTRN,0)=$G(^IBT(356,IBTRN,0))
35 S ^TMP($J,"IBT",356,IBTRN,1)=$G(^IBT(356,IBTRN,1))
36 Q
37 ;
38COMP ; -- Compare before editing with globals
39 S IBDIF=0
40 I $G(^IBT(356,IBTRN,0))'=$G(^TMP($J,"IBT",356,IBTRN,0)) S IBDIF=1
41 I $G(^IBT(356,IBTRN,1))'=$G(^TMP($J,"IBT",356,IBTRN,1)) S IBDIF=1
42 Q
43 ;
44UPDATE ; -- enter date and user if editing has taken place
45 ; entry locked by edit, locks not needed here
46 S DIE="^IBT(356,",DA=IBTRN
47 S DR="1.03///NOW;1.04////"_DUZ
48 D ^DIE K DA,DR,DIC,DIE
49 Q
50 ;
51DICS(Y) ; -- called by input transform and screen logic for type of diagnois
52 N IBY
53 S IBY=0
54 I Y=2 S IBY=1 G DICSQ
55 I Y=1 I '$D(^IBT(356.9,"ATP",+$P($G(^IBT(356.9,DA,0)),U,2),1))!($O(^IBT(356.9,"ATP",+$P($G(^IBT(356.9,DA,0)),U,2),1,0))=DA) S IBY=1
56 I Y=3 I '$D(^IBT(356.9,"ATP",+$P($G(^IBT(356.9,DA,0)),U,2),3))!($O(^IBT(356.9,"ATP",+$P($G(^IBT(356.9,DA,0)),U,2),3,0))=DA) S IBY=1
57 ;I Y=3 I '$D(^IBT(356.9,"ADG",+$P($G(^IBT(356.9,DA,0)),U,2),+^(0)))!($O(^IBT(356.9,"ADG",+$P($G(^IBT(356.9,DA,0)),U,2),+^(0),0))=DA) S IBY=1
58DICSQ Q IBY
59 ;
60BILLD(IBTRN) ; -- compute total amount billed and received for this visit
61 ; -- output total amount billed (minus offset) ^ total amount recieved
62 N X,Y,Z,IBY,IBZ
63 S (IBY,IBZ)=0
64 I '$G(IBTRN) G BILLDQ
65 ;
66 S (X,Y,Z)=0 F S X=$O(^IBT(356.399,"ACB",IBTRN,X)) Q:X="" D COMPUT
67 ;
68 I 'IBY,'IBZ D ;look to 399 if no ct pointer
69 .N DGPM,IBEVDT
70 .S IBEVDT=$P(^IBT(356,+IBTRN,0),"^",6)
71 .;inpatient
72 .S DGPM=$P(^IBT(356,+IBTRN,0),"^",5) I DGPM D
73 ..S (X,Y,Z)=0 F S X=$O(^DGCR(399,"D",IBEVDT,X)) Q:'X D COMPUT
74 .;
75 .;outpatient
76 .I $P($G(^IBE(356.6,+$P(^IBT(356,+IBTRN,0),"^",18),0)),"^",8)=2 D
77 ..S IBEVDT=+$P(IBEVDT,"."),DFN=$P(^IBT(356,+IBTRN,0),"^",2)
78 ..S (X,Y,Z)=0 F S X=$O(^DGCR(399,"AOPV",DFN,IBEVDT,X)) Q:'X D COMPUT
79 ..;I IBY S IBY=IBY_" (May include multiple visit dates)"
80 ;
81BILLDQ I 'IBY,$P(^IBT(356,+IBTRN,0),"^",29) S IBY=$P(^IBT(356,+IBTRN,0),"^",29)_" (Estimated)"
82 Q $G(IBY)_"^"_+$G(IBZ)
83 ;
84COMPUT ; -- add up the numbers
85 Q:$P($G(^DGCR(399,X,"S")),"^",17)
86 S Y=$P($G(^DGCR(399,X,"U1")),"^",1)-$P($G(^("U1")),"^",2)
87 I Y>0 S IBY=IBY+Y
88 S Z=$$TPR^PRCAFN(X)
89 I Z>0 S IBZ=IBZ+Y
90 Q
Note: See TracBrowser for help on using the repository browser.