VEPECPT ;RED/DAOU - CPT Patch for VOE Version 1 ; 8/2/05 10:31am
 ;;1.0;VOE;****;Aug 20, 20005
 ;Routine to display CPT disclaimer and load CPT codes into VOE ver 1
 ;
 I $P(^ICPT(0),"^",3)>107900 W $C(7),!?15,"CPT Codes exist, quitting",$C(7),!! Q
CPT ;  Enter CPT Codes
 N TEXT,END,INP S TEXT="" W #
 F LP=1:1 S TEXT=$T(TEXT+LP) Q:TEXT=" ;;;;"  W !,$P(TEXT,";;",2) I LP=23 R !,"Enter key to continue",INP#1 W #
 R !,"Enter key to continue",INP#1 W #
 ; Instructions for installing the global
 W !,"You will be asked for a device, this is the location of the file"
 W !,"and the file name. For example (if the zip file was extracted to the",!,"Temp directory): C:\TEMP\ICPT.GLO"
 W !,"When asked for Parameters, accept the default 'RS' (press enter key)."
 W !,"When asked for Input Option, type an A for ALL and press the enter key",!
 R !,"Press any key to install the CPT Patch",INP#1
 W !! D ^%GI
 ; Merger the scratch globals and kill them
 M ^DIC(81.1)=^ZDIC(81.1) K DIC(81.1)
 M ^DIC(81.3)=^ZDIC(81.3) K DIC(81.3)
 M ^LEX(757)=^ZZZ(757) K LEX(757)
 M ^LEX(757.001)=^ZZZ(757.001) K LEX(757.001)
 M ^LEX(757.01)=^ZZZ(757.01) K LEX(757.01)
 M ^LEX(757.02)=^ZZZ(757.02) K LEX(757.02)
 M ^LEX(757.1)=^ZZZ(757.1) K LEX(757.1)
 M ^LEX(757.11)=^ZZZ(757.11) K LEX(757.11)
 M ^LEX(757.12)=^ZZZ(757.12) K LEX(757.12)
 M ^LEX(757.13)=^ZZZ(757.13) K LEX(757.13)
 M ^LEX(757.14)=^ZZZ(757.14) K LEX(757.14)
 M ^LEX(757.21)=^ZZZ(757.21) K LEX(757.21)
 M ^LEX(757.3)=^ZZZ(757.3) K LEX(757.3)
 M ^LEX(757.31)=^ZZZ(757.31) K LEX(757.31)
 M ^LEX(757.4)=^ZZZ(757.4) K LEX(757.4)
 M ^LEX(757.41)=^ZZZ(757.41) K LEX(757.41)
 ; Check for success/failure
 I $P(^ICPT(0),"^",3)'>107900  W !,$C(7),"The CPT Patch has failed!" H 10 Q
 K ^ZZZ,^ZDIC
 W !,"The CPT Patch has been applied successfully" H 5 W !!
 Q
 ;  Text for CPT Copyright
TEXT ;;
 ;;CPT IS COPYRIGHT 2004 AMERICAN MEDICAL ASSOCIATION. ALL RIGHTS RESERVED.
 ;;NO FEE SCHEDULES, BASIC UNITS, RELATIVE VALUES OR RELATED LISTINGS ARE 
 ;;INCLUDED IN CPT. AMA DOES NOT DIRECTLY OR INDIRECTLY PRACTICE MEDICINE OR 
 ;;DISPENSE MEDICAL SERVICES. AMA ASSUMES NO LIABILITY FOR DATA CONTAINED OR 
 ;;NOT CONTAINED HEREIN.
 ;;
 ;;U.S. GOVERNMENT RIGHTS THIS PRODUCT INCLUDES CPT WHICH IS COMMERCIAL 
 ;;TECHNICAL DATA AND/OR COMPUTER DATA BASES AND/OR COMMERCIAL COMPUTER 
 ;;SOFTWARE AND/OR COMPUTER SOFTWARE DOCUMENTATION, AS APPLICABLE WHICH 
 ;;WERE DEVELOPED EXCLUSIVELY AT PRIVATE EXPENSE BY THE AMERICAN MEDICAL 
 ;;ASSOCIATION, 515 NORTH STATE STREET, CHICAGO, ILLINOIS, 60610.  U.S. 
 ;;GOVERNMENT RIGHTS TO USE, MODIFY, REPRODUCE, RELEASE, PERFORM, DISPLAY, 
 ;;OR DISCLOSE THESE TECHNICAL DATA AND/OR COMPUTER DATA BASES AND/OR
 ;;COMPUTER SOFTWARE AND/OR COMPUTER SOFTWARE DOCUMENTATION ARE 
 ;;SUBJECT TO THE LIMITED RIGHTS RESTRICTIONS OF DFARS 252.227-7015(b)(2) (JUNE 
 ;;1995) AND/OR SUBJECT TO THE RESTRICTIONS OF DFARS 227.7202-1(a) (JUNE 1995) 
 ;;AND DFARS 227.7202-3(a) (JUNE 1995), AS APPLICABLE, FOR U.S. DEPARTMENT 
 ;;DEFENSE PROCUREMENTS AND THE LIMITED RIGHTS RESTRICTIONS OF FAR 52.227-14 
 ;;(JUNE 1987) AND/OR SUBJECT TO THE RESTRICTED RIGHTS PROVISIONS OF 
 ;;52.227-14 (JUNE 1987) AND FAR 52.227-19 (JUNE 1987),AS APPLICABLE, AND ANY 
 ;;APPLICABLE AGENCY FAR SUPPLEMENTS, FOR NON-DEPARTMENT OF DEFENSE 
 ;;FEDERAL PROCUREMENTS.
 ;;
 ;;THIS CD-ROM/DISKETTE/ELECTRONIC FILE MAY NOT BE SOLD, DUPLICATED, OR GIVEN 
 ;;AWAY IN WHOLE OR IN PART WITHOUT THE EXPRESS WRITTEN CONSENT OF THE 
 ;;AMERICAN MEDICAL ASSOCIATION. THIS CPT CD-ROM/DISKETTE/ELECTRONIC FILE 
 ;;INCLUDES ALL CPT PROCEDURES IN CPT 2004.
 ;;
 ;;FOR QUESTIONS REGARDING THE USE OF CPT CODES, PLEASE CONTACT THE 
 ;;AMERICAN MEDICAL ASSOCIATION CPT INFORMATION AND EDUCATION SERVICES AT 
 ;;800-634-6922.
 ;;
 ;;TO PURCHASE ADDITIONAL CPT PRODUCTS, CONTACT THE AMERICAN MEDICAL 
 ;;ASSOCIATION CUSTOMER SERVICE AT 800-621-8335.
 ;;
 ;;TO REQUEST A LICENSE FOR DISTRIBUTION OF PRODUCTS CONTAINING OR 
 ;;REPRINTING CPT, PLEASE CONTACT THE AMERICAN MEDICAL ASSOCIATION CPT 
 ;;INTELLECTUAL PROPERTY SERVICES, 515 N. STATE STREET, CHICAGO, ILLINOIS 60610, 
 ;;312 464-5022.
 ;;;;