source: IHS-VA_UTILITIES-XB/XBVCH1.m@ 641

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

Initial commit of XB, move away from sf.net.
Includes kids file and documentation.
File size: 5.4 KB
Line 
1XBVCH1 ; IHS/ADC/GTH - CONTINUE VARIABLE CHANGER ; [ 10/29/2002 7:42 AM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;
4 ; Thanks to Paul Wesley, DSD/OIRM, for the original routine.
5 ;
6PROCESS ;
7 S XBL=$L(XBV0),XBOUT=0
8 S X=0
9 X ^%ZOSF("RM")
10 S (XBROU,XBRM)=""
11 F S XBROU=$O(^XBVROU(XBJ,"R",XBROU)) Q:XBROU="" S XBRM=XBRM_XBROU_","
12 S XBROU=""
13 F S XBROU=$O(^XBVROU(XBJ,"R",XBROU)) Q:XBROU="" D Q:$G(XBOUT)
14 . S X=XBROU
15 . X ^%ZOSF("TEST")
16 . E D ^XBCLS W !!,X," NOT FOUND",! KILL DIR S DIR(0)="E" D ^DIR S:(Y=0) XBOUT=1 Q
17 . S X=XBROU,DIF="^XBVROU(XBJ,""R"","""_XBROU_""",",(XCNP,%N)=0
18 . X ^%ZOSF("LOAD")
19 . I ^XBVROU(XBJ,"R",XBROU,1,0)["GENERATED FROM" W !,^(0),! KILL DIR S DIR(0)="E" D ^DIR D ^XBCLS Q
20 . S XBLN=0,XBEDIT=0
21 . F S XBLN=$O(^XBVROU(XBJ,"R",XBROU,XBLN)) Q:XBLN="" S XBLIN=^(XBLN,0) D LIN Q:$G(XBOUT)
22 . I XBEDIT D SAVE
23 . KILL ^XBVROU(XBJ,"R",XBROU)
24 .Q
25 Q
26 ;
27DISPROU ;display routine list
28 S DX=1,DY=22
29 X XBXY
30 S XBRD=""
31 F XBRI=1:1 S XBRD=$P(XBRM,",",XBRI) Q:XBRD="" W:'(XBRI-1#8) ! S XBRC=(10*(XBRI-1#8)) W ?XBRC W:XBRD=XBROU "|" W XBRD W:XBRD=XBROU "|"
32 Q
33 ;
34 ;--------------------------------------
35 ;
36LIN ;PROCESS LINE FROM TOP
37 S XBLIN0=XBLIN,XBVX=XBV0
38 Q:XBLIN0'[XBV0
39 D SCAN0,CHKMK
40 I '$G(XBMK),$L(XBV0)=1 Q ;skip when single character variable
41 I '$G(XBMK) KILL XBEDLIN D EDIT,CHKMK Q:'$G(XBMK) Q:$G(XBOUT)
42 D ACCEPT
43 Q
44 ;
45SCAN0 ;
46 S XBLINX=XBLIN0,XBVX=XBV0
47 D SCAN,UPT
48 Q
49 ;
50SCAN1 ;
51 S XBLINX=XBLIN1,XBVX=XBV1
52 D SCAN
53 Q
54 ;
55DISP0 ;
56 S XBVX=XBV0,XBLINX=XBLIN0
57 D ^XBCLS,DISPLAY
58 Q
59 ;
60DISP1 ;
61 S XBVX=XBV1,XBLINX=XBLIN1
62 D DISPLAY
63 Q
64 ;
65SCAN ;
66 KILL XB,XBT,XBMK
67 S XBL=$L(XBVX)
68 F XBI=1:1 S XB(XBI)=$F(XBLINX,XBVX,$G(XB(XBI-1))+1)-XBL Q:XB(XBI)'>0 D
69 . S XB(XBI,"M")=0,XB(XBI,0)=XB(XBI)
70 . I XBP[$E(XBLINX,XB(XBI)-1),XBS[$E(XBLINX,XB(XBI)+XBL) S XB(XBI,"M")=1
71 . S XB("B",XB(XBI))=XBI,XB("E",XB(XBI)+XBL-1)=XBI
72 . S XB(XBI,"E")=XB(XBI)+XBL-1
73 .Q
74 KILL XB(XBI)
75CHKMK ;
76 I XBVX=XBV0 KILL XBMK S XBJM="" F S XBJM=$O(XB(XBJM)) Q:XBJM="" I $G(XB(XBJM,"M")) W *7 S XBMK=1
77 KILL XBJM
78 Q
79 ;
80EDIT ;
81 D DISP0
82 S DX=1,DY=13
83 X XBXY
84 R "TAB/T/SPC/CR/R/N/%/^/? :",*X:DTIME
85 S X=$C(X)
86 I X="T" D UPT G EDIT
87 I $A(X)=9 D UPT G EDIT
88 I X=" " S XB(XBT,"M")=XB(XBT,"M")+1#2 D UPT G EDIT
89 I X="R" S XBLN=0 KILL XBMK Q
90 I X="N" S XBLN=999 KILL XBMK Q
91 ; I X="%" D ^XBNEW("%EDIT^XBVCH1:XBJ;XBROU") S XBLN=0 KILL XBMK Q ; IHS/SET/GTH XB*3*9 10/29/2002
92 I X="%" D EN^XBNEW("%EDIT^XBVCH1","XBJ;XBROU") S XBLN=0 KILL XBMK Q ; IHS/SET/GTH XB*3*9 10/29/2002
93 I X="^" S XBOUT=1 KILL XBMK Q
94 KILL XBMK
95 S XBJM=""
96 F S XBJM=$O(XB(XBJM)) Q:XBJM="" I $G(XB(XBJM,"M")) W *7 S XBMK=1
97 KILL XBJM
98 I $A(X)=13 Q
99 D ^XBCLS
100 W !!!
101 W !?5,"'X' Set changes"
102 W !?5,"'Tab' or 'T' Move to next marker"
103 W !?5,"'Space bar' Toggel marker and move to next"
104 W !?5,"'CR' Skip to next line"
105 W !?5,"'R' Restart the current Routine"
106 W !?5,"'%' %E Edit Routine"
107 W !?5,"'N' Next Routine"
108 W !?5,"'^' Exit"
109 KILL DIR
110 S DIR(0)="E"
111 D ^DIR
112 G EDIT
113 ;
114DISPLAY ; display line
115 ; XB(XBI,0)=POS XB("B",POS)=XBI XB("E",POS)=XBI XB(XBI,"M")=MARK (0 OR 1)
116 ; XBD(0) =underline-on,XBD(1)=Bold on,XBD(2)=Underline Off,XBD(3)=Bold Off,XBD("RVON")=RVON,XBD("RVOFF")=RVOFF
117 D:(XBVX=XBV0) ^XBCLS ;displaying current line
118 D:XBVX=XBV0 DISPROU
119 S DX=0,DY=0
120 X XBXY
121 W ?5,"routine ",XBROU,?35,"line ",XBLN,!!
122 I XBVX=XBV1 W ! ;displaying new line
123 W XBD(6)
124 F XBI=1:1:$L(XBLINX) D
125 . I '(XBI#80) W !!!
126 . I $D(XB("B",XBI)) W XBD(XB(XB("B",XBI),"M")*2)
127 . W $E(XBLINX,XBI)
128 . I $D(XB("E",XBI)) W XBD(XB(XB("E",XBI),"M")*2+1)
129 .Q
130 W XBD(7)
131 Q:(XBVX=XBV1) ;no tab marker when displaying new line
132TAB ;
133 S DY=+3,DX=XB(XBT,0)#80-1,DY=DY+(XB(XBT,0)\80*3)
134 S:DY>8 DX=DX+1
135TAB1 ;
136 X XBXY
137 W XBD(2),"|",XBD(3)
138 Q
139 ;
140UPT ; SET TAB
141 S XBT=$G(XBT),XBT=$O(XB(XBT))
142 I XBT'>0 S XBT=0 G UPT
143 KILL XB("T")
144 S XB("T",XB(XBT,0))=""
145 Q
146 ;
147BLDLIN1 ;
148 S XBLIN0=XBLIN,XBSUB=XBV0_":"_XBV1,XBLIN1=""
149 F XBI=1:1 Q:'$D(XB(XBI)) S XBLIN1=XBLIN1_$E(XBLIN,$G(XB(XBI-1,"E"))+1,XB(XBI,0)-1)_$S(XB(XBI,"M"):XBV1,1:XBV0)
150 S XBI=XBI-1
151 S XBLIN1=XBLIN1_$E(XBLIN,XB(XBI,"E")+1,999)
152 Q
153 ;
154ACCEPT ;
155 D DISP0,BLDLIN1,SCAN1,DISP1
156 KILL DIR
157 S DIR(0)="S^Y:ACCEPT;E:EDIT;S:SKIP;N:NEXT ROUTINE;Q:QUIT",DIR("B")="Y"
158 S X=$P(XBLINX," ",2,999)
159 F Q:$E(X)'=" " S X=$E(X,2,999)
160 F Q:$E(X)'="." S X=$E(X,2,999)
161 D ^DIM
162 I '$D(X) W *7,!,XBD(2),"FM DIM checker does not like this line !",XBD(3),!,XBD(2),XBLINX,XBD(3),! S DIR("B")="E"
163 D ^DIR
164 KILL DIR
165 I Y="N" S XBLN=999 Q
166 I Y="S" Q
167 I Y="E" D SCAN0,EDIT,CHKMK G:$G(XBMK) ACCEPT Q
168 I Y="Q" S XBOUT=1 Q
169 I Y'="Y" G ACCEPT
170 S XBEDIT=1 ; set edit markers
171 S XBLIN=XBLIN1,^XBVROU(XBJ,"R",XBROU,XBLN,0)=XBLIN ;set new line
172 Q
173 ;
174%EDIT ; USE %E EDITOR
175 X "ZL @XBROU X ^%E"
176 KILL ^XBVROU(XBJ,"R",XBROU)
177 S X=XBROU,DIF="^XBVROU(XBJ,""R"","""_XBROU_""",",(XCNP,%N)=0
178 X ^%ZOSF("LOAD")
179 S XBLIN=0
180 Q
181 ;
182SAVE ; SAVE NEW ROUTINE TO DISK
183 D ^XBCLS
184 X ^%ZOSF("UCI")
185 I Y["DEV," W !,"you are in DEV .. NO CHANGES" H 2 Q
186 I Y["PRD," W !,"you are in PRD .. NO CHANGES" H 2 Q
187 KILL DIR
188 S DIR(0)="Y",DIR("A")=XBROU_" has been changed. Save with Changes ?",DIR("B")="Y"
189 D ^DIR
190 KILL DIR
191 I 'Y W !?5,XBROU," NOT CHANGED" H 3 D ^XBCLS Q
192 W !?5,XBROU,"is being saved with changes",!
193 S XBSAV1="ZR",XBSAV2="F XBI=1:1 S XBX=$G(^XBVROU(XBJ,""R"",XBROU,XBI,0)) Q:'$L(XBX) ZI XBX",XBSAV3="ZS @XBROU"
194 X "X XBSAV1,XBSAV2,XBSAV3"
195 S ^XBVROU("PRT",$J,"VCHG",XBSUB,XBROU)=""
196 S ^XBVROU("PRT",$J,"RCHG",XBROU,XBSUB)=""
197 S ^XBVROU(XBJ,"NV",XBV1)=""
198 W !?5,XBROU,"SAVED WITH CHANGES" H 2
199 Q
200 ;
Note: See TracBrowser for help on using the repository browser.