| 1 | ICPT60PR ;ALB/ABR - ICPT Pre-init Driver; 3/25/97
|
|---|
| 2 | ;;6.0;CPT/HCPCS;;May 19, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | EN ; 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 | ;
|
|---|
| 16 | DELDD ; 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 | ;
|
|---|
| 30 | DEL81 ; 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 | ;
|
|---|
