source: FOIAVistA/trunk/r/CPT_HCPCS_CODES-ICPT-DGYA/ICPT60PR.m@ 1119

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

initial load of FOIAVistA 6/30/08 version

File size: 1.6 KB
Line 
1ICPT60PR ;ALB/ABR - ICPT Pre-init Driver; 3/25/97
2 ;;6.0;CPT/HCPCS;;May 19, 1997
3 ;
4EN ; This routine will delete the DD and data for files #81 thru 81.5
5 ;
6 D BMES^XPDUTL("Both the data and data dictionary will be deleted for the following files:")
7 D MES^XPDUTL("81 - CPT; 81.1 - CPT CATEGORY; 81.2 - CPT COPYRIGHT; and 81.3 - CPT MODIFIER")
8 D BMES^XPDUTL("Files 81.4 - CPT MODIFIER CATEGORY and 81.5 - CPT SOURCE will be")
9 D MES^XPDUTL("permanently deleted with this release.")
10 ;
11 D DELDD
12 D DEL81
13 D BMES^XPDUTL("... File data and DD deletions complete.")
14 Q
15 ;
16DELDD ; Delete DD'S, data for files 81.1-81.3
17 N DIU
18 S DIU="^DIC(81.1,",DIU(0)="" D EN^DIU2 K DIU
19 D BMES^XPDUTL("File #81.1, CPT CATEGORY, has been deleted")
20 S DIU="^DIC(81.2,",DIU(0)="" D EN^DIU2 K DIU
21 D MES^XPDUTL("File #81.2, CPT COPYRIGHT has been deleted")
22 S DIU="^DIC(81.3,",DIU(0)="" D EN^DIU2 K DIU
23 D MES^XPDUTL("File #81.3, CPT MODIFIER has been deleted")
24 S DIU="^DIC(81.4,",DIU(0)="" D EN^DIU2 K DIU
25 D MES^XPDUTL("File #81.4, CPT MODIFIER CATEGORY has been permanently deleted.")
26 S DIU="^DIC(81.5,",DIU(0)="" D EN^DIU2 K DIU
27 D MES^XPDUTL("File #81.5, CPT SOURCE has been permanently deleted.")
28 Q
29 ;
30DEL81 ; Delete DD, Data for file 81 - CPT
31 N X,ICPTZ,XPDIDTOT
32 S XPDIDTOT=14000 ; # of entries in old CPT file
33 D BMES^XPDUTL(">>> Deleting data and data dictionary for file #81, CPT...")
34 ; delete DD for 81
35 S DIU="^ICPT(",DIU(0)="" D EN^DIU2 K DIU
36 ; delete data for 81 - leave 0-node to facilitate protection,
37 ; global placement
38 S X=0 F ICPTZ=1:1 S X=$O(^ICPT(X)) Q:X="" K ^ICPT(X) I '(ICPTZ#280) D UPDATE^XPDID(ICPTZ)
39 Q
40 ;
Note: See TracBrowser for help on using the repository browser.