source: FOIAVistA/trunk/r/SOCIAL_WORK-SOW-SWBH-SWFG/SOWKOPT.m@ 1002

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

initial load of FOIAVistA 6/30/08 version

File size: 2.4 KB
Line 
1SOWKOPT ;B'HAM ISC/SAB-ROUTINE TO DELETE OPTIONS AND TEMPLATES IN OLD NAMESPACE ; 02/10/92 13:30
2 ;;3.0; Social Work ;**49**;27 Apr 93
3 W !!,*7,"DELETING OLD NAMESPACE (SW) SORT TEMPLATES...",!!
4 S DIK="^DIBT(",OPT="SW" F I=0:0 S OPT=$O(^DIBT("B",OPT)) Q:$E(OPT,1,2)'="SW"!(OPT="") F T=0:0 S T=$O(^DIBT("B",OPT,T)) Q:'T I $D(^DIBT(T)),$P(^DIBT(T,0),"^",4)'<650,$P(^(0),"^",4)'>656 S DA=T D ^DIK W !,OPT_" Sort Template...<DELETED>"
5 W !!,*7,"DELETING OLD NAMESPACE (SW) INPUT TEMPLATES...",!!
6 S DIK="^DIE(",OPT="SW" F I=0:0 S OPT=$O(^DIE("B",OPT)) Q:$E(OPT,1,2)'="SW"!(OPT="") F T=0:0 S T=$O(^DIE("B",OPT,T)) Q:'T I $D(^DIE(T)),$P(^DIE(T,0),"^",4)'<650,$P(^(0),"^",4)'>656 S DA=T D ^DIK W !,OPT_" Input Temple...<DELETED>"
7 W !!,*7,"DELETING OLD NAMESPACE (SW) PRINT TEMPLATES...",!!
8 S DIK="^DIPT(",OPT="SW" F I=0:0 S OPT=$O(^DIPT("B",OPT)) Q:$E(OPT,1,2)'="SW"!(OPT="") F T=0:0 S T=$O(^DIPT("B",OPT,T)) Q:'T I $D(^DIPT(T)),$P(^DIPT(T,0),"^",4)'<650,$P(^(0),"^",4)'>656 S DA=T D ^DIK W !,OPT_" Print Template...<DELETED>"
9 W !!,*7,"DELETING OLD NAMESPACE (SW) OPTIONS...",!!
10 S DIK="^DIC(19,",OPT="SW" F I=0:0 S OPT=$O(^DIC(19,"B",OPT)) Q:$E(OPT,1,2)'="SW"!(OPT="") F T=0:0 S T=$O(^DIC(19,"B",OPT,T)) Q:'T I $E(OPT,1,4)'="SWFG",$E(OPT,1,3)'="SWZ" S DA=T D ^DIK W !,OPT_" Menu Option...<DELETED>"
11 W !!,*7,"DELETING OBSOLETE OPTIONS...",!!
12 S DIK="^DIC(19," F OPT="SOWKDPP","SOWKDPPD","SOWKPDR","SOWKPDRD","SOWKARSC","SOWKDBPRO" S DA=$O(^DIC(19,"B",OPT,0)) I DA D ^DIK W !,OPT_" Menu Option...<DELETED>"
13 S DIK="^DIC(19," F OPT="SOWKARSCTRANS","SOWKARSD","SOWKARSDEL","SOWKARSDEL1","SOWKARSM","SOWKARSN","SOWKARSQ","SOWKARSR","SOWKARST","SOWKARSTRANS","SOWKARSTRC" S DA=$O(^DIC(19,"B",OPT,0)) I DA D ^DIK W !,OPT_" Menu Option...<DELETED>"
14 K DIK,OPT,DA,I,T Q
15WRK S ^VA(200,DA,654)=1_"^"_IMM_"^"_NUM_"^^"_POS
16 S:IMM ^VA(200,"ASWC",IMM,DA)="" S ^VA(200,"ASWB",DA,DA)="" S:NUM ^VA(200,"ASWD",NUM,DA)="" S:POS=1!(POS=2)!(POS=3) ^VA(200,"ASWE",DA,POS)=""
17 Q
18XREF ;Entry point to re-index 'CP' and 'BS5' x-refs in file #650 for lookups
19 W !! S ZTIO="",ZTDESC="Option to re-index the 'CP' and 'BS5' x-refs in file #650",ZTRTN="XRF^SOWKOPT" D ^%ZTLOAD
20 W:$D(ZTSK) *7,!!,"Option QUEUED to run" K ZTSK Q
21XRF K ^SOWK(650,"CP"),^("BS5")
22 F DA=0:0 S DA=$O(^SOWK(650,DA)) Q:'DA I '$P(^SOWK(650,DA,0),"^",2)!'$P(^(0),"^",3)!'$P(^(0),"^",13) S DIK="^SOWK(650," D ^DIK
23 F DA=0:0 S DA=$O(^SOWK(650,DA)) Q:'DA S X=$P(^SOWK(650,DA,0),"^",8) X ^DD(650,7,1,2,1),^DD(650,7,1,3,1)
24 K DA,X D KILL^%ZTLOAD K ZTSK Q
Note: See TracBrowser for help on using the repository browser.