ADE6P193.m

ADE6P193 ;IHS/OIT/ENM - ADE6.0 PATCH 19 REACTIVATE ADA REC [ 04/23/2009  10:51 AM ]

 ;;6.0;ADE;**19**;MAR 25, 1999

 ;

ZAPINA ;EP

 D E1,E2

 Q

E1 ;REMOVE INACTIVE DATE FOR ADA RECORD 4268

 S ADEIRN=""

 S ADEIRN=$O(^AUTTADA("B",4268,0)) I +ADEIRN D ZAPIT

 K D,DA,DR,DIE,D0,DIC,ADEIRN

 Q

ZAPIT ;

 S DIE="^AUTTADA(",DA=ADEIRN

 S DR=".08////@" D ^DIE

 Q

E2 ;Remove Synonym and Mnemonic from 4 records in the Dent Operative Site File

 S ADEORN=""

 S ADEORN=$O(^ADEOPS("B","SUPRANUMERY #1",0)) I +ADEORN D ZAPOS

 S ADEORN=$O(^ADEOPS("B","SUPRANUMERY #2",0)) I +ADEORN D ZAPOS

 S ADEORN=$O(^ADEOPS("B","SUPRANUMERY #3",0)) I +ADEORN D ZAPOS

 S ADEORN=$O(^ADEOPS("B","SUPRANUMERY #4",0)) I +ADEORN D ZAPOS

 K D,DA,DR,DIE,D0,DIC,ADEORN

 Q

ZAPOS ;

 S DIE="^ADEOPS(",DA=ADEORN

 S DR="8801////@"_";8802////@" D ^DIE

 Q

ADE6P193  ;IHS/OIT/ENM - ADE6.0 PATCH 19 REACTIVATE ADA REC [ 04/23/2009  10:51 AM ]

 +1       ;;6.0;ADE;**19**;MAR 25, 1999

 +2       ;

ZAPINA    ;EP

 +1        DO E1

           DO E2

 +2        QUIT 

E1        ;REMOVE INACTIVE DATE FOR ADA RECORD 4268

 +1        SET ADEIRN=""

 +2        SET ADEIRN=$ORDER(^AUTTADA("B",4268,0))

           IF +ADEIRN

               DO ZAPIT

 +3        KILL D,DA,DR,DIE,D0,DIC,ADEIRN

 +4        QUIT 

ZAPIT     ;

 +1        SET DIE="^AUTTADA("

           SET DA=ADEIRN

 +2        SET DR=".08////@"

           DO ^DIE

 +3        QUIT 

E2        ;Remove Synonym and Mnemonic from 4 records in the Dent Operative Site File

 +1        SET ADEORN=""

 +2        SET ADEORN=$ORDER(^ADEOPS("B","SUPRANUMERY #1",0))

           IF +ADEORN

               DO ZAPOS

 +3        SET ADEORN=$ORDER(^ADEOPS("B","SUPRANUMERY #2",0))

           IF +ADEORN

               DO ZAPOS

 +4        SET ADEORN=$ORDER(^ADEOPS("B","SUPRANUMERY #3",0))

           IF +ADEORN

               DO ZAPOS

 +5        SET ADEORN=$ORDER(^ADEOPS("B","SUPRANUMERY #4",0))

           IF +ADEORN

               DO ZAPOS

 +6        KILL D,DA,DR,DIE,D0,DIC,ADEORN

 +7        QUIT 

ZAPOS     ;

 +1        SET DIE="^ADEOPS("

           SET DA=ADEORN

 +2        SET DR="8801////@"_";8802////@"

           DO ^DIE

 +3        QUIT