source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBCSV1.m@ 1147

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

initial load of WorldVistAEHR

File size: 5.6 KB
Line 
1FBCSV1 ;WOIFO/SS-UTILITIES FOR CODE SET VERSIONING;4/7/2003
2 ;;3.5;FEE BASIS;**55,77,94**;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;wrapper for DRG^ICDGTDRG
6 ;to use instead of direct read of ^ICD(
7 ;FBIEN - ien of #80.2
8 ;FBDATE - date of service (optional)
9 ;returns (#.01) NAME of #80.2 or "" if invalid/error
10ICD(FBIEN,FBDATE) ;
11 N FBRET
12 S FBRET=$$DRG^ICDGTDRG($G(FBIEN),$S(+$G(FBDATE)=0:"",1:FBDATE))
13 Q:+FBRET<0 ""
14 Q $P(FBRET,"^",1)
15 ;
16 ;wrapper for ICDOP^ICDCODE
17 ;to use instead of direct read of ^ICD0(
18 ;FBIEN - ien of #80.1
19 ;FBDATE - date of service (optional)
20 ;returns (#.01) NAME of #80.1 or "" if invalid/error
21ICD0(FBIEN,FBDATE) ;
22 N FBRET
23 S FBRET=$$ICDOP^ICDCODE($G(FBIEN),$S(+$G(FBDATE)=0:"",1:FBDATE),,1)
24 Q:+FBRET<0 ""
25 Q $P(FBRET,"^",2)
26 ;
27 ;wrapper for ICDDX^ICDCODE
28 ;to use instead of direct read of ^ICD9(
29 ;FBIEN - ien of #80
30 ;FBDATE - date of service (optional)
31 ;returns (#.01) NAME of #80 or "" if invalid/error
32ICD9(FBIEN,FBDATE) ;
33 N FBRET
34 S FBRET=$$ICDDX^ICDCODE($G(FBIEN),$S(+$G(FBDATE)=0:"",1:FBDATE),,1)
35 Q:+FBRET<0 ""
36 Q $P(FBRET,"^",2)
37 ;
38 ;wrapper for ICDDX^ICDCODE with piece #
39 ;to use instead of direct read of ^ICD9(
40 ;FBIEN - ien of #80
41 ;FBPC - piece #
42 ;FBDATE (optional) - date of service
43 ;returns piece # FBPC of #80 or "" if invalid/error
44ICD9P(FBIEN,FBPC,FBDATE) ;
45 N FBRET
46 S FBRET=$$ICDDX^ICDCODE($G(FBIEN),$S(+$G(FBDATE)=0:"",1:FBDATE),,1)
47 Q:+FBRET<0 ""
48 Q $P(FBRET,"^",FBPC+1)
49 ;
50 ;extended wrapper for ICDDX^ICDCODE
51 ;to use instead of direct read of ^ICD9(
52 ;FBIEN - ien of #80
53 ;FBPC - piece #
54 ;FBEXTR - $E parameter
55 ;FBDATE (optional) - date of service
56 ;returns piece #FBPC and (#.01) NAME of #80 and or "" if invalid/error
57ICD9EX(FBIEN,FBPC,FBEXTR,FBDATE) ;
58 N FBRET
59 S FBRET=$$ICDDX^ICDCODE($G(FBIEN),$S(+$G(FBDATE)=0:"",1:FBDATE),,1)
60 Q:+FBRET<0 ""
61 Q $E($P(FBRET,"^",FBPC+1),1,FBEXTR)_" ("_$P(FBRET,"^",2)_")"
62 ;
63 ;get FROM date
64FRDTINV(FBDA) ;
65 N FBRETDT
66 S FBRETDT=$P($$B9DISCHG^FBAAV5(FBDA),"^",1) ; Discharge Date
67 I FBRETDT="" S FBRETDT=$P($G(^FBAAI(FBDA,0)),"^",7) ; Treatment To DT
68 I FBRETDT="" S FBRETDT=$P($G(^FBAAI(FBDA,0)),"^",6) ; Treatment Fr DT
69 Q FBRETDT
70 ;
71 ;if FBCODE="" returns FBNUM spaces
72 ;otherwise returns FBCODE
73SPACES(FBCODE,FBNUM) ;
74 I $L(FBCODE)=0 S $P(FBCODE," ",FBNUM)=" "
75 Q FBCODE
76 ;
77 ;EVALUATE (sometimes can be used instead of "$S")
78 ;if FBCODE="" returns FBRETV
79 ;otherwise returns FBCODE
80EV(FBCODE,FBRETV) ;
81 Q:$L(FBCODE)=0 FBRETV
82 Q FBCODE
83 ;
84 ;converts a date to fileman format
85DT2FMDT(FBDAT) ;
86 N X,Y
87 S X=$$TRIM^XLFSTR(FBDAT)
88 D ^%DT
89 Q +Y
90 ;
91 ;wrapper for ICDDX^ICDCODE
92 ;to use in prompts (and input templates)of file #162.5 to screen out
93 ; inactive/invalid codes
94 ;FBICD9 - ien of #80
95 ;FBINV - ien of the current #162.5 record
96 ;FBDATE - (optional) date of service
97 ;returns 0 if code is active, otherwise - nonzero value
98INPICD9(FBICD9,FBINV,FBDATE) ;
99 N FBRET
100 ;I '$G(FBDATE) S FBDATE=$$FRDTINV(+$G(FBINV))
101 S FBDATE=$$FRDTINV(+$G(FBINV))
102 S FBRET=$$ICDDX^ICDCODE($G(FBICD9),$S(+$G(FBDATE)=0:"",1:FBDATE))
103 I +FBRET<0 W " Invalid Code " Q 2
104 I $P(FBRET,"^",10)=0 W !," Code is inactive" W:$G(FBDATE)>0 " on "_$$FMTE^XLFDT(FBDATE) Q 1
105 Q 0
106 ;
107 ;wrapper for ICDOP^ICDCODE
108 ;checks if code is active on the date of service and
109 ;if active returns CODE NUMBER
110 ;is inactive returns "" and prints message "ICD O/P Code inactive ..."
111 ;is invalid/local returns "" and prints message "Invalid ICD O/P Code"
112CHKICD0(FBIEN,FBDATE) ;
113 N FBRET
114 S FBRET=$$ICDOP^ICDCODE($G(FBIEN),$S(+$G(FBDATE)=0:"",1:FBDATE))
115 I +FBRET<0 W " Invalid ICD O/P Code " Q ""
116 I $P(FBRET,"^",10)=0 D Q ""
117 . W !," ICD O/P Code "_$P(FBRET,"^",2)_" inactive"
118 . W:$G(FBDATE) " on date of service (",$$FMTE^XLFDT(FBDATE),")"
119 Q $P(FBRET,"^",2)
120 ;
121 ;wrapper for ICDOP^ICDCODE
122 ;to use in prompts (and input templates)of file #162.5 to screen out
123 ; inactive/invalid codes
124 ;FBICD0 - ien of #80.1
125 ;FBINV - ien of the current #162.5 record
126 ;FBDATE - (optional) date of service
127 ;returns 0 if code is active, otherwise - nonzero value
128INPICD0(FBICD0,FBINV,FBDATE) ;
129 N FBRET
130 ;I '$G(FBDATE) S FBDATE=$$FRDTINV(+$G(FBINV))
131 S FBDATE=$$FRDTINV(+$G(FBINV))
132 S FBRET=$$ICDOP^ICDCODE($G(FBICD0),$S(+$G(FBDATE)=0:"",1:FBDATE))
133 I +FBRET<0 W " Invalid Code " Q 2
134 I $P(FBRET,"^",10)=0 W !," Code is inactive" W:$G(FBDATE)>0 " on "_$$FMTE^XLFDT(FBDATE) Q 1
135 Q 0
136 ;
137 ;wrapper for DRG^ICDGTDRG
138 ;to use in prompts (and input templates)of file #162.5 to screen out
139 ; inactive/invalid codes
140 ;FBICD - ien of #80.2
141 ;FBINV - ien of the current #162.5 record
142 ;FBDATE - (optional) date of service
143 ;returns 0 if code is active, otherwise - nonzero value
144INPICD(FBICD,FBINV,FBDATE) ;
145 N FBRET
146 ;I '$G(FBDATE) S FBDATE=$$FRDTINV(+$G(FBINV))
147 S FBDATE=$$FRDTINV(+$G(FBINV))
148 S FBRET=$$DRG^ICDGTDRG($G(FBICD),$S(+$G(FBDATE)=0:"",1:FBDATE))
149 I +FBRET<0 W " Invalid Code " Q 2
150 I $P(FBRET,"^",14)=0 W !," Code is inactive" W:$G(FBDATE)>0 " on "_$$FMTE^XLFDT(FBDATE) Q 1
151 Q 0
152 ;
153 ;wrapper for ICDDX^ICDCODE
154 ;checks if code is inactive on the date of service and
155 ;if active returns CODE NUMBER
156 ;is inactive returns "" and prints message "ICD Dx Code inactive ..."
157 ;is invalid/local returns "" and prints message "Invalid ICD Dx Code"
158CHKICD9(FBIEN,FBDATE) ;
159 N FBRET
160 S FBRET=$$ICDDX^ICDCODE($G(FBIEN),$S(+$G(FBDATE)=0:"",1:FBDATE))
161 I +FBRET<0 W " Invalid ICD Dx Code " Q ""
162 I $P(FBRET,"^",10)=0 D Q ""
163 . W !," ICD Dx Code "_$P(FBRET,"^",2)_" inactive"
164 . W:$G(FBDATE) " on date of service (",$$FMTE^XLFDT(FBDATE),")"
165 Q $P(FBRET,"^",2)
166 ;
167 ;
168 ;convert date as a string like "MMDDYYYY" into FM date like "YYYMMDD"
169STR2FBDT(FBDTSTR) ;
170 N X,Y S X=FBDTSTR D ^%DT
171 Q:Y=-1 ""
172 Q Y\1
173 ;
174 ;FBCSV1
Note: See TracBrowser for help on using the repository browser.