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

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

initial load of WorldVistAEHR
File size: 3.6 KB
RevLine 
[613]1IBTRC3 ;ALB/AAS - CLAIMS TRAINING INS. REV DEFAULTS ; 29-SEP-93
2 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5LAST(IBTRN,IBTRC) ; -- return last insurance review
6 ; -- Input IBTRN = claims tracking id
7 ; IBTRC = ins. review being edited (option)
8 ; (if hip is defined for ibtrc will use last review
9 ; for that policy)
10 ;
11 N X,Y,IBHIP,IBQUIT
12 S Y="",IBQUIT=0
13 I '$G(IBTRN) G LASTQ
14 S IBHIP=$P($G(^IBT(356.2,+$G(IBTRC),1)),"^",5)
15 S X=-$G(^IBT(356.2,+IBTRC,0)) F S X=$O(^IBT(356.2,"ATIDT",IBTRN,X)) Q:'X!(IBQUIT) D
16 .S Y="" F S Y=$O(^IBT(356.2,"ATIDT",IBTRN,X,Y)) Q:'Y!('IBHIP) D Q:IBQUIT
17 ..I $P($G(^IBT(356.2,+Y,1)),"^",5)=IBHIP S IBQUIT=1 Q
18LASTQ Q $S(+Y<1:"",Y:Y,1:"")
19 ;
20HIP(IBTRC) ; -- compute default health insurance policy for claims tracking
21 ; -- called by trigger on patient field (.05) of file 356.2
22 ; -- output pointer to subfile (2.312)^insurnace co name
23 N X,IBDD,IBINDT,DFN
24 S X=""
25 S DFN=$P($G(^IBT(356.2,+$G(IBTRC),0)),"^",5)
26 G:'DFN HIPQ
27 S IBINDT=$S($P($G(^IBT(356,+$P($G(^IBT(356.2,+IBTRC,0)),U,2),0)),U,6):$P(^(0),U,6),1:DT)
28 D ALL^IBCNS1(DFN,"IBDD",1,IBINDT)
29 I $G(IBDD(0))=1 S X=+$O(IBDD(0))
30 ;
31 ; -- if more than one look for primary
32 I 'X,$G(IBDD(0))>1 D
33 .S IBX=0
34 .F S IBX=$O(IBDD(IBX)) Q:'IBX I $P($G(IBDD(IBX,0)),"^",20)=1 S X=IBX Q
35 I X S X=X_"^"_$P($G(^DIC(36,+$G(IBDD(X,0)),0)),"^")
36HIPQ Q X
37 ;
38HIPD(DA,IBTLST) ; -- compute default health insurance policy from last review
39 ; -- called from input templates
40 ; input da = current entry being edited
41 ; ibtlst = last entry for this review as determine by $$LAST
42 ;
43 N X,DFN
44 S X="" I $P($G(^IBT(356.2,DA,1)),"^",5) G HIPDQ
45 G:'$G(IBTLST) HIPDQ
46 S X=$P($G(^IBT(356.2,+IBTLST,1)),"^",5),DFN=$P(^(0),"^",5)
47HIPDQ Q $S(+X<1:"",1:$P($G(^DIC(36,+$G(^DPT(DFN,.312,X,0)),0)),"^",1))
48 ;
49PC(DA,IBTLST) ; -- compute default person contacted from last review
50 ; -- called from input templates
51 ; input da = current entry being edited
52 ; ibtlst = last entry for this review as determine by $$LAST
53 ;
54 Q $P($G(^IBT(356.2,+$G(IBTLST),0)),"^",6)
55 ;
56MC(DA,IBTLST) ; -- compute default method of contact from last review
57 ; -- called from input templates
58 ; input da = current entry being edited
59 ;
60 ; ibtlst = last entry for this review as determine by $$LAST
61 ;
62 N X
63 S X=$P($G(^IBT(356.2,+$G(IBTLST),0)),"^",17)
64 Q $S(+X>0:$$EXPAND^IBTRE(356.2,.17,X),1:"PHONE")
65 ;
66CP(DA,IBTLST) ; -- compute default contact phone number from last review
67 ; -- called from input templates
68 ; input da = current entry being edited
69 ; ibtlst = last entry for this review as determine by $$LAST
70 ;
71 Q $P($G(^IBT(356.2,+$G(IBTLST),0)),"^",7)
72 ;
73AN(DA,IBTLST) ; -- compute default authorization number policy
74 ; -- called from input templates
75 ; input da = current entry being edited
76 ; ibtlst = last entry for this review as determine by $$LAST
77 N X
78 S X=$P(^IBT(356.2,DA,0),"^",9)
79 Q $E($S($L(X):X,1:$P($G(^IBT(356.2,+$G(IBTLST),0)),"^",28)),1,10)
80 ;
81APPEAL ; -- called from IBTRC, needed more room to compute
82 ; info if an appeal
83 N DAYS S DAYS=""
84 S X=$$SETFLD^VALM1($$EXPAND^IBTRE(356.2,.29,$P(IBTRCD,"^",29)),X,"ACTION")
85 S DAYS=$P(IBTRCD,"^",25) I $P(IBTRCD,"^",29)=1,$P(IBTRCD,"^",10)=3,$O(^IBT(356.2,+IBTRC,14,0)) S DAYS=$$AP^IBTODD1(IBTRC)
86 S X=$$SETFLD^VALM1($J(DAYS,3),X,"DAYS")
87 S X=$$SETFLD^VALM1($$TPE(),X,"TYPE")
88 Q
89 ;
90TPE() ; -- add appeal type to type of action
91 N X
92 S X=$P(IBETYP,"^",3)
93 I $P(IBTRCD,"^",23) S X=X_"-"_$S($P(IBTRCD,"^",23)=1:"Clin",$P(IBTRCD,"^",23)=2:"Admin",1:"")
94 Q X
Note: See TracBrowser for help on using the repository browser.