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

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

initial load of WorldVistAEHR

File size: 5.5 KB
Line 
1IBYPPM ;ALB/CXW,TJH - IB*2*333 POST INIT: ADD TORT/INTERAGENCY RATES NOV 2005 ; 11/23/05
2 ;;2.0;INTEGRATED BILLING;**333**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;
6 ; Add OCT 2005 Tort and Interagency Charges to the Charge Master, 61 Charge Items
7 Q
8POST ;
9 N IBA,IBEFFDT
10 S IBA(1)="",IBA(2)=" IB*2*333 Post-Install .....",IBA(3)="" D MES^XPDUTL(.IBA) K IBA
11 S IBEFFDT=3051103 ; effective date of Tort Nov 03, 2005
12 D ADDCI(IBEFFDT) ; add new Tort Liable and Interagency charges or and Reasonable Charges
13 ;
14 S IBA(1)="",IBA(2)=" IB*2*333 Post-Install Complete",IBA(3)="" D MES^XPDUTL(.IBA) K IBA
15 Q
16 ;
17ADDCI(EFFDAT) ; Add Charge Items (363.2) needs Charge Sets, pass in the effective date of the new charges
18 N IBA,IBCNT,IBCNT1,IBI,IBLN,IBFN,IBCS,IBXRF,IBCI,IBRVCD,IBCHG,DD,DO,DLAYGO,DIC,DIE,DA,DR,X,Y,IBX,IBZ,IBDFLTDT,IBDT S (IBCNT,IBCNT1)=0
19 ;
20 S IBDFLTDT=+$G(EFFDAT) I 'IBDFLTDT D MSG("** Error: No Date, No Charges Added") G CIQ
21 ;
22 F IBI=1:1 S IBLN=$P($T(CIF+IBI),";;",2) Q:+IBLN!(IBLN="") I $E(IBLN)?1A D SETCI
23 ;
24 I +IBCNT1 D MSG(IBCNT1_" Duplicate Charge Items already exist, not re-added")
25 ;
26CIQ S IBA(1)=" >> "_IBCNT_" Tort/Interagency Charge Items added (363.2)" D MES^XPDUTL(.IBA) K IBA
27 Q
28 ;
29SETCI ; set Charge Item (duplicates based on item, CS, eff dt, rev cd)
30 ;
31 S IBCS=$P(IBLN,U,2),IBCS=+$O(^IBE(363.1,"B",IBCS,0)) I 'IBCS D MSG("** Error: CS "_$P(IBLN,U,2)_" undefined") Q
32 S IBCI=+$$MCCRUTL($P(IBLN,U,1),5) I 'IBCI D MSG("** Error: BS "_$P(IBLN,U,1)_" undefined") Q
33 S IBDT=IBDFLTDT I +$P(IBLN,U,3) S IBDT=+$P(IBLN,U,3)
34 S IBRVCD=$$RVCD($P(IBLN,U,4))
35 S IBCHG=+$P(IBLN,U,5)
36 S IBXRF="AIVDTS"_IBCS
37 ;
38 S IBX=0 F S IBX=$O(^IBA(363.2,IBXRF,IBCI,-IBDT,IBX)) Q:'IBX S IBZ=$G(^IBA(363.2,IBX,0)) I $P(IBZ,U,6)=IBRVCD D
39 . S IBCI=0,IBCNT1=IBCNT1+1 I +$P(IBZ,U,5)'=IBCHG D MSG("** Error: Item exists, wrong charge: "_IBLN)
40 Q:'IBCI
41 ;
42 K DD,DO S DLAYGO=363.2,DIC="^IBA(363.2,",DIC(0)="L",X=IBCI_";DGCR(399.1," D FILE^DICN K DIC I Y<1 K X,Y Q
43 S IBFN=+Y,IBCNT=IBCNT+1
44 ;
45 S DR=".02////"_IBCS_";.03////"_IBDT_";.05////"_IBCHG I +IBRVCD S DR=DR_";.06////"_IBRVCD
46 S DIE="^IBA(363.2,",DA=+IBFN D ^DIE K DIE,DA,DR,X,Y
47 Q
48 ;
49 ;
50MCCRUTL(X,P) ; returns IFN of item in 399.1 if Name is found and piece P is true
51 N IBX,IBY S IBY=""
52 I $G(X)'="" S IBX=0 F S IBX=$O(^DGCR(399.1,"B",X,IBX)) Q:'IBX I $P($G(^DGCR(399.1,IBX,0)),U,+$G(P)) S IBY=IBX
53 Q IBY
54 ;
55RVCD(RVCD) ; returns IFN if revenue code is valid and active
56 N IBX,IBY S IBY=""
57 I +$G(RVCD) S IBX=$G(^DGCR(399.2,+RVCD,0)) I +$P(IBX,U,3) S IBY=+RVCD
58 Q IBY
59 ;
60MSG(X) ;
61 N IBX S IBX=$O(IBA(999999),-1) S:'IBX IBX=1 S IBX=IBX+1
62 S IBA(IBX)=" "_$G(X)
63 Q
64 ;
65 ;
66CIF ; Charge Items (363.2): Bedsection ^ Charge Set ^Effective Date ^ Revenue Code ^ Charge
67 ;;
68TORT ;; 2005 Tortiously Liable All Inclusive
69 ;;
70 ;;ALCOHOL AND DRUG TREATMENT^TL-INPT (INCLUSIVE)^^^1952
71 ;;BLIND REHABILITATION^TL-INPT (INCLUSIVE)^^^1178
72 ;;GENERAL MEDICAL CARE^TL-INPT (INCLUSIVE)^^^2037
73 ;;INTERMEDIATE CARE^TL-INPT (INCLUSIVE)^^^1324
74 ;;NEUROLOGY^TL-INPT (INCLUSIVE)^^^2633
75 ;;NURSING HOME CARE^TL-INPT (INCLUSIVE)^^^504
76 ;;PRRTP^TL-INPT (INCLUSIVE)^^^293
77 ;;PSYCHIATRIC CARE^TL-INPT (INCLUSIVE)^^^1211
78 ;;REHABILITATION MEDICINE^TL-INPT (INCLUSIVE)^^^1670
79 ;;SPINAL CORD INJURY CARE^TL-INPT (INCLUSIVE)^^^1383
80 ;;SURGICAL CARE^TL-INPT (INCLUSIVE)^^^4117
81 ;;
82 ;; Tortiously Liable Non-Professional
83 ;;ALCOHOL AND DRUG TREATMENT^TL-INPT (NPF)^^101^1314
84 ;;ALCOHOL AND DRUG TREATMENT^TL-INPT (NPF)^^240^452
85 ;;BLIND REHABILITATION^TL-INPT (NPF)^^101^498
86 ;;BLIND REHABILITATION^TL-INPT (NPF)^^240^585
87 ;;GENERAL MEDICAL CARE^TL-INPT (NPF)^^101^1262
88 ;;GENERAL MEDICAL CARE^TL-INPT (NPF)^^240^531
89 ;;INTERMEDIATE CARE^TL-INPT (NPF)^^101^1065
90 ;;INTERMEDIATE CARE^TL-INPT (NPF)^^240^194
91 ;;NEUROLOGY^TL-INPT (NPF)^^101^1553
92 ;;NEUROLOGY^TL-INPT (NPF)^^240^695
93 ;;NURSING HOME CARE^TL-INPT (NPF)^^101^420
94 ;;NURSING HOME CARE^TL-INPT (NPF)^^240^68
95 ;;PRRTP^TL-INPT (NPF)^^101^244
96 ;;PRRTP^TL-INPT (NPF)^^240^31
97 ;;PSYCHIATRIC CARE^TL-INPT (NPF)^^101^906
98 ;;PSYCHIATRIC CARE^TL-INPT (NPF)^^240^191
99 ;;REHABILITATION MEDICINE^TL-INPT (NPF)^^101^970
100 ;;REHABILITATION MEDICINE^TL-INPT (NPF)^^240^510
101 ;;SPINAL CORD INJURY CARE^TL-INPT (NPF)^^101^864
102 ;;SPINAL CORD INJURY CARE^TL-INPT (NPF)^^240^348
103 ;;SURGICAL CARE^TL-INPT (NPF)^^101^2414
104 ;;SURGICAL CARE^TL-INPT (NPF)^^240^1249
105 ;;
106 ;; Tortiously Liable Professional
107 ;;ALCOHOL AND DRUG TREATMENT^TL-INPT (PF)^^^186
108 ;;BLIND REHABILITATION^TL-INPT (PF)^^^95
109 ;;GENERAL MEDICAL CARE^TL-INPT (PF)^^^244
110 ;;INTERMEDIATE CARE^TL-INPT (PF)^^^65
111 ;;NEUROLOGY^TL-INPT (PF)^^^385
112 ;;NURSING HOME CARE^TL-INPT (PF)^^^16
113 ;;PRRTP^TL-INPT (PF)^^^18
114 ;;PSYCHIATRIC CARE^TL-INPT (PF)^^^114
115 ;;REHABILITATION MEDICINE^TL-INPT (PF)^^^190
116 ;;SPINAL CORD INJURY CARE^TL-INPT (PF)^^^171
117 ;;SURGICAL CARE^TL-INPT (PF)^^^454
118 ;;
119 ;; Tortiously Liable Other
120 ;;OUTPATIENT VISIT^TL-OPT VST^^^298
121 ;;PRESCRIPTION^TL-RX FILL^^^51
122 ;;OUTPATIENT DENTAL^TL-OPT DENTAL^^^202
123 ;;
124 ;;
125IA ;; 2005 Interagency
126 ;;
127 ;;ALCOHOL AND DRUG TREATMENT^IA-INPT^^^1832
128 ;;BLIND REHABILITATION^IA-INPT^^^1112
129 ;;GENERAL MEDICAL CARE^IA-INPT^^^1914
130 ;;INTERMEDIATE CARE^IA-INPT^^^1241
131 ;;NEUROLOGY^IA-INPT^^^2465
132 ;;NURSING HOME CARE^IA-INPT^^^470
133 ;;PRRTP^IA-INPT^^^273
134 ;;PSYCHIATRIC CARE^IA-INPT^^^1132
135 ;;REHABILITATION MEDICINE^IA-INPT^^^1564
136 ;;SPINAL CORD INJURY CARE^IA-INPT^^^1292
137 ;;SURGICAL CARE^IA-INPT^^^3894
138 ;;
139 ;;OUTPATIENT VISIT^IA-OPT VST^^^284
140 ;;PRESCRIPTION^IA-RX FILL^^^51
141 ;;OUTPATIENT DENTAL^IA-OPT DENTAL^^^188
142 ;;
143 Q
Note: See TracBrowser for help on using the repository browser.