source: IHS-VA_UTILITIES-XB/trunk/XBVCH.m@ 850

Last change on this file since 850 was 642, checked in by Sam Habiel, 15 years ago

Modified directory structure; moved routines.

File size: 3.7 KB
Line 
1XBVCH ; IHS/ADC/GTH - CHANGE VARIABLE NAMES ; [ 02/07/97 3:02 PM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;
4 ; Thanks to Paul Wesley, DSD/OIRM, for the original routine.
5 ;
6 I '$D(IOST(0)) D HOME^%ZIS
7 S XBJ=$J
8 D EXIT^XBVCH
9 S XBJ=$J
10 S X="IORVON;IORVOFF;IOUON;IOUOFF;IOINHI;IOINORM;IOAWM0;IOAWM1"
11 D ENDR^%ZISS
12 S XBD(0)=IOUON,XBD(1)=IOUOFF,XBD(2)=IORVON,XBD(3)=IORVOFF,XBD(4)=IORVON,XBD(5)=IORVOFF,XBD(6)=IOAWM0,XBD(7)=IOAWM1,XBXY=IOXY
13 D KILL^%ZISS
14 S XBP=" #&'()*+,'-/<=>@\_?;:[]!"""
15 S XBS=" #&'()*+,'-/<=>@\_?;:[]!"""
16 KILL DIR
17 S DIR(0)="Y",DIR("B")="Y",DIR("A")="Do you have a %INDEX Summary in a Host File to work with ? "
18 D ^DIR
19 KILL DIR
20 D:Y=1 ^XBVCHV
21START ;
22 KILL XBV0,XBV1,XBV2
23V0 ;
24 KILL DIR
25 S DIR(0)="F:0,8",DIR("A")="Old Variable ? or '^' to exit "
26 I $G(XBFILE) S DIR("A")=DIR("A")_" or '|' to see variables "
27 D ^DIR
28 KILL DIR
29 G:(Y="^") EXIT
30 I Y["|",$G(XBFILE) S XBV="" D SHOVAR G V0
31 I $G(XBFILE),'$D(^XBVROU(XBJ,"V",Y)) W *7 G V0
32 S XBV0=Y
33V1 ;
34 KILL DIR
35 S DIR(0)="F:0,8",DIR("A")="New Variable ? or '^' to exit "
36 D ^DIR
37 KILL DIR
38 G:(Y="^") V0
39 S XBV1=Y
40 I $G(XBFILE),$D(^XBVROU(XBJ,"V",XBV1)) W *7,!!,"FYI >> ",XBV1," << Already Exits" KILL DIR S DIR(0)="E" D ^DIR I Y'>0 G V1
41 I $D(^XBVROU(XBJ,"NV",XBV1)) W *7,!!,"FYI >> ",XBV1," << is a >>NEW VARIABLE<" KILL DIR S DIR(0)="E" D ^DIR I Y'>0 G V1
42 ;
43V2 ;
44 S XBV1L=$L(XBV1)
45 I $E(XBV1,XBV1L)=")" S XBV2=$E(XBV1,1,XBV1L-1)_","
46SELROU ;
47 I '$G(XBFILE) X ^%ZOSF("RSEL") S %X="^UTILITY(XBJ,",%Y="^XBVROU(XBJ,""R""," D %XY^%RCR
48 I $G(XBFILE) F XBVI=1:1 Q:'$D(^XBVROU(XBJ,"V",XBV0,XBVI)) S XBVRM=^(XBVI) D
49 . I XBVRM'["," S ^XBVROU(XBJ,"R",XBVRM)="" Q
50 . F XBVJ=1:1 S XBVR=$P(XBVRM,",",XBVJ) Q:XBVR="" S ^XBVROU(XBJ,"R",XBVR)=""
51 .Q
52 ;
53 ;----------------------------------------
54 ;
55PROCESS ;
56 D ^XBVCH1
57 G START
58 ;
59 ;--------------------
60 ;
61SHOVAR ;
62 D ^XBCLS
63 S XBVAR=""
64 F XBI=0:1 S XBVAR=$O(^XBVROU(XBJ,"V",XBVAR)) Q:XBVAR="" D:'(XBI#120) PAGE Q:X="^" W:'(XBI#6) ! W ?((XBI#6)*10),XBVAR
65 Q
66 ;
67PAGE ;
68 Q:XBI=0
69 KILL DIR
70 S DIR(0)="E"
71 D ^DIR
72 Q
73 ;
74 ;----------------------
75EXIT ;EP - Paginat, print, kill, quit.
76 D ^XBCLS
77 I $D(^XBVROU("PRT",XBJ,"VCHG")) D PRINT
78 KILL ^XBVROU(XBJ),^UTILITY(XBJ)
79 I '$D(ZTQUEUED) KILL ^XBVROU("PRT",XBJ)
80 D EN^XBVK("XB")
81 Q
82 ;
83PRINT ;print variables and routines changed
84 ;
85 KILL XBRC,XBRP,XBRX
86 W !,"Changes were made and a Summary is available",!!
87 S XBRP="PRINT1^XBVCH",XBNS="XB*"
88 D ^XBDBQUE
89 Q
90 ;
91PRINT1 ; Continue print
92 S:'$D(XBJ) XBJ=$J
93 S XBPG("HDR")="VARIABLES/ROUTINES CHANGED"
94 D XBHDR
95 S XBSUB=""
96 F S XBSUB=$O(^XBVROU("PRT",XBJ,"VCHG",XBSUB)) Q:XBSUB="" D
97 . U IO
98 . W !!?5,XBSUB
99 . S XBROU=""
100 . F XBC=2:1 S XBROU=$O(^XBVROU("PRT",XBJ,"VCHG",XBSUB,XBROU)) Q:XBROU="" D XBPG D
101 .. U IO
102 .. W ?(10*XBC),XBROU
103 .. I (XBC+2)>(IOM\10) S XBC=0 W ! D XBPG
104 ..Q
105 .Q
106 S XBROU=""
107 F S XBROU=$O(^XBVROU("PRT",XBJ,"RCHG",XBROU)) Q:XBROU="" D XBPG D
108 . U IO
109 . W !!?5,XBROU
110 . S XBSUB=""
111 . F XBC=2:1 S XBSUB=$O(^XBVROU("PRT",XBJ,"RCHG",XBROU,XBSUB)) Q:XBSUB="" D
112 .. U IO
113 .. W ?(20*XBC),XBSUB
114 .. I (XBC+2)>(IOM\20) S XBC=0 W ! D XBPG
115 ..Q
116 .Q
117 Q
118 ;
119XBPG ;EP PAGE CONTROLLER
120 ; this utility uses variables XBPG("HDR"),XBPG("DT"),XBPG("LINE"),XBPG("PG") ; kill variables by D EXBPG
121 ;
122 Q:($Y<(IOSL-4))!($G(DUOUT))
123 S XBPG("PG")=$G(XBPG("PG"))+1
124 I $E(IOST)="C" S Y=$$DIR^XBDIR("E") Q:($G(DIROUT)!$G(DUOUT)!$G(DTOUT))
125XBHDR ;EP write page header
126 W:$Y @IOF
127 W !
128 Q:'$D(XBPG("HDR"))
129 S:'$D(XBPG("LINE")) $P(XBPG("LINE"),"-",IOM-2)=""
130 S:'$D(XBPG("PG")) XBPG("PG")=1
131 I '$D(XBPG("DT")) S %H=$H D YX^%DTC S XBPG("DT")=Y
132 U IO
133 W ?(IOM-40-$L(XBPG("HDR"))/2),XBPG("HDR"),?(IOM-40),XBPG("DT"),?(IOM-10),"PAGE: ",XBPG("PG"),!,XBPG("LINE")
134XBHD ;EP Write column header / message
135 W !!
136 Q
137 ;
138EXBPG ;
139 KILL XBPG("LINE"),XBPG("PG"),XBPG("HDR"),XBPG("DT")
140 Q
141 ;
Note: See TracBrowser for help on using the repository browser.