AUM91P2.m

AUM91P2 ;IHS/SD/SDR - Data removal from ICD Expanded field ; [ 08/18/2003  11:02 AM ]

 ;;10.2;TABLE MAINTENANCE;;MAR 09, 2010

START ;EP

 K AUMFLG

 S AUMI=0

 W !!,"Removing data from ICD EXPANDED field of ICD DX file..."

 F  S AUMI=$O(^ICD9(AUMI)) Q:'AUMI  D

 .I $P($G(^ICD9(AUMI,0)),U,8)=1 D

 ..W !?3,$P($G(^ICD9(AUMI,0)),U),?13,$P($G(^ICD9(AUMI,0)),U,8)

 ..K DIC,DIE,DIR,X,Y,DA,DR

 ..S DIE="^ICD9("

 ..S DA=AUMI

 ..S DR="8////@"

 ..D ^DIE

 ..S AUMFLG=1

 I +$G(AUMFLG)'=1 W !?3,"No data found"

 ;

 K AUMFLG

 S AUMI=0

 W !!,"Removing data from ICD EXPANDED field of ICD PX file..."

 F  S AUMI=$O(^ICD0(AUMI)) Q:'AUMI  D

 .I $P($G(^ICD0(AUMI,0)),U,8)=1 D

 ..W !?3,$P($G(^ICD0(AUMI,0)),U),?13,$P($G(^ICD0(AUMI,0)),U,8)

 ..K DIC,DIE,DIR,X,Y,DA,DR

 ..S DIE="^ICD0("

 ..S DA=AUMI

 ..S DR="8////@"

 ..D ^DIE

 ..S AUMFLG=1

 I +$G(AUMFLG)'=1 W !?3,"No data found"

 Q

AUM91P2   ;IHS/SD/SDR - Data removal from ICD Expanded field ; [ 08/18/2003  11:02 AM ]

 +1       ;;10.2;TABLE MAINTENANCE;;MAR 09, 2010

START     ;EP

 +1        KILL AUMFLG

 +2        SET AUMI=0

 +3        WRITE !!,"Removing data from ICD EXPANDED field of ICD DX file..."

 +4        FOR 

               SET AUMI=$ORDER(^ICD9(AUMI))

               IF 'AUMI

                   QUIT 

               Begin DoDot:1

 +5                IF $PIECE($GET(^ICD9(AUMI,0)),U,8)=1

                       Begin DoDot:2

 +6                        WRITE !?3,$PIECE($GET(^ICD9(AUMI,0)),U),?13,$PIECE($GET(^ICD9(AUMI,0)),U,8)

 +7                        KILL DIC,DIE,DIR,X,Y,DA,DR

 +8                        SET DIE="^ICD9("

 +9                        SET DA=AUMI

 +10                       SET DR="8////@"

 +11                       DO ^DIE

 +12                       SET AUMFLG=1

                       End DoDot:2

               End DoDot:1

 +13       IF +$GET(AUMFLG)'=1

               WRITE !?3,"No data found"

 +14      ;

 +15       KILL AUMFLG

 +16       SET AUMI=0

 +17       WRITE !!,"Removing data from ICD EXPANDED field of ICD PX file..."

 +18       FOR 

               SET AUMI=$ORDER(^ICD0(AUMI))

               IF 'AUMI

                   QUIT 

               Begin DoDot:1

 +19               IF $PIECE($GET(^ICD0(AUMI,0)),U,8)=1

                       Begin DoDot:2

 +20                       WRITE !?3,$PIECE($GET(^ICD0(AUMI,0)),U),?13,$PIECE($GET(^ICD0(AUMI,0)),U,8)

 +21                       KILL DIC,DIE,DIR,X,Y,DA,DR

 +22                       SET DIE="^ICD0("

 +23                       SET DA=AUMI

 +24                       SET DR="8////@"

 +25                       DO ^DIE

 +26                       SET AUMFLG=1

                       End DoDot:2

               End DoDot:1

 +27       IF +$GET(AUMFLG)'=1

               WRITE !?3,"No data found"

 +28       QUIT