- ICPT60PR ;ALB/ABR - ICPT Pre-init Driver; 3/25/97
- ;;6.0;CPT/HCPCS;;May 19, 1997
- ;
- EN ; This routine will delete the DD and data for files #81 thru 81.5
- ;
- D BMES^XPDUTL("Both the data and data dictionary will be deleted for the following files:")
- D MES^XPDUTL("81 - CPT; 81.1 - CPT CATEGORY; 81.2 - CPT COPYRIGHT; and 81.3 - CPT MODIFIER")
- D BMES^XPDUTL("Files 81.4 - CPT MODIFIER CATEGORY and 81.5 - CPT SOURCE will be")
- D MES^XPDUTL("permanently deleted with this release.")
- ;
- D DELDD
- D DEL81
- D BMES^XPDUTL("... File data and DD deletions complete.")
- Q
- ;
- DELDD ; Delete DD'S, data for files 81.1-81.3
- N DIU
- S DIU="^DIC(81.1,",DIU(0)="" D EN^DIU2 K DIU
- D BMES^XPDUTL("File #81.1, CPT CATEGORY, has been deleted")
- S DIU="^DIC(81.2,",DIU(0)="" D EN^DIU2 K DIU
- D MES^XPDUTL("File #81.2, CPT COPYRIGHT has been deleted")
- S DIU="^DIC(81.3,",DIU(0)="" D EN^DIU2 K DIU
- D MES^XPDUTL("File #81.3, CPT MODIFIER has been deleted")
- S DIU="^DIC(81.4,",DIU(0)="" D EN^DIU2 K DIU
- D MES^XPDUTL("File #81.4, CPT MODIFIER CATEGORY has been permanently deleted.")
- S DIU="^DIC(81.5,",DIU(0)="" D EN^DIU2 K DIU
- D MES^XPDUTL("File #81.5, CPT SOURCE has been permanently deleted.")
- Q
- ;
- DEL81 ; Delete DD, Data for file 81 - CPT
- N X,ICPTZ,XPDIDTOT
- S XPDIDTOT=14000 ; # of entries in old CPT file
- D BMES^XPDUTL(">>> Deleting data and data dictionary for file #81, CPT...")
- ; delete DD for 81
- S DIU="^ICPT(",DIU(0)="" D EN^DIU2 K DIU
- ; delete data for 81 - leave 0-node to facilitate protection,
- ; global placement
- S X=0 F ICPTZ=1:1 S X=$O(^ICPT(X)) Q:X="" K ^ICPT(X) I '(ICPTZ#280) D UPDATE^XPDID(ICPTZ)
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICPT60PR 1661 printed Mar 13, 2025@20:50:04 Page 2
- ICPT60PR ;ALB/ABR - ICPT Pre-init Driver; 3/25/97
- +1 ;;6.0;CPT/HCPCS;;May 19, 1997
- +2 ;
- EN ; This routine will delete the DD and data for files #81 thru 81.5
- +1 ;
- +2 DO BMES^XPDUTL("Both the data and data dictionary will be deleted for the following files:")
- +3 DO MES^XPDUTL("81 - CPT; 81.1 - CPT CATEGORY; 81.2 - CPT COPYRIGHT; and 81.3 - CPT MODIFIER")
- +4 DO BMES^XPDUTL("Files 81.4 - CPT MODIFIER CATEGORY and 81.5 - CPT SOURCE will be")
- +5 DO MES^XPDUTL("permanently deleted with this release.")
- +6 ;
- +7 DO DELDD
- +8 DO DEL81
- +9 DO BMES^XPDUTL("... File data and DD deletions complete.")
- +10 QUIT
- +11 ;
- DELDD ; Delete DD'S, data for files 81.1-81.3
- +1 NEW DIU
- +2 SET DIU="^DIC(81.1,"
- SET DIU(0)=""
- DO EN^DIU2
- KILL DIU
- +3 DO BMES^XPDUTL("File #81.1, CPT CATEGORY, has been deleted")
- +4 SET DIU="^DIC(81.2,"
- SET DIU(0)=""
- DO EN^DIU2
- KILL DIU
- +5 DO MES^XPDUTL("File #81.2, CPT COPYRIGHT has been deleted")
- +6 SET DIU="^DIC(81.3,"
- SET DIU(0)=""
- DO EN^DIU2
- KILL DIU
- +7 DO MES^XPDUTL("File #81.3, CPT MODIFIER has been deleted")
- +8 SET DIU="^DIC(81.4,"
- SET DIU(0)=""
- DO EN^DIU2
- KILL DIU
- +9 DO MES^XPDUTL("File #81.4, CPT MODIFIER CATEGORY has been permanently deleted.")
- +10 SET DIU="^DIC(81.5,"
- SET DIU(0)=""
- DO EN^DIU2
- KILL DIU
- +11 DO MES^XPDUTL("File #81.5, CPT SOURCE has been permanently deleted.")
- +12 QUIT
- +13 ;
- DEL81 ; Delete DD, Data for file 81 - CPT
- +1 NEW X,ICPTZ,XPDIDTOT
- +2 ; # of entries in old CPT file
- SET XPDIDTOT=14000
- +3 DO BMES^XPDUTL(">>> Deleting data and data dictionary for file #81, CPT...")
- +4 ; delete DD for 81
- +5 SET DIU="^ICPT("
- SET DIU(0)=""
- DO EN^DIU2
- KILL DIU
- +6 ; delete data for 81 - leave 0-node to facilitate protection,
- +7 ; global placement
- +8 SET X=0
- FOR ICPTZ=1:1
- SET X=$ORDER(^ICPT(X))
- if X=""
- QUIT
- KILL ^ICPT(X)
- IF '(ICPTZ#280)
- DO UPDATE^XPDID(ICPTZ)
- +9 QUIT
- +10 ;
