source: FOIAVistA/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/EC725U02.m@ 1378

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

initial load of FOIAVistA 6/30/08 version

File size: 7.8 KB
Line 
1EC725U02 ;ALB/GTS/JAP/JAM - EC National Procedure Update;08/10/99
2 ;;2.0; EVENT CAPTURE ;**20**;8 May 96
3 ;
4 ;this routine is used as a post-init in a KIDS build
5 ;to modify the EC National Procedure file #725
6 ;
7NAMECHG ;* change national procedure names
8 ;
9 ; ECXX is in format:
10 ; NATIONAL NUMBER^NEW NAME
11 ;
12 N ECX,ECXX,ECDA,DA,DR,DIC,DIE,X,Y
13 D MES^XPDUTL(" ")
14 D BMES^XPDUTL("Changing names in EC NATIONAL PROCEDURE File (#725)...")
15 D MES^XPDUTL(" ")
16 F ECX=1:1 S ECXX=$P($T(CHNG+ECX),";;",2) Q:ECXX="QUIT" D
17 .I $D(^EC(725,"D",$P(ECXX,U,1))) D
18 ..S ECDA=+$O(^EC(725,"D",$P(ECXX,U,1),0))
19 ..I $D(^EC(725,ECDA,0)) D
20 ...S DA=ECDA,DR=".01////^S X=$P(ECXX,U,2)",DIE="^EC(725," D ^DIE
21 ...D MES^XPDUTL(" ")
22 ...D BMES^XPDUTL(" Entry #"_ECDA_" for "_$P(ECXX,U,1))
23 ...D BMES^XPDUTL(" ...field (#.01) updated to "_$P(ECXX,U,2)_".")
24 .I '$D(^EC(725,"D",$P(ECXX,U,1))) D
25 ..D MES^XPDUTL(" ")
26 ..D BMES^XPDUTL("Can't find entry for "_$P(ECXX,U,1))
27 ..D BMES^XPDUTL("...field (#.01) not updated.")
28 Q
29 ;
30CHNG ;name changes
31 ;;SW006^HEALTH ED/REFER IND NEW PT 15 MIN
32 ;;SW015^PSYCHSOC TX OPT 75-80 MIN
33 ;;SW002^CONSULTATION INPT 10 MIN
34 ;;SW003^DISCH PLANNING <30MIN
35 ;;SW013^OFFICE VISIT OPT 5 MIN
36 ;;SW014^PSYCHSOC ASSES INPT @ 30 MIN
37 ;;SW019^HEALTHED/REFER GP (1-5) @30MIN
38 ;;SW025^HEAKTHED/REFER GP (6-8) @30MIN
39 ;;SW026^HEALTHED/REFER GP (9+) @30MIN
40 ;;SW033^CONSULTATION INPT 20 MIN
41 ;;SW034^CONSULTATION INPT 30 MIN
42 ;;SW056^OFFICE VISIT OPT 10 MIN
43 ;;SW057^OFFICE VISIT OPT 15 MIN
44 ;;SW058^OFFICE VISIT OPT 25 MIN
45 ;;SW059^OFFICE VISIT OPT 40 MIN
46 ;;SW037^HEALTH ED/REFER IND NEW PT 30 MIN
47 ;;SW038^HEALTH ED/REFER IND NEW PT 45 MIN
48 ;;SW039^HEALTH ED/REFER IND NEW PT 60 MIN
49 ;;SW060^COMP & PEN EXAM
50 ;;SW061^PSYCHSOC TX OPT 20-30 MIN
51 ;;SW062^PSYCHSOC TX OPT 45-50 MIN
52 ;;QUIT
53 ;
54ADDPROC ;* add national procedures
55 ;
56 ; ECXX is in format:
57 ; NAME^NATIONAL NUMBER^CPT CODE^FIRST NATIONAL NUMBER SEQUENCE
58 ; LAST NATIONAL NUMBER SEQUENCE
59 ;
60 N ECX,ECXX,ECDINUM,NAME,CODE,CPT,COUNT,X,Y,DIC,DIE,DA,DR,DLAYGO,DINUM
61 N ECADD,ECBEG,ECEND,CODX,NAMX,ECSEQ,LIEN
62 D MES^XPDUTL(" ")
63 D BMES^XPDUTL("Adding new procedures to EC NATIONAL PROCEDURE File (#725)...")
64 D MES^XPDUTL(" ")
65 S ECDINUM=$O(^EC(725,9999),-1),COUNT=$P(^EC(725,0),U,4)
66 F ECX=1:1 S ECXX=$P($T(NEW+ECX),";;",2) Q:ECXX="QUIT" D
67 .S NAME=$P(ECXX,U,1),CODE=$P(ECXX,U,2),CPT=$P(ECXX,U,3),CODX=CODE
68 .S ECBEG=$P(ECXX,U,4),ECEND=$P(ECXX,U,5),NAMX=NAME
69 .I ECBEG="" S X=NAME D FILPROC Q
70 .F ECSEQ=ECBEG:1:ECEND D
71 ..S ECADD="000"_ECSEQ,ECADD=$E(ECADD,$L(ECADD)-2,$L(ECADD))
72 ..S NAME=NAMX_" "_ECADD,X=NAME,CODE=CODX_ECADD
73 ..D FILPROC
74 S $P(^EC(725,0),U,4)=COUNT,X=$O(^EC(725,999999),-1),$P(^EC(725,0),U,3)=X
75 Q
76 ;
77FILPROC ;File national procedures
78 ;
79 I '$D(^EC(725,"D",CODE)) D
80 .S ECDINUM=ECDINUM+1,DINUM=ECDINUM,DIC(0)="L",DLAYGO=725,DIC="^EC(725,"
81 .S DIC("DR")="1////^S X=CODE;4////^S X=CPT"
82 .D FILE^DICN
83 .I +Y>0 D
84 ..S COUNT=COUNT+1
85 ..D MES^XPDUTL(" ")
86 ..D BMES^XPDUTL(" Entry #"_+Y_" for "_$P(Y,U,2)_$S(CPT:" [CPT: "_CPT_"]",1:"")_" ("_CODE_")")
87 ..D BMES^XPDUTL(" ...successfully added.")
88 .I Y=-1 D
89 ..D MES^XPDUTL(" ")
90 ..D BMES^XPDUTL("ERROR when attempting to add "_NAME_" ("_CODE_")")
91 I $D(^EC(725,"DL",CODE)) D
92 .S LIEN=$O(^EC(725,"DL",CODE,""))
93 .D MES^XPDUTL(" ")
94 .D BMES^XPDUTL(" Your site has a local procedure (entry #"_LIEN_") in File #725")
95 .D BMES^XPDUTL(" which uses "_CODE_" as its National Number.")
96 .D BMES^XPDUTL(" Please inactivate this local procedure.")
97 .K Y
98 Q
99NEW ;national procedures to add
100 ;;BEDDAY STATE HOSPITAL^SH^^1^20
101 ;;BEDDAY STATE DOM^SD^^1^42
102 ;;BEDDAY STATE NURS HOME^SN^^1^100
103 ;;SN 0-25 CARE LEVEL ADDON^SN101
104 ;;SN 26-50 CARE LEVEL ADDON^SN102
105 ;;SN 51-75 CARE LEVEL ADDON^SN103
106 ;;SN 76-100 CARE LEVEL ADDON^SN104
107 ;;SN 101-199 CARE LEVEL ADDON^SN105
108 ;;SN 200-299 CARE LEVEL ADDON^SN106
109 ;;SN 300-499 CARE LEVEL ADDON^SN107
110 ;;SN 500-599 CARE LEVEL ADDON^SN108
111 ;;SN >600 CARE LEVEL ADDON^SN109
112 ;;SN RUGS II^SN110
113 ;;SN RUGS III^SN111
114 ;;BEDDAY COMM NUR HOME^CN^^1^100
115 ;;CN 0-25 CARE LEVEL ADDON^CN101
116 ;;CN 26-50 CARE LEVEL ADDON^CN102
117 ;;CN 51-75 CARE LEVEL ADDON^CN103
118 ;;CN 76-100 CARE LEVEL ADDON^CN104
119 ;;CN 101-199 CARE LEVEL ADDON^CN105
120 ;;CN 200-299 CARE LEVEL ADDON^CN106
121 ;;CN 300-499 CARE LEVEL ADDON^CN107
122 ;;CN 500-599 CARE LEVEL ADDON^CN108
123 ;;CN >600 CARE LEVEL ADDON^CN109
124 ;;CN RUGS II^CN110
125 ;;CN RUGS III^CN111
126 ;;HH VIST, NEW^HH001^99211
127 ;;HH VIST-NEW-MOD SEVERITY^HH002^99211
128 ;;HH VIST-NEW-HI SEVERITY^HH003^99211
129 ;;HH VIST, ESTAB 15 MIN^HH004^99211
130 ;;HH VIST, ESTAB 25 MIN^HH005^99211
131 ;;HH VIST, ESTAB 40 MIN^HH006^99211
132 ;;HH VIST, ESTAB 60 MIN^HH007^99211
133 ;;HH COMPLAINT RESOLVE^HH008^99499
134 ;;HH COLLATERAL VISIT^HH009^99499
135 ;;HH PAT ADVOCACY^HH010^99499
136 ;;HH HAA HOME VISIT^HH011^99211
137 ;;HH CNH PAT VISIT^HH012^99211
138 ;;HH OUTPT CONSULT^HH013^99499
139 ;;HH INPT FOLLOW VISIT^HH014^99499
140 ;;HH INPT CONSULT^HH015^99499
141 ;;HH PATIENT EDUCATION^HH016^99499
142 ;;HH COLLATERAL EDUCATION^HH017^99499
143 ;;HH PHONE CONTACT WITH PATIENT^HH025^99371
144 ;;HH REFER-VA PURCH SKILLED^HH030
145 ;;HH END-VA PURCH SKILLED^HH031
146 ;;HH REFER-VA PURCH AIDE^HH032
147 ;;HH END-VA PURCH AIDE^HH033
148 ;;HH REFER VA PURCH HOME MAKER^HH034
149 ;;HH END-VA PURCH HOME MAKER^HH035
150 ;;HH REFER-VA PURCH INFUSION^HH036
151 ;;HH END-VA PURCH INFUSION^HH037
152 ;;HH REFER-VA PURCH HOSPICE^HH038
153 ;;HH END-VA PURCH HOSPICE^HH039
154 ;;HH REFER-VA PD RESPIR CONTRCT^HH040
155 ;;HH END VA PURCH RESPIRATORY^HH041
156 ;;HH REFER-VA PURCH MNTL HLTH^HH042
157 ;;HH END VA PURCH MNTL HLTH^HH043
158 ;;HH REFER TO MEDICARE^HH044
159 ;;HH REFER TO VA PD PHYSICAL THPY^HH045
160 ;;HH REFER TO HOMHLH END VA PD PT^HH046
161 ;;HH REFER TO VA PD OCCUP THPY^HH047
162 ;;HH REFER TO END VA PD OT^HH048
163 ;;HH REFER TO VA PD SPEECH THPY^HH049
164 ;;HH REFER TO END VA PD SPECH^HH050
165 ;;HH REFER TO VA PD SOCIAL WK^HH051
166 ;;HH REFER TO END VA PD SOC WK^HH052
167 ;;HH REFER TO VA PD HOME HOSPICE^HH053
168 ;;HH REFER TO END VA PD HOMHSPC^HH054
169 ;;HH REFER TO VA PD BOWEL AND BLADDER^HH055
170 ;;HH REFER TO END VA PD BOWEL AND BLADDER^HH056
171 ;;HH REFER TO VA PD LAB SERVICES^HH057
172 ;;HH REFER TO END VA PD LAB^HH058
173 ;;HH REFER - HOME HSPICE MEDICARE^HH059
174 ;;HH REFER - HOME HSPICE MEDICAID^HH060
175 ;;HH REFER - HOME HSPICE THIRD PARTY^HH061
176 ;;HH REFER - HOME HSPICE GRATUS^HH062
177 ;;HH REFER TO MEDICAID^HH063
178 ;;HH REFER PUBLIC HEALTH (COUNTY)^HH064
179 ;;HH REFER THIRD PARTY^HH065
180 ;;HH REFER TO HMO^HH066
181 ;;HH REFER TO PRIVATE PAY^HH067
182 ;;HH REFER RESPITE MEDICARE^HH068
183 ;;HH REFER RESPITE OTHER^HH069
184 ;;HH CARE PLAN OVERSIGHT^HH070
185 ;;HH MEDICAL RECORDS REVIEW^HH071
186 ;;HH FAMILY SUPPORT ACTIVITIES^HH072
187 ;;HH MONITORING LAB RESULTS^HH073
188 ;;HH DISCHARGE DAY MANAGEMENT^HH074
189 ;;HH ADMIN DETAILS OF REFER COORDIN^HH075
190 ;;HH REFER TO VA PURCH. PALLIATIVE CARE^HH076
191 ;;HH END VA PURCH. PALLIATIVE CARE^HH077
192 ;;HH PURCH VISITS/MO-SKILLED^HH091
193 ;;HH PURCH VISITS/MO-AIDE^HH092
194 ;;HH PURCH VISITS/MO-INFUSION^HH093
195 ;;HH PURCH VISITS/MO-HOSPICE^HH094
196 ;;HH PURCH VISITS/MO-RESPIRATORY^HH095
197 ;;HH PURCH VISITS/MO-MENT HLTH^HH096
198 ;;HH PURCH VISITS/MO-PHYS THPY^HH097
199 ;;HH PURCH VISITS/MO-OCCUP THPY^HH098
200 ;;HH PURCH VISITS/MO-SPECH THPY^HH099
201 ;;HH PURCH VISITS/MO-SOCIAL WK^HH100
202 ;;HH PURCH VISITS/MO-HOM HOSPIC^HH101
203 ;;HH PURCH VISITS/MO-BOWEL-BLADDER^HH102
204 ;;HH PURCH VISITS/MO-LAB SERVICES^HH103
205 ;;HH PURCH VISITS/MO-HOMEMAKER^HH104
206 ;;HH PURCH VISITS/MO-RESPITE^HH105
207 ;;HH PURCH VISITS/MO-PALLIATIVE CRE^HH106
208 ;;HH PURCH VISITS/MO-ADULT DAY CARE^HH107
209 ;;DISCH PLANNING >30MIN^SW007^99239
210 ;;INDIV FUNCTIONAL IMPVMT @ 15 MIN^SW072^97530
211 ;;SELF CARE/HOME MGMT @ 15 MIN^SW073^97535
212 ;;COMM/WORK REINTEGRATE @15 MIN^SW074^97537
213 ;;HIGH RISK ASSESSMENT^SW075^99420
214 ;;HOME VISIT 60 MIN^SW076^99350
215 ;;PSYCHSOCASSES OPT @ 60 MIN^SW077^99244
216 ;;PSYCHSOC TX INPT 75-80 MIN^SW080^90821
217 ;;PSYCHSOC TX INPT 20-30 MIN^SW081^90816
218 ;;PSYCHSOC TX INPT 45-50 MIN^SW082^90818
219 ;;HEALTHED/REFER GP (1-5) @60MIN^SW083^99412
220 ;;HEAKTHED/REFER GP (6-8) @60MIN^SW084^99412
221 ;;HEALTHED/REFER GP (9+) @60MIN^SW085^99412
222 ;;QUIT
Note: See TracBrowser for help on using the repository browser.