source: WorldVistAEHR/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/EC725U26.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: 7.2 KB
Line 
1EC725U26 ;ALB/GTS/JAP/GT - EC National Procedure Update; 9/11/2003
2 ;;2.0; EVENT CAPTURE ;**67**;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 ;
7ADDPROC ;* add national procedures
8 ;
9 ; ECXX is in format:
10 ; NAME^NATIONAL NUMBER^CPT CODE^FIRST NATIONAL NUMBER SEQUENCE
11 ; LAST NATIONAL NUMBER SEQUENCE
12 ;
13 N ECX,ECXX,ECDINUM,NAME,CODE,CPT,COUNT,X,Y,DIC,DIE,DA,DR,DLAYGO,DINUM
14 N ECADD,ECBEG,ECEND,CODX,NAMX,ECSEQ,LIEN,STR,CPTN,STR
15 D MES^XPDUTL(" ")
16 D BMES^XPDUTL("Adding new procedures to EC NATIONAL PROCEDURE File (#725)...")
17 D MES^XPDUTL(" ")
18 S ECDINUM=$O(^EC(725,9999),-1),COUNT=$P(^EC(725,0),U,4)
19 F ECX=1:1 S ECXX=$P($T(NEW+ECX),";;",2) Q:ECXX="QUIT" D
20 .S NAME=$P(ECXX,U,1),CODE=$P(ECXX,U,2),CPTN=$P(ECXX,U,3),CODX=CODE
21 .S CPT=""
22 .I CPTN'="" S CPT=$$FIND1^DIC(81,"","X",CPTN) I +CPT<1 D Q
23 ..S STR=" CPT code "_CPTN_" not a valid code in CPT File."
24 ..D MES^XPDUTL(" ")
25 ..D BMES^XPDUTL(" ["_CODE_"] "_STR)
26 .S ECBEG=$P(ECXX,U,4),ECEND=$P(ECXX,U,5),NAMX=NAME
27 .I ECBEG="" S X=NAME D FILPROC Q
28 .F ECSEQ=ECBEG:1:ECEND D
29 ..S ECADD="000"_ECSEQ,ECADD=$E(ECADD,$L(ECADD)-2,$L(ECADD))
30 ..;S NAME=NAMX_ECADD,X=NAME,CODE=CODX_ECADD
31 ..I $E(CODX,1,3)'="RCM" S NAME=NAMX_ECSEQ,X=NAME,CODE=CODX_ECADD
32 ..E S NAME=NAMX_$E(ECADD,2,99),X=NAME,CODE=CODX_$E(ECADD,2,99)
33 ..D FILPROC
34 S $P(^EC(725,0),U,4)=COUNT,X=$O(^EC(725,999999),-1),$P(^EC(725,0),U,3)=X
35 Q
36 ;
37FILPROC ;File national procedures
38 I '$D(^EC(725,"D",CODE)) D
39 .S ECDINUM=ECDINUM+1,DINUM=ECDINUM,DIC(0)="L",DLAYGO=725,DIC="^EC(725,"
40 .S DIC("DR")="1////^S X=CODE;4////^S X=CPT"
41 .D FILE^DICN
42 .I +Y>0 D
43 ..S COUNT=COUNT+1
44 ..D MES^XPDUTL(" ")
45 ..S STR=" Entry #"_+Y_" for "_$P(Y,U,2)
46 ..S STR=STR_$S(CPT'="":" [CPT: "_CPT_"]",1:"")_" ("_CODE_")"
47 ..D BMES^XPDUTL(STR_" ...successfully added.")
48 .I Y=-1 D
49 ..D MES^XPDUTL(" ")
50 ..D BMES^XPDUTL("ERROR when attempting to add "_NAME_" ("_CODE_")")
51 I $D(^EC(725,"DL",CODE)) D
52 .S LIEN=$O(^EC(725,"DL",CODE,""))
53 .D MES^XPDUTL(" ")
54 .D BMES^XPDUTL(" Your site has a local procedure (entry #"_LIEN_") in File #725")
55 .D BMES^XPDUTL(" which uses "_CODE_" as its National Number.")
56 .D BMES^XPDUTL(" Please inactivate this local procedure.")
57 .K Y
58 Q
59NEW ;national procedures to add;;descript^nation #^CPT code^beg seq^end seq
60 ;;TELEMETRY BEDDAY WARD 1^CA001
61 ;;TELEMETRY BEDDAY WARD 2^CA002
62 ;;TELEMETRY BEDDAY WARD 3^CA003
63 ;;TELEMETRY BEDDAY WARD 4^CA004
64 ;;TELEMETRY BEDDAY WARD 5^CA005
65 ;;TELEMETRY BEDDAY WARD 6^CA006
66 ;;TELEMETRY BEDDAY WARD 7^CA007
67 ;;TELEMETRY BEDDAY WARD 8^CA008
68 ;;TELEMETRY BEDDAY WARD 9^CA009
69 ;;TELEMETRY BEDDAY WARD 10^CA010
70 ;;TELEMETRY BEDDAY WARD 11^CA011
71 ;;TELEMETRY BEDDAY WARD 12^CA012
72 ;;TELEMETRY BEDDAY WARD 13^CA013
73 ;;TELEMETRY BEDDAY WARD 14^CA014
74 ;;TELEMETRY BEDDAY WARD 15^CA015
75 ;;TELEMETRY BEDDAY WARD 16^CA016
76 ;;TELEMETRY BEDDAY WARD 17^CA017
77 ;;TELEMETRY BEDDAY WARD 18^CA018
78 ;;TELEMETRY BEDDAY WARD 19^CA019
79 ;;TELEMETRY BEDDAY WARD 20^CA020
80 ;;TELEMETRY BEDDAY WARD 21^CA021
81 ;;TELEMETRY BEDDAY WARD 22^CA022
82 ;;TELEMETRY BEDDAY WARD 23^CA023
83 ;;TELEMETRY BEDDAY WARD 24^CA024
84 ;;TELEMETRY BEDDAY WARD 25^CA025
85 ;;MH CWT/TWE <4 HR WRKDY^MH066^97799
86 ;;MH CWT/TWE 4 TO <8 HR WRKDY^MH067^97799
87 ;;MH CWT/TWE 8 HRS/MORE WRKDY^MH068^97799
88 ;;MH CWT/SE <4 HR WRKDY^MH069^97799
89 ;;MH CWT/SE 4 TO <8 HR WRKDY^MH070^97799
90 ;;MH CWT/SE 8 HRS/MORE WRKDY^MH071^97799
91 ;;PM CWT/TWE <4 HR WRKDY^PM504^97799
92 ;;PM CWT/TWE 4 TO <8 HR WRKDY^PM505^97799
93 ;;PM CWT/TWE 8 HRS/MORE WRKDY^PM506^97799
94 ;;PM CWT/SE <4 HR WRKDY^PM507^97799
95 ;;PM CWT/SE 4 TO <8 HR WRKDY^PM508^97799
96 ;;PM CWT/SE 8 HRS/MORE WRKDY^PM509^97799
97 ;;ARTIFICIAL AIRWAY CHANGE^RT018
98 ;;EXTUBATION OF AIRWAY^RT019
99 ;;NASOTRACHEAL SUCTIONING^RT020
100 ;;ENDOTRACHEAL SUCTIONING^RT021
101 ;;TRACHEOSTOMY TUBE CARE^RT022
102 ;;ENDOTRACHEAL TUBE ACRE^RT023
103 ;;PLACE ASSISTIVE SPCH VALVE^RT024
104 ;;INTUBATION OF AIRWAY^RT025
105 ;;INTUBATION ASSIST^RT026
106 ;;ADJUNCT AIRWAY DEVICE^RT027
107 ;;MECH VENTILATION - INVASIVE^RT028
108 ;;MECH VENTILATION -NONINVASIVE^RT029
109 ;;CPAP SETUP^RT030
110 ;;BIPAP SET UP^RT031
111 ;;CPAP/BIPAP TROUBLESHOOT^RT032
112 ;;MANUAL VENTILATION^RT033
113 ;;SYSTEM CHECK^RT034
114 ;;WEANING PARAMETERS^RT035
115 ;;SETTING ADJUSTMENT^RT036
116 ;;VENTILATOR CIRCUIT CHNG^RT037
117 ;;VENTILATOR TRANSPORT^RT038
118 ;;CHEST PHYIOTHERAPY^RT039
119 ;;FLUTTER^RT040
120 ;;INCENTIVE SPIROMETRY^RT041
121 ;;SMALL VOLUME NEBULIZER^RT042
122 ;;IPPB - INITIAL^RT043
123 ;;IPPB - SUBSEQUENT^RT044
124 ;;METERED DOES INHALER^RT045
125 ;;CONT. NEBULIZER SET-UP^RT046
126 ;;CONT. NEBULIZER CHECK, 5M INTERVALS^RT047
127 ;;ULTRASONIC NEBULZATION CHECK, 5 MIN INTERVALS^RT048
128 ;;BRONCHOSCOPY ASSIST^RT049
129 ;;PENTAMINDINE RX^RT050
130 ;;THORACENTESIS ASSIST^RT051
131 ;;PATIENT EDUCATION/INSTRUCTION 15M INTERVALS^RT052
132 ;;PATIENT ASSESSMENT^RT053
133 ;;PULSE OXIMETRY SPOT CHECK^RT054
134 ;;CONTINUOUS MONITORING SET-UP^RT055
135 ;;EXERCISE PULSE OXIMETRY^RT056
136 ;;SPONTANEOUS MECHANICS^RT057
137 ;;PEAK FLOW MEASUREMENT WITH PEAK FLOW METER^RT058
138 ;;SPUTUM INDUCTION^RT059
139 ;;ABG ANALYSIS^RT060
140 ;;ABG QUALITY CONTROL^RT061
141 ;;ABG PROFICIENCY TESTING^RT062
142 ;;ARTERIAL PUNCTURE^RT063
143 ;;ARTERIAL LINE SPECIMEN^RT064
144 ;;SUPPLEMENTAL OXYGEN THERAPY - HIGH FLOW^RT065
145 ;;SUPPLEMENTAL OXYGEN THERAPY - LOW FLOW^RT066
146 ;;PATIENT SYSTEM CHECK^RT067
147 ;;EQUIPMENT CHANGE^RT068
148 ;;CONTINUOUS AEROSOL THERAPY SYSTEM CHECK^RT069
149 ;;PORTABLE OXYGEN CYLINDER SET-UP^RT070
150 ;;TRANSTRACHEAL OXYGEN CATHETER MAINTENANCE^RT071
151 ;;POSITIVE EXPIRATORY PRESSURE (PEP) THERAPY^RT072
152 ;;CARDIOPULMONARY RESUSCITATION (CPR)^RT073
153 ;;PATIENT TRANSPORT - OUTPATIENT^RT074
154 ;;RESTING METABOLIC RATE^RT075
155 ;;HELIOX & NITRIC OXIDE USE IN SPECIAL SITUATIONS^RT076
156 ;;CUFF PRESSURE MEASUREMENT^RT077
157 ;;CALL TO BEDSIDE/STAND-BY^RT078
158 ;;IPV THERAPY^RT079
159 ;;VEST THERAPY^RT080
160 ;;SPAG SYSTEM - SYSTEM SET-UP^RT081
161 ;;SPAG SYSTEM - PATIENT/SYSTEM CHECK^RT082
162 ;;HOME OXYGEN VISIT^RT083
163 ;;HOME OXYGEN EVALUATION - INITIAL^RT084
164 ;;HOME OXYGEN EVALUATION - FOLLOW-UP/RENEWAL^RT085
165 ;;PATIENT NOT AVAILABLE/REFUSAL OF TREATMENT^RT086
166 ;;CHECK STAND-BY EQUIPMENT^RT087
167 ;;SPEECH GEN DEV, DIG MSG >20 <=40M^SP501^E2504
168 ;;SPEECH GEN DEV, DIG MSG >40M^SP502^E2506
169 ;;QUIT
170NAMECHG ;* change national procedure names
171 ;
172 ; ECXX is in format:
173 ; NATIONAL NUMBER^NEW NAME
174 ;
175 N ECX,ECXX,ECDA,DA,DR,DIC,DIE,X,Y,STR
176 D MES^XPDUTL(" ")
177 D BMES^XPDUTL("Changing names in EC NATIONAL PROCEDURE File (#725)...")
178 D MES^XPDUTL(" ")
179 F ECX=1:1 S ECXX=$P($T(CHNG+ECX),";;",2) Q:ECXX="QUIT" D
180 .I $D(^EC(725,"D",$P(ECXX,U,1))) D
181 ..S ECDA=+$O(^EC(725,"D",$P(ECXX,U,1),0))
182 ..I $D(^EC(725,ECDA,0)) D
183 ...S DA=ECDA,DR=".01////^S X=$P(ECXX,U,2)",DIE="^EC(725," D ^DIE
184 ...D MES^XPDUTL(" ")
185 ...D MES^XPDUTL(" Entry #"_ECDA_" for "_$P(ECXX,U,1))
186 ...D BMES^XPDUTL(" ... field (#.01) updated to "_$P(ECXX,U,2)_".")
187 .I '$D(^EC(725,"D",$P(ECXX,U,1))) D
188 ..D MES^XPDUTL(" ")
189 ..S STR="Can't find entry for "_$P(ECXX,U,1)
190 ..D BMES^XPDUTL(STR_" ...field (#.01) not updated.")
191 Q
192 ;
193CHNG ;name changes -national code #^new procedure name
194 ;;SP456^SPEECH GEN DEV, DIG MSG <=8M^E2500
195 ;;SP457^SPEECH GEN DEV, DIG MSG >8 <=20M^E2502
196 ;;SP458^SPEECH GEN DEV, SYNTH, PHYS CONTACT^E2508
197 ;;SP459^SPEECH GEN DEV, MULT FORMULATION^E2510
198 ;;SP460^SPEECH GEN DEV, SFTWRE PC/PDA^E2511
199 ;;SP461^ACCESSORY FOR SGD, MOUNTING SYSTEM^E2512
200 ;;SP462^ACCESSORY FOR SGD, NOT OTHERWISE CLASSIFIED^E2599
201 ;;QUIT
Note: See TracBrowser for help on using the repository browser.