201 lines
5.4 KiB
Mathematica
201 lines
5.4 KiB
Mathematica
XBVCH1 ; IHS/ADC/GTH - CONTINUE VARIABLE CHANGER ; [ 10/29/2002 7:42 AM ]
|
|
;;4.0;XB;;Jul 20, 2009;Build 2
|
|
;
|
|
; Thanks to Paul Wesley, DSD/OIRM, for the original routine.
|
|
;
|
|
PROCESS ;
|
|
S XBL=$L(XBV0),XBOUT=0
|
|
S X=0
|
|
X ^%ZOSF("RM")
|
|
S (XBROU,XBRM)=""
|
|
F S XBROU=$O(^XBVROU(XBJ,"R",XBROU)) Q:XBROU="" S XBRM=XBRM_XBROU_","
|
|
S XBROU=""
|
|
F S XBROU=$O(^XBVROU(XBJ,"R",XBROU)) Q:XBROU="" D Q:$G(XBOUT)
|
|
. S X=XBROU
|
|
. X ^%ZOSF("TEST")
|
|
. E D ^XBCLS W !!,X," NOT FOUND",! KILL DIR S DIR(0)="E" D ^DIR S:(Y=0) XBOUT=1 Q
|
|
. S X=XBROU,DIF="^XBVROU(XBJ,""R"","""_XBROU_""",",(XCNP,%N)=0
|
|
. X ^%ZOSF("LOAD")
|
|
. I ^XBVROU(XBJ,"R",XBROU,1,0)["GENERATED FROM" W !,^(0),! KILL DIR S DIR(0)="E" D ^DIR D ^XBCLS Q
|
|
. S XBLN=0,XBEDIT=0
|
|
. F S XBLN=$O(^XBVROU(XBJ,"R",XBROU,XBLN)) Q:XBLN="" S XBLIN=^(XBLN,0) D LIN Q:$G(XBOUT)
|
|
. I XBEDIT D SAVE
|
|
. KILL ^XBVROU(XBJ,"R",XBROU)
|
|
.Q
|
|
Q
|
|
;
|
|
DISPROU ;display routine list
|
|
S DX=1,DY=22
|
|
X XBXY
|
|
S XBRD=""
|
|
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 "|"
|
|
Q
|
|
;
|
|
;--------------------------------------
|
|
;
|
|
LIN ;PROCESS LINE FROM TOP
|
|
S XBLIN0=XBLIN,XBVX=XBV0
|
|
Q:XBLIN0'[XBV0
|
|
D SCAN0,CHKMK
|
|
I '$G(XBMK),$L(XBV0)=1 Q ;skip when single character variable
|
|
I '$G(XBMK) KILL XBEDLIN D EDIT,CHKMK Q:'$G(XBMK) Q:$G(XBOUT)
|
|
D ACCEPT
|
|
Q
|
|
;
|
|
SCAN0 ;
|
|
S XBLINX=XBLIN0,XBVX=XBV0
|
|
D SCAN,UPT
|
|
Q
|
|
;
|
|
SCAN1 ;
|
|
S XBLINX=XBLIN1,XBVX=XBV1
|
|
D SCAN
|
|
Q
|
|
;
|
|
DISP0 ;
|
|
S XBVX=XBV0,XBLINX=XBLIN0
|
|
D ^XBCLS,DISPLAY
|
|
Q
|
|
;
|
|
DISP1 ;
|
|
S XBVX=XBV1,XBLINX=XBLIN1
|
|
D DISPLAY
|
|
Q
|
|
;
|
|
SCAN ;
|
|
KILL XB,XBT,XBMK
|
|
S XBL=$L(XBVX)
|
|
F XBI=1:1 S XB(XBI)=$F(XBLINX,XBVX,$G(XB(XBI-1))+1)-XBL Q:XB(XBI)'>0 D
|
|
. S XB(XBI,"M")=0,XB(XBI,0)=XB(XBI)
|
|
. I XBP[$E(XBLINX,XB(XBI)-1),XBS[$E(XBLINX,XB(XBI)+XBL) S XB(XBI,"M")=1
|
|
. S XB("B",XB(XBI))=XBI,XB("E",XB(XBI)+XBL-1)=XBI
|
|
. S XB(XBI,"E")=XB(XBI)+XBL-1
|
|
.Q
|
|
KILL XB(XBI)
|
|
CHKMK ;
|
|
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
|
|
KILL XBJM
|
|
Q
|
|
;
|
|
EDIT ;
|
|
D DISP0
|
|
S DX=1,DY=13
|
|
X XBXY
|
|
R "TAB/T/SPC/CR/R/N/%/^/? :",*X:DTIME
|
|
S X=$C(X)
|
|
I X="T" D UPT G EDIT
|
|
I $A(X)=9 D UPT G EDIT
|
|
I X=" " S XB(XBT,"M")=XB(XBT,"M")+1#2 D UPT G EDIT
|
|
I X="R" S XBLN=0 KILL XBMK Q
|
|
I X="N" S XBLN=999 KILL XBMK Q
|
|
; I X="%" D ^XBNEW("%EDIT^XBVCH1:XBJ;XBROU") S XBLN=0 KILL XBMK Q ; IHS/SET/GTH XB*3*9 10/29/2002
|
|
I X="%" D EN^XBNEW("%EDIT^XBVCH1","XBJ;XBROU") S XBLN=0 KILL XBMK Q ; IHS/SET/GTH XB*3*9 10/29/2002
|
|
I X="^" S XBOUT=1 KILL XBMK Q
|
|
KILL XBMK
|
|
S XBJM=""
|
|
F S XBJM=$O(XB(XBJM)) Q:XBJM="" I $G(XB(XBJM,"M")) W *7 S XBMK=1
|
|
KILL XBJM
|
|
I $A(X)=13 Q
|
|
D ^XBCLS
|
|
W !!!
|
|
W !?5,"'X' Set changes"
|
|
W !?5,"'Tab' or 'T' Move to next marker"
|
|
W !?5,"'Space bar' Toggel marker and move to next"
|
|
W !?5,"'CR' Skip to next line"
|
|
W !?5,"'R' Restart the current Routine"
|
|
W !?5,"'%' %E Edit Routine"
|
|
W !?5,"'N' Next Routine"
|
|
W !?5,"'^' Exit"
|
|
KILL DIR
|
|
S DIR(0)="E"
|
|
D ^DIR
|
|
G EDIT
|
|
;
|
|
DISPLAY ; display line
|
|
; XB(XBI,0)=POS XB("B",POS)=XBI XB("E",POS)=XBI XB(XBI,"M")=MARK (0 OR 1)
|
|
; XBD(0) =underline-on,XBD(1)=Bold on,XBD(2)=Underline Off,XBD(3)=Bold Off,XBD("RVON")=RVON,XBD("RVOFF")=RVOFF
|
|
D:(XBVX=XBV0) ^XBCLS ;displaying current line
|
|
D:XBVX=XBV0 DISPROU
|
|
S DX=0,DY=0
|
|
X XBXY
|
|
W ?5,"routine ",XBROU,?35,"line ",XBLN,!!
|
|
I XBVX=XBV1 W ! ;displaying new line
|
|
W XBD(6)
|
|
F XBI=1:1:$L(XBLINX) D
|
|
. I '(XBI#80) W !!!
|
|
. I $D(XB("B",XBI)) W XBD(XB(XB("B",XBI),"M")*2)
|
|
. W $E(XBLINX,XBI)
|
|
. I $D(XB("E",XBI)) W XBD(XB(XB("E",XBI),"M")*2+1)
|
|
.Q
|
|
W XBD(7)
|
|
Q:(XBVX=XBV1) ;no tab marker when displaying new line
|
|
TAB ;
|
|
S DY=+3,DX=XB(XBT,0)#80-1,DY=DY+(XB(XBT,0)\80*3)
|
|
S:DY>8 DX=DX+1
|
|
TAB1 ;
|
|
X XBXY
|
|
W XBD(2),"|",XBD(3)
|
|
Q
|
|
;
|
|
UPT ; SET TAB
|
|
S XBT=$G(XBT),XBT=$O(XB(XBT))
|
|
I XBT'>0 S XBT=0 G UPT
|
|
KILL XB("T")
|
|
S XB("T",XB(XBT,0))=""
|
|
Q
|
|
;
|
|
BLDLIN1 ;
|
|
S XBLIN0=XBLIN,XBSUB=XBV0_":"_XBV1,XBLIN1=""
|
|
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)
|
|
S XBI=XBI-1
|
|
S XBLIN1=XBLIN1_$E(XBLIN,XB(XBI,"E")+1,999)
|
|
Q
|
|
;
|
|
ACCEPT ;
|
|
D DISP0,BLDLIN1,SCAN1,DISP1
|
|
KILL DIR
|
|
S DIR(0)="S^Y:ACCEPT;E:EDIT;S:SKIP;N:NEXT ROUTINE;Q:QUIT",DIR("B")="Y"
|
|
S X=$P(XBLINX," ",2,999)
|
|
F Q:$E(X)'=" " S X=$E(X,2,999)
|
|
F Q:$E(X)'="." S X=$E(X,2,999)
|
|
D ^DIM
|
|
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"
|
|
D ^DIR
|
|
KILL DIR
|
|
I Y="N" S XBLN=999 Q
|
|
I Y="S" Q
|
|
I Y="E" D SCAN0,EDIT,CHKMK G:$G(XBMK) ACCEPT Q
|
|
I Y="Q" S XBOUT=1 Q
|
|
I Y'="Y" G ACCEPT
|
|
S XBEDIT=1 ; set edit markers
|
|
S XBLIN=XBLIN1,^XBVROU(XBJ,"R",XBROU,XBLN,0)=XBLIN ;set new line
|
|
Q
|
|
;
|
|
%EDIT ; USE %E EDITOR
|
|
X "ZL @XBROU X ^%E"
|
|
KILL ^XBVROU(XBJ,"R",XBROU)
|
|
S X=XBROU,DIF="^XBVROU(XBJ,""R"","""_XBROU_""",",(XCNP,%N)=0
|
|
X ^%ZOSF("LOAD")
|
|
S XBLIN=0
|
|
Q
|
|
;
|
|
SAVE ; SAVE NEW ROUTINE TO DISK
|
|
D ^XBCLS
|
|
X ^%ZOSF("UCI")
|
|
I Y["DEV," W !,"you are in DEV .. NO CHANGES" H 2 Q
|
|
I Y["PRD," W !,"you are in PRD .. NO CHANGES" H 2 Q
|
|
KILL DIR
|
|
S DIR(0)="Y",DIR("A")=XBROU_" has been changed. Save with Changes ?",DIR("B")="Y"
|
|
D ^DIR
|
|
KILL DIR
|
|
I 'Y W !?5,XBROU," NOT CHANGED" H 3 D ^XBCLS Q
|
|
W !?5,XBROU,"is being saved with changes",!
|
|
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"
|
|
X "X XBSAV1,XBSAV2,XBSAV3"
|
|
S ^XBVROU("PRT",$J,"VCHG",XBSUB,XBROU)=""
|
|
S ^XBVROU("PRT",$J,"RCHG",XBROU,XBSUB)=""
|
|
S ^XBVROU(XBJ,"NV",XBV1)=""
|
|
W !?5,XBROU,"SAVED WITH CHANGES" H 2
|
|
Q
|
|
;
|