source: FOIAVistA/tag/r/MAILMAN-XM/XMC1.m@ 1746

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

initial load of FOIAVistA 6/30/08 version

File size: 6.5 KB
Line 
1XMC1 ;ISC-SF/GMB-Script Interpreter ;07/23/2002 10:15
2 ;;8.0;MailMan;;Jun 28, 2002
3 ; Was (WASH ISC)/THM
4 ;
5 ; Entry points used by MailMan options (not covered by DBIA):
6 ; RESUME XMSCRIPTRES (was RES^XMC11)
7ENT ;
8 ; Expects as input:
9 ; XMINST Domain IEN
10 ; XMSITE Domain name
11 ; XMB("SCR IEN") Script IEN
12 I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D C^XMCTRAP"
13 E S X="C^XMCTRAP",@^%ZOSF("TRAP")
14 K ^TMP("XMY",$J),^TMP("XMY0",$J)
15 N XMLER,XMLIN
16 S ER=0,XMC("SHOW TRAN")="RS"
17 D GET^XMCXT(0)
18 I '$D(^XMBS(4.2999,XMINST,0)) D STAT^XMTDR(XMINST)
19 ; *** how about L +^XMBS(4.2999,XMINST,3) ?
20 I '$D(XMC("TALKMODE")) L +^DIC(4.2,XMINST,"XMNETSEND"):0 E D Q
21 . D ERTRAN(42210) ;Netmail transmission in progress on another channel
22 D IN
23 L -^DIC(4.2,XMINST,"XMNETSEND")
24 Q
25IN ;To |1| from |2| beginning |3|
26 D DOTRAN(42211,XMSITE,^XMB("NETNAME"),$$FMTE^XLFDT(DT,5))
27 D DOTRAN(42212,$P(XMB("SCR REC"),U)) ;Script: |1|
28 I $$USESCR(XMINST,.XMB) D
29 . D EN(XMINST,XMSITE,$P(XMB("SCR REC"),U),"^DIC(4.2,"_XMINST_",1,"_XMB("SCR IEN")_",1,")
30 E D
31 . N XMNETREC,X,XMC1,XMSCRN
32 . S XMNETREC=$G(^XMB(1,1,"NETWORK"))
33 . S XMSCRN=$P(XMB("SCR REC"),U)
34 . D DOTRAN(42213) ;Creating transmission script 'on the fly' ...
35 . S X="O H="_XMSITE_",P="_$P(^DIC(3.4,$P(XMNETREC,U,3),0),U)
36 . S XMC1=$P(X," ",2,999)
37 . D O Q:ER
38 . S X="C "_$P(^XMB(4.6,$P(XMNETREC,U,4),0),U)
39 . S XMC1=$P(X," ",2,999)
40 . D C
41 Q:$D(XMC("TALKMODE"))
42 I ER,'$D(ER("MSG")),XMTRAN'="" D TRAN
43 D DOTRAN(42214) ; Script Complete.
44 I ER D DOTRAN(42215) ; Stopped because of error.
45 D CLOSE^XMC1B
46 Q
47USESCR(XMINST,XMB) ; Function returns 1 if we should use the existing
48 ; script, or 0 if we should build a TCP/IP script.
49 Q:"^^SMTP^TCPCHAN^"'[(U_$P(XMB("SCR REC"),U,4)) 1 ; Use it
50 N XMNETREC
51 S XMNETREC=$G(^XMB(1,1,"NETWORK"))
52 Q:'$P(XMNETREC,U,3)!'$P(XMNETREC,U,4) 1 ; Use it
53 Q $O(^DIC(4.2,XMINST,1,XMB("SCR IEN"),1,0))>0 ;1=Use it; 0=Build it
54EN(XMINST,XMSITE,XMSCRN,XMROOT) ;
55 I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D C^XMCTRAP"
56 E S X="C^XMCTRAP",@^%ZOSF("TRAP")
57 N XMCI
58 S XMCI=0
59 F S XMCI=$O(@(XMROOT_XMCI_")")) Q:'XMCI D INT(@(XMROOT_XMCI_",0)"),XMCI) Q:ER
60 Q
61INT(X,XMCI) ; Interpret the script line
62 ; X script line
63 N XMC1
64 S ER=0
65 S:$E(X)?1L X=$$UP^XLFSTR(X)_$E(X,2,999)
66 I "EFCXOHMDLTSW"'[$E(X)!(X="") D Q
67 . D ERTRAN(42216,X,XMCI) ;Invalid script command '|1|' at line |2|
68 S XMC1=$P(X," ",2,999)
69 D @$E(X)
70 S:'$D(ER) ER=0
71 Q
72C ; Call a subroutine
73 D DOTRAN(X)
74 N X,Y,DIC,XMNSCR,XMNSCRN,XMER
75 S X=$P(XMC1,"("),DIC="^XMB(4.6,",DIC(0)="O" D ^DIC
76 I Y<0 D Q
77 . D ERTRAN(42217,X) ;Script '|1|' cannot be found in file 4.6
78 S XMNSCR=+Y,XMNSCRN=$P(Y,U,2)
79 D DOTRAN(42218,XMNSCRN) ;Calling script '|1|' (file 4.6)
80 D EN(XMINST,XMSITE,XMNSCRN,"^XMB(4.6,XMNSCR,1,")
81 I ER D Q ; XMER may be set by the transmission script in file 4.6
82 . I $D(XMER),'$D(ER("MSG")) D ERTRAN(XMER)
83 D DOTRAN(42219,XMSCRN) ;Returning to script '|1|'.
84 Q
85DI ; Dial phone
86 N XMC1,DIR,X,Y
87 S DIR(0)="F^3:50"
88 S DIR("A")=$$EZBLD^DIALOG(42220) ;Enter number(s) to dial
89 D ^DIR Q:$D(DIRUT)
90 S XMC1=Y
91D ; Dial numbers sucessively (Strip all punctuation not in XMSTRIP string)
92 D DIAL(XMC1)
93 Q
94DIAL(XMNUMS) ;
95 N XMSEP,XMI,XMNUM
96 S XMSEP=$S($L($G(XMFIELD)):XMFIELD,1:$S($G(XMSTRIP)[",":";",1:","))
97 F XMI=1:1 S XMNUM=$P(XMNUMS,XMSEP,XMI) Q:XMNUM="" D DIALTRY(XMNUM) Q:'ER
98 K XMSTRIP,XMFIELD
99 Q
100DIALTRY(XMNUM) ;
101 N XMPHONE,XMI,XMDIGIT,Y
102 S XMPHONE=""
103 F XMI=1:1:$L(XMNUM) S XMDIGIT=$E(XMNUM,XMI) I $S(XMDIGIT'?1P:1,$G(XMSTRIP)[XMDIGIT:1,1:0) S XMPHONE=XMPHONE_XMDIGIT
104 S ER=0
105 D DOTRAN(42221,XMPHONE) ;Dialing |1|
106 I '$D(XMDIAL) D ERTRAN(42222) Q ;Call failed: no XMDIAL
107 X XMDIAL
108 I ER D ERTRAN($S($D(Y):42222.1,1:42222.2),$G(Y)) ;Call failed: |1| or unknown reason
109 Q
110E ; Set error message to be displayed.
111 S ER("MSG")=XMC1
112 D DOTRAN(42223,ER("MSG")) ;Error message set to '|1|'
113 Q
114F ; Flush buffer
115 D DOTRAN(42224) ;Flushing buffer
116 G BUFLUSH^XML
117 Q
118H ; Hang up phone
119 D DOTRAN(42225) ;Hanging up phone
120 Q:'$D(XMHANG)
121 X XMHANG
122 Q
123L ; Look for string
124 D LOOK^XMC1A
125 Q
126M ; Send mail
127 D DOTRAN(42226) ;Beginning sender-SMTP service
128 D ENTER^XMS
129 I ER D DOTRAN("ER="_ER_" - ER(""MSG"")="_$G(ER("MSG")))
130 Q
131O ; Open device, protocol, and host
132 D DOTRAN(X)
133 D OPEN^XMC1B X:'ER XMOPEN
134 I ER D DOTRAN(42227) Q ;Open failed
135 D DOTRAN(42228,XMSITE) ;Channel opened to |1|
136 D FLUSH
137 D DOTRAN(42229,XMC("DEVICE"),XMPROT) ;Device '|1|', Protocol '|2|' (file 3.4)
138 N XMFDA,XMIENS
139 S XMIENS=XMINST_","
140 S XMFDA(4.2999,XMIENS,1)=$H
141 S XMFDA(4.2999,XMIENS,6)=IO ; Device
142 D FILE^DIE("","XMFDA")
143 Q
144FLUSH ; Flush buffer
145 Q:'$D(XMBFLUSH)
146 N XMLX
147 F R XMLX:0 Q:'$T
148 Q
149S ; Send line
150 I XMC1?1"@".E D Q:ER
151 . N XMSAVE
152 . S XMSAVE=XMC1
153 . D INDIR(.XMC1) Q:ER
154 . D DOTRAN(42230,XMSAVE,XMC1) ;Transforming '|1|' to '|2|'
155 I XMC("SHOW TRAN")["S" D DOTRAN("S: "_XMC1)
156 I XMC1["~" S XMC1=$$RTRAN^XMCU1(XMC1)
157 W XMC1,$C(13)
158 Q
159INDIR(XMC1) ; GET INDIRECT REFERENCE
160 N XMREF
161 S XMREF=$P(XMC1,"@",2,99)
162 I '$D(@XMREF) D ERTRAN(42231,XMREF) Q ;Undefined reference to |1|
163 S XMC1=@XMREF
164 Q
165T ;
166 Q:'$D(XMC("TALKMODE"))
167 S XMCI=999999
168 D DOTRAN(42232) ;Entering Talk mode
169 Q
170W ; Wait a number of seconds
171 D DOTRAN(42233,XMC1) ;Waiting |1| seconds
172 H +XMC1
173 Q
174X ; Execute a line of code
175 D DOTRAN(42234,XMC1) ;Xecuting |1|
176 X XMC1
177 Q:'ER
178 I $E(XMC1,1,2)'="O ",$E(XMC1,1,14)'="D CALL^%ZISTCP" Q
179 D ERTRAN(42235,XMHOST) S ER=25 ;Can't connect using IP address |1|
180 Q
181ERTRAN(XMDIALOG,XM1,XM2,XM3) ;
182 D DOTRAN(XMDIALOG,.XM1,.XM2,.XM3)
183 S ER=1
184 I '$D(ER("MSG")) S ER("MSG")=XMTRAN
185 Q
186DOTRAN(XMDIALOG,XM1,XM2,XM3) ;
187 N XMPARM
188 S:$D(XM1) XMPARM(1)=XM1 S:$D(XM2) XMPARM(2)=XM2 S:$D(XM3) XMPARM(3)=XM3
189 S XMTRAN=$S(+XMDIALOG=XMDIALOG:$$EZBLD^DIALOG(XMDIALOG,.XMPARM),1:XMDIALOG)
190 ; fall through...
191TRAN ;
192 N XMTIME,XMAUDIT
193 S XMTIME=$P($H,",",2)
194 S XMAUDIT=$E($TR($J(XMTIME\3600,2)_":"_$J(XMTIME#3600\60,2)_":"_$J(XMTIME#60,2)," ","0")_" "_XMTRAN,1,245)
195 ; Trace / Debug transmission problems
196 ; Field 8.2 in file 4.3 says whether to audit.
197 I $G(XMC("AUDIT")) S XMC("AUDIT","I")=$G(XMC("AUDIT","I"))+1,^TMP("XMC",XMC("AUDIT"),XMC("AUDIT","I"),0)=XMAUDIT
198 Q:$G(XM)'["D"
199 U IO(0)
200 W !,XMAUDIT
201 W:$G(XMLER) "("_XMLER_")"
202 I IO'="",IOT'="RES" U IO
203 Q
204RESUME ; Resume script processing
205 N I,DIR,X,Y
206 S:'$D(XMCI) XMCI=0
207 D ^%ZIS Q:POP
208 S I=0
209 F S I=$O(^DIC(4.2,XMINST,1,XMB("SCR IEN"),1,I)) Q:I="" W !,$J(I,2),$S(I=XMCI:"->",1:" "),^(I,0)
210 S DIR(0)="N^1:"_$O(^DIC(4.2,XMINST,1,XMB("SCR IEN"),1,""),-1)
211 S DIR("A")=$$EZBLD^DIALOG(42236) ;Resume script processing from line
212 S DIR("B")=XMCI
213 D ^DIR Q:$D(DIRUT)
214 S XMCI=Y
215 D DOTRAN(42237,XMCI) ;Resuming script from line |1|
216 S XMCI=XMCI-.1
217 U IO
218 G IN
219 Q
Note: See TracBrowser for help on using the repository browser.