BLSRLC.m

BLSRLC ; IHS/CMI/LAB - wipe out all loinc codes ; [ 11/19/2002  8:26 AM ]

 ;;5.2;LR;**1015**;NOV 18, 2002

 ;

 W !!,"This routine will remove all loinc codes from file 60.",!

 S DIR(0)="Y",DIR("A")="Do you want to continue",DIR("B")="N" KILL DA D ^DIR KILL DIR

 Q:$D(DIRUT)

 Q:'Y

 S BLSX=0 F  S BLSX=$O(^LAB(60,BLSX)) Q:BLSX'=+BLSX  D

 .S BLSS=0 F  S BLSS=$O(^LAB(60,BLSX,1,BLSS)) Q:BLSS'=+BLSS  D

 ..I '$D(^LAB(60,BLSX,1,BLSS,95.3)) Q  ;no loinc code

 ..W ".",BLSX

 ..S DA(1)=BLSX,DA=BLSS,DIE="^LAB(60,"_BLSX_",1,",DR="95.3///@" D ^DIE

 ..I $D(Y) Q

 ..Q

 .Q

 W !!,"Loinc codes have been removed from file 60."

 Q

BLSRLC    ; IHS/CMI/LAB - wipe out all loinc codes ; [ 11/19/2002  8:26 AM ]

 +1       ;;5.2;LR;**1015**;NOV 18, 2002

 +2       ;

 +3        WRITE !!,"This routine will remove all loinc codes from file 60.",!

 +4        SET DIR(0)="Y"

           SET DIR("A")="Do you want to continue"

           SET DIR("B")="N"

           KILL DA

           DO ^DIR

           KILL DIR

 +5        IF $DATA(DIRUT)

               QUIT 

 +6        IF 'Y

               QUIT 

 +7        SET BLSX=0

           FOR 

               SET BLSX=$ORDER(^LAB(60,BLSX))

               IF BLSX'=+BLSX

                   QUIT 

               Begin DoDot:1

 +8                SET BLSS=0

                   FOR 

                       SET BLSS=$ORDER(^LAB(60,BLSX,1,BLSS))

                       IF BLSS'=+BLSS

                           QUIT 

                       Begin DoDot:2

 +9       ;no loinc code

                           IF '$DATA(^LAB(60,BLSX,1,BLSS,95.3))

                               QUIT 

 +10                       WRITE ".",BLSX

 +11                       SET DA(1)=BLSX

                           SET DA=BLSS

                           SET DIE="^LAB(60,"_BLSX_",1,"

                           SET DR="95.3///@"

                           DO ^DIE

 +12                       IF $DATA(Y)

                               QUIT 

 +13                       QUIT 

                       End DoDot:2

 +14               QUIT 

               End DoDot:1

 +15       WRITE !!,"Loinc codes have been removed from file 60."

 +16       QUIT