source: WorldVistAEHR/trunk/r/SURGERY-SR/SROASWPD.m@ 660

Last change on this file since 660 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 988 bytes
RevLine 
[613]1SROASWPD ;B'HAM ISC/MAM - REMOVE CONVERSION OPTION ; 28 APR 1992
2 ;;3.0; Surgery ;;24 Jun 93
3 I $O(^SRA(0)) Q
4DEL W !!,"Queuing task to delete all SRA options from your system."
5 S ZTRTN="SRA^SROASWPD",ZTDESC="Delete all SRA options from OPTION file (19)",ZTIO="",ZTDTH=$H D ^%ZTLOAD K ZTSK
6 S SRISK=$O(^DIC(19,"B","SROA RISK ASSESSMENT",0)) I 'SRISK Q
7 S SRCONV=$O(^DIC(19,"B","SROA CONVERT",0)) I 'SRCONV Q
8 S INT=$O(^DIC(19,SRISK,10,"B",SRCONV,0)) I 'INT Q
9 W !!,"This option will self destruct now..."
10 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
11 Q
12SRA S SROPT="SRA" F S SROPT=$O(^DIC(19,"B",SROPT)) Q:$E(SROPT,1,3)'="SRA" D CLEAN
13 S ZTREQ="@"
14 Q
15CLEAN ; remove option from any menu
16 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
17 K DA,DIK S DA=SRIFN,DIK="^DIC(19," D ^DIK
18 Q
Note: See TracBrowser for help on using the repository browser.