source: WorldVistAEHR/trunk/r/ZZOTHER/ZZMKEDIT.m@ 1365

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

initial load of WorldVistAEHR
File size: 4.1 KB
Line 
1ZZMKEDIT ;SFISC/MKO-EDIT A ROUTINE ;3:38 PM 22 Aug 2000
2 ;;21.0;VA FileMan;;Dec 28, 1994
3 N DDWRTN
4 G EN
5 ;
6EDIT(DDWRTN) ;Use the Screen Editor to edit a routine.
7EN ;Entry point to jump around the EDIT entry point, which requires
8 ;parameter passing syntax. (Called from ^ZZMKEDIT.)
9 N DDWI,DDWIC,DDWNEW,DDWX,X,Y,%,%X,%Y
10 N DIR,DIROUT,DIRUT,DTOUT,DUOUT
11 N DIE,XCM,XCN,DTIME
12 S DTIME=3600
13 ;
14 I $G(DDWRTN)]"" D
15 . D LOAD(.DDWRTN)
16 E D
17 . X ^%ZOSF("EON")
18 . K DIR
19 . S DIR(0)="FO^1:8^K:X?.E1.C.E!'(X?1""%""1.7AN!(X?1A1.7AN)) X"
20 . S DIR("A")="Edit routine"
21 . S DIR("?")="Enter the name of a routine, without the leading up-arrow"
22 . ;
23 . F D Q:$G(DDWRTN)]""
24 .. W ! D ^DIR I $D(DIRUT) S DDWRTN=U Q
25 .. S DDWRTN=X
26 .. X ^%ZOSF("TEST") S DDWNEW='$T
27 .. I DDWNEW D
28 ... D ADD(.DDWRTN) Q:U[$G(DDWRTN)
29 ... S DDWIC=$F(^TMP("DDWRTN",$J,1,0),"-")
30 .. E D LOAD(.DDWRTN)
31 Q:U[$G(DDWRTN)
32 ;
33CALL ;Call Screen Editor
34 D EDIT^DDW("^TMP(""DDWRTN"",$J)","M",DDWRTN,"Routine: "_DDWRTN,,$G(DDWIC))
35 ;
36 ;Prompt whether to save changes
37 K DIR
38 S DIR(0)="YO"
39 S DIR("A")="Do you want to save changes to routine "_DDWRTN
40 S DIR("?",1)="Enter 'YES' to save your changes."
41 S DIR("?",2)="Enter 'NO' or '^' to discard your changes."
42 S DIR("?")="Press <RET> to return to the editor."
43 W ! D ^DIR
44 I Y="" K DUOUT,DIRUT,DIROUT,DTOUT,DIR,X,Y G CALL
45 G:$D(DIRUT)!'Y QUIT
46 ;
47 ;Time stamp routine
48 S $P(^TMP("DDWRTN",$J,1,0),";",3)=$$NOW
49 ;
50 ;Remove extra spaces
51 S DDWI=0
52 F S DDWI=$O(^TMP("DDWRTN",$J,DDWI)) Q:'DDWI D
53 . S DDWX=^TMP("DDWRTN",$J,DDWI,0)
54 . S DDWX=$$STRIP(DDWX)
55 . S ^TMP("DDWRTN",$J,DDWI,0)=$$LS(DDWX)
56 ;
57 ;Save routine
58 S X=DDWRTN,XCN=0,DIE="^TMP(""DDWRTN"",$J,"
59 X ^%ZOSF("SAVE")
60 ;
61 ;Write routine size
62 X "ZL "_DDWRTN_" X ^%ZOSF(""SIZE"")"
63 W !!,"Routine size: "_Y
64 X "ZL "_DDWRTN_" X ^ZZMKEDIT(""SIZE"")"
65 W !,"Routine size (excluding commented lines): "_Y,!
66 ;
67QUIT K ^TMP("DDWRTN",$J)
68 Q
69 ;
70ADD(DDWRTN) ;Add routine
71 I $$LOADCHK(DDWRTN) D Q
72 . W !!,$C(7)_"Another process has just created routine "_DDWRTN
73 . S DDWRTN=""
74 ;
75 ;Prompt user
76 N DIR,DIRUT,DUOUT,DTOUT,DIROUT,INIT,X,Y
77 S DIR(0)="Y"
78 S DIR("A")="Is "_DDWRTN_" a new routine"
79 S DIR("?")="Answer 'YES' if you want to create routine "_DDWRTN_"."
80 W ! D ^DIR
81 I $D(DIRUT)!'Y S DDWRTN="" Q
82 ;
83 K DIR
84 S DIR(0)="FO^1:15"
85 S DIR("A")="Programmer initials"
86 S DIR("?")="Enter your initials, which will appear on the first line of the routine."
87 W ! D ^DIR
88 I $D(DUOUT)!$D(DTOUT) S DDWRTN="" Q
89 S INIT=Y
90 ;
91 K ^TMP("DDWRTN",$J)
92 S ^TMP("DDWRTN",$J)=DDWRTN
93 ;
94 ;Create routine in ^TMP
95 S ^TMP("DDWRTN",$J,1,0)=$$SP(DDWRTN_" ;SFISC/"_INIT_"- ;")
96 S ^TMP("DDWRTN",$J,2,0)=$$SP(" ;;1.0")
97 Q
98 ;
99LOAD(DDWRTN) ;Load routine into ^TMP
100 N DDWI,DDWX
101 ;
102 ;Check if routine is already loaded in ^TMP
103 I $$LOADCHK(DDWRTN) D Q
104 . W !,$C(7)_"Another process is already editing routine "_DDWRTN,!
105 . S DDWRTN=""
106 ;
107 ;Load routine into ^TMP
108 W !,"Loading ",DDWRTN
109 K ^TMP("DDWRTN",$J)
110 S ^TMP("DDWRTN",$J)=DDWRTN
111 F DDWI=1:1 S DDWX=$T(+DDWI^@DDWRTN) Q:DDWX="" D
112 . S ^TMP("DDWRTN",$J,DDWI,0)=$$SP(DDWX)
113 Q
114 ;
115LOADCHK(RTN) ;Check if routine is already loaded by another process
116 N J
117 S J=""
118 F S J=$O(^TMP("DDWRTN",J)) Q:J="" I RTN=^TMP("DDWRTN",J),J'=$J Q
119 Q J]""
120 ;
121LS(X) ;Replace multiple line start characters with a single space
122 N I,P1,P2
123 I $G(X)="" S X=" "
124 E I X?1." ".E D
125 . F I=1:1:$L(X) Q:$E(X,I+1)'=" "
126 . S $E(X,1,I)=" "
127 E D
128 . S P1=$F(X," ")-1
129 . I P1<0 S X=X_" " Q
130 . F P2=P1:1:$L(X) Q:$E(X,P2+1)'=" "
131 . S $E(X,P1,P2)=" "
132 Q X
133 ;
134SP(X,N) ;Replace line start character with up to N spaces (default=8)
135 N BODY,TAG,SP
136 S:$G(N)<1 N=8
137 S SP=$J("",N)
138 I $G(X)="" S X=""
139 E I X?1" ".E S $E(X,1)=SP
140 E D
141 . S TAG=$P(X," "),BODY=$P(X," ",2,999)
142 . I $L(TAG)<N S X=TAG_$E(SP,1,N-$L(TAG))_BODY
143 . E S X=TAG_" "_BODY
144 Q X
145 ;
146STRIP(X) ;Strip trailing blanks from X
147 Q:X[";;=" X
148 N I
149 F I=$L(X):-1:0 Q:$E(X,I)'=" "
150 S X=$E(X,1,I)
151 Q X
152 ;
153NOW() ;Return current time in external form
154 N %,%I,%H,AP,HR,MIN,MON,TIM,X
155 D NOW^%DTC
156 S TIM=$P(%,".",2)
157 S HR=$E(TIM,1,2)
158 S AP=$S(HR<12:"AM",1:"PM")
159 S HR=$S(HR<13:+HR,1:HR#12)
160 S MIN=$E(TIM_"0000",3,4)
161 ;
162 S MON=$P("Jan^Feb^Mar^Apr^May^Jun^Jul^Aug^Sep^Oct^Nov^Dec",U,%I(1))
163 Q HR_":"_MIN_" "_AP_" "_%I(2)_" "_MON_" "_(%I(3)+1700)
Note: See TracBrowser for help on using the repository browser.