source: WorldVistAEHR/trunk/r/VISTA_OFFICE_EHR-VEPE/VEPERCPT.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: 781 bytes
RevLine 
[613]1VEPERCPT ;RED/DAOU ; 8/1/05 7:30pm
2 ;;1.0;Code to clean out CPT codes;;;Build 1
3 ;REMOVE COPYRIGHTED CPT FILES' DATA
4 W !,"Removing CPT code data now",!
5 K ^ICPT S ^ICPT(0)="CPT^81I"
6 K ^DIC(81.1) S ^DIC(81.1,0)="CPT CATEGORY^81.1",^(0,"GL")="^DIC(81.1,"
7 K ^DIC(81.3) S ^DIC(81.3,0)="CPT MODIFIER^81.3I",^(0,"GL")="^DIC(81.3,"
8 S %=$P(^DD(757.02,1,0),U,2) I %'="RF" W !,"757.02,1 has changed" Q
9 S $P(^DD(757.02,1,0),U,2)="F"
10 S %=$P(^DD(757.02,2,0),U,2) I %'="RP757.03'" W !,"757.02,2 has changed" Q
11 S $P(^DD(757.02,2,0),U,2)="P757.03'"
12 S DA=0,DIE=757.02,DR="1///@;2///@"
13 F S DA=$O(^LEX(757.02,DA)) Q:DA'>0 D
14 . S %=$P($G(^LEX(757.02,DA,0)),U,3)
15 . I %=3!(%=4) D ^DIE
16 . Q
17 S $P(^DD(757.02,1,0),U,2)="RF"
18 S $P(^DD(757.02,2,0),U,2)="RP757.03'"
19 W !,"CPT Codes removed",!
20 Q
Note: See TracBrowser for help on using the repository browser.