SROASWPD.m

SROASWPD ;B'HAM ISC/MAM - REMOVE CONVERSION OPTION ; 28 APR 1992

 ;;3.0; Surgery ;;24 Jun 93

 I $O(^SRA(0)) Q

DEL W !!,"Queuing task to delete all SRA options from your system."

 S ZTRTN="SRA^SROASWPD",ZTDESC="Delete all SRA options from OPTION file (19)",ZTIO="",ZTDTH=$H D ^%ZTLOAD K ZTSK

 S SRISK=$O(^DIC(19,"B","SROA RISK ASSESSMENT",0)) I 'SRISK Q

 S SRCONV=$O(^DIC(19,"B","SROA CONVERT",0)) I 'SRCONV Q

 S INT=$O(^DIC(19,SRISK,10,"B",SRCONV,0)) I 'INT Q

 W !!,"This option will self destruct now..."

 K DA,DIK S DA(1)=SRISK,DA=INT,DIK="^DIC(19,"_DA(1)_",10," D ^DIK K DA,DIK S DA=SRCONV,DIK="^DIC(19," D ^DIK

 Q

SRA S SROPT="SRA" F  S SROPT=$O(^DIC(19,"B",SROPT)) Q:$E(SROPT,1,3)'="SRA"  D CLEAN

 S ZTREQ="@"

 Q

CLEAN ; remove option from any menu

 S SRIFN=$O(^DIC(19,"B",SROPT,0)) S SHEMP=0 F  S SHEMP=$O(^DIC(19,"AD",SRIFN,SHEMP)) Q:'SHEMP  K DA,DIK S DA(1)=SHEMP,DA=$O(^DIC(19,"AD",SRIFN,SHEMP,0)),DIK="^DIC(19,"_DA(1)_",10," D ^DIK

 K DA,DIK S DA=SRIFN,DIK="^DIC(19," D ^DIK

 Q

SROASWPD  ;B'HAM ISC/MAM - REMOVE CONVERSION OPTION ; 28 APR 1992

 +1       ;;3.0; Surgery ;;24 Jun 93

 +2        IF $ORDER(^SRA(0))

               QUIT 

DEL        WRITE !!,"Queuing task to delete all SRA options from your system."

 +1        SET ZTRTN="SRA^SROASWPD"

           SET ZTDESC="Delete all SRA options from OPTION file (19)"

           SET ZTIO=""

           SET ZTDTH=$HOROLOG

           DO ^%ZTLOAD

           KILL ZTSK

 +2        SET SRISK=$ORDER(^DIC(19,"B","SROA RISK ASSESSMENT",0))

           IF 'SRISK

               QUIT 

 +3        SET SRCONV=$ORDER(^DIC(19,"B","SROA CONVERT",0))

           IF 'SRCONV

               QUIT 

 +4        SET INT=$ORDER(^DIC(19,SRISK,10,"B",SRCONV,0))

           IF 'INT

               QUIT 

 +5        WRITE !!,"This option will self destruct now..."

 +6        KILL DA,DIK

           SET DA(1)=SRISK

           SET DA=INT

           SET DIK="^DIC(19,"_DA(1)_",10,"

           DO ^DIK

           KILL DA,DIK

           SET DA=SRCONV

           SET DIK="^DIC(19,"

           DO ^DIK

 +7        QUIT 

SRA        SET SROPT="SRA"

           FOR 

               SET SROPT=$ORDER(^DIC(19,"B",SROPT))

               IF $EXTRACT(SROPT,1,3)'="SRA"

                   QUIT 

               DO CLEAN

 +1        SET ZTREQ="@"

 +2        QUIT 

CLEAN     ; remove option from any menu

 +1        SET SRIFN=$ORDER(^DIC(19,"B",SROPT,0))

           SET SHEMP=0

           FOR 

               SET SHEMP=$ORDER(^DIC(19,"AD",SRIFN,SHEMP))

               IF 'SHEMP

                   QUIT 

               KILL DA,DIK

               SET DA(1)=SHEMP

               SET DA=$ORDER(^DIC(19,"AD",SRIFN,SHEMP,0))

               SET DIK="^DIC(19,"_DA(1)_",10,"

               DO ^DIK

 +2        KILL DA,DIK

           SET DA=SRIFN

           SET DIK="^DIC(19,"

           DO ^DIK

 +3        QUIT