source: WorldVistAEHR/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/EC725CH7.m@ 1800

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

initial load of WorldVistAEHR

File size: 1.9 KB
RevLine 
[613]1EC725CH7 ;ALB/GTS/JAP - EC National Procedure Update; 10/28/98
2 ;;2.0; EVENT CAPTURE ;**16**;8 May 96
3 ;
4 ;this routine is used as a post-init in KIDS build
5 ;to modify the the EC National Procedure file #725
6 ;
7INACT ;* inactivate national procedures
8 ;
9 ; ECXX is in format:
10 ; NATIONAL NUMBER^INACTIVATION DATE
11 ;
12 N ECX,ECXX,ECEXDT,ECINDT,ECDA,DIC,DIE,DA,DR,X,Y,%DT
13 D MES^XPDUTL(" ")
14 D BMES^XPDUTL("Inactivating procedures EC NATIONAL PROCEDURE File (#725)...")
15 D MES^XPDUTL(" ")
16 F ECX=1:1 K DD,DO,DA S ECXX=$P($T(OLD+ECX),";;",2) Q:ECXX="QUIT" D
17 .S ECEXDT=$P(ECXX,U,2)
18 .S X=ECEXDT
19 .S %DT="X" D ^%DT
20 .S ECINDT=$P(Y,".",1)
21 .S ECDA=+$O(^EC(725,"D",$P(ECXX,U,1),0))
22 .I $D(^EC(725,ECDA,0)) D
23 ..S DA=ECDA,DR="2////^S X=ECINDT",DIE="^EC(725," D ^DIE
24 ..D MES^XPDUTL(" ")
25 ..D BMES^XPDUTL(" "_$P(ECXX,U,1)_" inactivated as of "_ECEXDT_".")
26 Q
27 ;
28OLD ;national procedures to be inactivated
29 ;;SP002^1/1/1999
30 ;;SP122^1/1/1999
31 ;;SP135^1/1/1999
32 ;;SP136^1/1/1999
33 ;;SP138^1/1/1999
34 ;;SP141^1/1/1999
35 ;;SP146^1/1/1999
36 ;;SP151^1/1/1999
37 ;;SP156^1/1/1999
38 ;;SP161^1/1/1999
39 ;;SP169^1/1/1999
40 ;;SP232^1/1/1999
41 ;;SP240^1/1/1999
42 ;;SP243^1/1/1999
43 ;;SP244^1/1/1999
44 ;;SP250^1/1/1999
45 ;;SP251^1/1/1999
46 ;;SP252^1/1/1999
47 ;;QUIT
48 ;
49CPTCHG ;* change cpt codes
50 ;
51 ; ECXX is in format:
52 ; NATIONAL NUMBER^NEW CPT
53 ;
54 N ECX,ECXX,CPT,DIC,DIE,DA,DR,X,Y
55 D MES^XPDUTL(" ")
56 D BMES^XPDUTL("Changing CPT Codes in EC NATIONAL PROCEDURE file (#725)...")
57 D MES^XPDUTL(" ")
58 F ECX=1:1 S ECXX=$P($T(CPT+ECX),";;",2) Q:ECXX="QUIT" S CPT($P(ECXX,U,1))=$P(ECXX,U,2)
59 S ECXX=""
60 F S ECXX=$O(CPT(ECXX)) Q:ECXX="" D
61 .S ECX=$O(^EC(725,"D",ECXX,0))
62 .Q:+ECX=0
63 .Q:'$D(^EC(725,ECX,0))
64 .S CPT=CPT(ECXX)
65 .S DA=ECX,DR="4////"_CPT,DIE="^EC(725," D ^DIE
66 .D MES^XPDUTL(" ")
67 .D BMES^XPDUTL(" Entry #"_ECX_" for "_ECXX)
68 .D BMES^XPDUTL(" ...updated to use CPT code "_CPT_".")
69 Q
70 ;
71CPT ;cpt codes to be changed
72 ;;SP037^97703
73 ;;SP038^97703
74 ;;QUIT
Note: See TracBrowser for help on using the repository browser.