- XMC1 ;ISC-SF/GMB-Script Interpreter ;07/23/2002 10:15
- ;;8.0;MailMan;;Jun 28, 2002
- ; Was (WASH ISC)/THM
- ;
- ; Entry points used by MailMan options (not covered by DBIA):
- ; RESUME XMSCRIPTRES (was RES^XMC11)
- ENT ;
- ; Expects as input:
- ; XMINST Domain IEN
- ; XMSITE Domain name
- ; XMB("SCR IEN") Script IEN
- I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D C^XMCTRAP"
- E S X="C^XMCTRAP",@^%ZOSF("TRAP")
- K ^TMP("XMY",$J),^TMP("XMY0",$J)
- N XMLER,XMLIN
- S ER=0,XMC("SHOW TRAN")="RS"
- D GET^XMCXT(0)
- I '$D(^XMBS(4.2999,XMINST,0)) D STAT^XMTDR(XMINST)
- ; *** how about L +^XMBS(4.2999,XMINST,3) ?
- I '$D(XMC("TALKMODE")) L +^DIC(4.2,XMINST,"XMNETSEND"):0 E D Q
- . D ERTRAN(42210) ;Netmail transmission in progress on another channel
- D IN
- L -^DIC(4.2,XMINST,"XMNETSEND")
- Q
- IN ;To |1| from |2| beginning |3|
- D DOTRAN(42211,XMSITE,^XMB("NETNAME"),$$FMTE^XLFDT(DT,5))
- D DOTRAN(42212,$P(XMB("SCR REC"),U)) ;Script: |1|
- I $$USESCR(XMINST,.XMB) D
- . D EN(XMINST,XMSITE,$P(XMB("SCR REC"),U),"^DIC(4.2,"_XMINST_",1,"_XMB("SCR IEN")_",1,")
- E D
- . N XMNETREC,X,XMC1,XMSCRN
- . S XMNETREC=$G(^XMB(1,1,"NETWORK"))
- . S XMSCRN=$P(XMB("SCR REC"),U)
- . D DOTRAN(42213) ;Creating transmission script 'on the fly' ...
- . S X="O H="_XMSITE_",P="_$P(^DIC(3.4,$P(XMNETREC,U,3),0),U)
- . S XMC1=$P(X," ",2,999)
- . D O Q:ER
- . S X="C "_$P(^XMB(4.6,$P(XMNETREC,U,4),0),U)
- . S XMC1=$P(X," ",2,999)
- . D C
- Q:$D(XMC("TALKMODE"))
- I ER,'$D(ER("MSG")),XMTRAN'="" D TRAN
- D DOTRAN(42214) ; Script Complete.
- I ER D DOTRAN(42215) ; Stopped because of error.
- D CLOSE^XMC1B
- Q
- USESCR(XMINST,XMB) ; Function returns 1 if we should use the existing
- ; script, or 0 if we should build a TCP/IP script.
- Q:"^^SMTP^TCPCHAN^"'[(U_$P(XMB("SCR REC"),U,4)) 1 ; Use it
- N XMNETREC
- S XMNETREC=$G(^XMB(1,1,"NETWORK"))
- Q:'$P(XMNETREC,U,3)!'$P(XMNETREC,U,4) 1 ; Use it
- Q $O(^DIC(4.2,XMINST,1,XMB("SCR IEN"),1,0))>0 ;1=Use it; 0=Build it
- EN(XMINST,XMSITE,XMSCRN,XMROOT) ;
- I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D C^XMCTRAP"
- E S X="C^XMCTRAP",@^%ZOSF("TRAP")
- N XMCI
- S XMCI=0
- F S XMCI=$O(@(XMROOT_XMCI_")")) Q:'XMCI D INT(@(XMROOT_XMCI_",0)"),XMCI) Q:ER
- Q
- INT(X,XMCI) ; Interpret the script line
- ; X script line
- N XMC1
- S ER=0
- S:$E(X)?1L X=$$UP^XLFSTR(X)_$E(X,2,999)
- I "EFCXOHMDLTSW"'[$E(X)!(X="") D Q
- . D ERTRAN(42216,X,XMCI) ;Invalid script command '|1|' at line |2|
- S XMC1=$P(X," ",2,999)
- D @$E(X)
- S:'$D(ER) ER=0
- Q
- C ; Call a subroutine
- D DOTRAN(X)
- N X,Y,DIC,XMNSCR,XMNSCRN,XMER
- S X=$P(XMC1,"("),DIC="^XMB(4.6,",DIC(0)="O" D ^DIC
- I Y<0 D Q
- . D ERTRAN(42217,X) ;Script '|1|' cannot be found in file 4.6
- S XMNSCR=+Y,XMNSCRN=$P(Y,U,2)
- D DOTRAN(42218,XMNSCRN) ;Calling script '|1|' (file 4.6)
- D EN(XMINST,XMSITE,XMNSCRN,"^XMB(4.6,XMNSCR,1,")
- I ER D Q ; XMER may be set by the transmission script in file 4.6
- . I $D(XMER),'$D(ER("MSG")) D ERTRAN(XMER)
- D DOTRAN(42219,XMSCRN) ;Returning to script '|1|'.
- Q
- DI ; Dial phone
- N XMC1,DIR,X,Y
- S DIR(0)="F^3:50"
- S DIR("A")=$$EZBLD^DIALOG(42220) ;Enter number(s) to dial
- D ^DIR Q:$D(DIRUT)
- S XMC1=Y
- D ; Dial numbers sucessively (Strip all punctuation not in XMSTRIP string)
- D DIAL(XMC1)
- Q
- DIAL(XMNUMS) ;
- N XMSEP,XMI,XMNUM
- S XMSEP=$S($L($G(XMFIELD)):XMFIELD,1:$S($G(XMSTRIP)[",":";",1:","))
- F XMI=1:1 S XMNUM=$P(XMNUMS,XMSEP,XMI) Q:XMNUM="" D DIALTRY(XMNUM) Q:'ER
- K XMSTRIP,XMFIELD
- Q
- DIALTRY(XMNUM) ;
- N XMPHONE,XMI,XMDIGIT,Y
- S XMPHONE=""
- 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
- S ER=0
- D DOTRAN(42221,XMPHONE) ;Dialing |1|
- I '$D(XMDIAL) D ERTRAN(42222) Q ;Call failed: no XMDIAL
- X XMDIAL
- I ER D ERTRAN($S($D(Y):42222.1,1:42222.2),$G(Y)) ;Call failed: |1| or unknown reason
- Q
- E ; Set error message to be displayed.
- S ER("MSG")=XMC1
- D DOTRAN(42223,ER("MSG")) ;Error message set to '|1|'
- Q
- F ; Flush buffer
- D DOTRAN(42224) ;Flushing buffer
- G BUFLUSH^XML
- Q
- H ; Hang up phone
- D DOTRAN(42225) ;Hanging up phone
- Q:'$D(XMHANG)
- X XMHANG
- Q
- L ; Look for string
- D LOOK^XMC1A
- Q
- M ; Send mail
- D DOTRAN(42226) ;Beginning sender-SMTP service
- D ENTER^XMS
- I ER D DOTRAN("ER="_ER_" - ER(""MSG"")="_$G(ER("MSG")))
- Q
- O ; Open device, protocol, and host
- D DOTRAN(X)
- D OPEN^XMC1B X:'ER XMOPEN
- I ER D DOTRAN(42227) Q ;Open failed
- D DOTRAN(42228,XMSITE) ;Channel opened to |1|
- D FLUSH
- D DOTRAN(42229,XMC("DEVICE"),XMPROT) ;Device '|1|', Protocol '|2|' (file 3.4)
- N XMFDA,XMIENS
- S XMIENS=XMINST_","
- S XMFDA(4.2999,XMIENS,1)=$H
- S XMFDA(4.2999,XMIENS,6)=IO ; Device
- D FILE^DIE("","XMFDA")
- Q
- FLUSH ; Flush buffer
- Q:'$D(XMBFLUSH)
- N XMLX
- F R XMLX:0 Q:'$T
- Q
- S ; Send line
- I XMC1?1"@".E D Q:ER
- . N XMSAVE
- . S XMSAVE=XMC1
- . D INDIR(.XMC1) Q:ER
- . D DOTRAN(42230,XMSAVE,XMC1) ;Transforming '|1|' to '|2|'
- I XMC("SHOW TRAN")["S" D DOTRAN("S: "_XMC1)
- I XMC1["~" S XMC1=$$RTRAN^XMCU1(XMC1)
- W XMC1,$C(13)
- Q
- INDIR(XMC1) ; GET INDIRECT REFERENCE
- N XMREF
- S XMREF=$P(XMC1,"@",2,99)
- I '$D(@XMREF) D ERTRAN(42231,XMREF) Q ;Undefined reference to |1|
- S XMC1=@XMREF
- Q
- T ;
- Q:'$D(XMC("TALKMODE"))
- S XMCI=999999
- D DOTRAN(42232) ;Entering Talk mode
- Q
- W ; Wait a number of seconds
- D DOTRAN(42233,XMC1) ;Waiting |1| seconds
- H +XMC1
- Q
- X ; Execute a line of code
- D DOTRAN(42234,XMC1) ;Xecuting |1|
- X XMC1
- Q:'ER
- I $E(XMC1,1,2)'="O ",$E(XMC1,1,14)'="D CALL^%ZISTCP" Q
- D ERTRAN(42235,XMHOST) S ER=25 ;Can't connect using IP address |1|
- Q
- ERTRAN(XMDIALOG,XM1,XM2,XM3) ;
- D DOTRAN(XMDIALOG,.XM1,.XM2,.XM3)
- S ER=1
- I '$D(ER("MSG")) S ER("MSG")=XMTRAN
- Q
- DOTRAN(XMDIALOG,XM1,XM2,XM3) ;
- N XMPARM
- S:$D(XM1) XMPARM(1)=XM1 S:$D(XM2) XMPARM(2)=XM2 S:$D(XM3) XMPARM(3)=XM3
- S XMTRAN=$S(+XMDIALOG=XMDIALOG:$$EZBLD^DIALOG(XMDIALOG,.XMPARM),1:XMDIALOG)
- ; fall through...
- TRAN ;
- N XMTIME,XMAUDIT
- S XMTIME=$P($H,",",2)
- S XMAUDIT=$E($TR($J(XMTIME\3600,2)_":"_$J(XMTIME#3600\60,2)_":"_$J(XMTIME#60,2)," ","0")_" "_XMTRAN,1,245)
- ; Trace / Debug transmission problems
- ; Field 8.2 in file 4.3 says whether to audit.
- I $G(XMC("AUDIT")) S XMC("AUDIT","I")=$G(XMC("AUDIT","I"))+1,^TMP("XMC",XMC("AUDIT"),XMC("AUDIT","I"),0)=XMAUDIT
- Q:$G(XM)'["D"
- U IO(0)
- W !,XMAUDIT
- W:$G(XMLER) "("_XMLER_")"
- I IO'="",IOT'="RES" U IO
- Q
- RESUME ; Resume script processing
- N I,DIR,X,Y
- S:'$D(XMCI) XMCI=0
- D ^%ZIS Q:POP
- S I=0
- 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)
- S DIR(0)="N^1:"_$O(^DIC(4.2,XMINST,1,XMB("SCR IEN"),1,""),-1)
- S DIR("A")=$$EZBLD^DIALOG(42236) ;Resume script processing from line
- S DIR("B")=XMCI
- D ^DIR Q:$D(DIRUT)
- S XMCI=Y
- D DOTRAN(42237,XMCI) ;Resuming script from line |1|
- S XMCI=XMCI-.1
- U IO
- G IN
- Q
- XMC1 ;ISC-SF/GMB-Script Interpreter ;07/23/2002 10:15
- +1 ;;8.0;MailMan;;Jun 28, 2002
- +2 ; Was (WASH ISC)/THM
- +3 ;
- +4 ; Entry points used by MailMan options (not covered by DBIA):
- +5 ; RESUME XMSCRIPTRES (was RES^XMC11)
- ENT ;
- +1 ; Expects as input:
- +2 ; XMINST Domain IEN
- +3 ; XMSITE Domain name
- +4 ; XMB("SCR IEN") Script IEN
- +5 IF $$NEWERR^%ZTER
- NEW $ETRAP,$ESTACK
- SET $ETRAP="D C^XMCTRAP"
- +6 IF '$TEST
- SET X="C^XMCTRAP"
- SET @^%ZOSF("TRAP")
- +7 KILL ^TMP("XMY",$JOB),^TMP("XMY0",$JOB)
- +8 NEW XMLER,XMLIN
- +9 SET ER=0
- SET XMC("SHOW TRAN")="RS"
- +10 DO GET^XMCXT(0)
- +11 IF '$DATA(^XMBS(4.2999,XMINST,0))
- DO STAT^XMTDR(XMINST)
- +12 ; *** how about L +^XMBS(4.2999,XMINST,3) ?
- +13 IF '$DATA(XMC("TALKMODE"))
- LOCK +^DIC(4.2,XMINST,"XMNETSEND"):0
- IF '$TEST
- Begin DoDot:1
- +14 ;Netmail transmission in progress on another channel
- DO ERTRAN(42210)
- End DoDot:1
- QUIT
- +15 DO IN
- +16 LOCK -^DIC(4.2,XMINST,"XMNETSEND")
- +17 QUIT
- IN ;To |1| from |2| beginning |3|
- +1 DO DOTRAN(42211,XMSITE,^XMB("NETNAME"),$$FMTE^XLFDT(DT,5))
- +2 ;Script: |1|
- DO DOTRAN(42212,$PIECE(XMB("SCR REC"),U))
- +3 IF $$USESCR(XMINST,.XMB)
- Begin DoDot:1
- +4 DO EN(XMINST,XMSITE,$PIECE(XMB("SCR REC"),U),"^DIC(4.2,"_XMINST_",1,"_XMB("SCR IEN")_",1,")
- End DoDot:1
- +5 IF '$TEST
- Begin DoDot:1
- +6 NEW XMNETREC,X,XMC1,XMSCRN
- +7 SET XMNETREC=$GET(^XMB(1,1,"NETWORK"))
- +8 SET XMSCRN=$PIECE(XMB("SCR REC"),U)
- +9 ;Creating transmission script 'on the fly' ...
- DO DOTRAN(42213)
- +10 SET X="O H="_XMSITE_",P="_$PIECE(^DIC(3.4,$PIECE(XMNETREC,U,3),0),U)
- +11 SET XMC1=$PIECE(X," ",2,999)
- +12 DO O
- IF ER
- QUIT
- +13 SET X="C "_$PIECE(^XMB(4.6,$PIECE(XMNETREC,U,4),0),U)
- +14 SET XMC1=$PIECE(X," ",2,999)
- +15 DO C
- End DoDot:1
- +16 IF $DATA(XMC("TALKMODE"))
- QUIT
- +17 IF ER
- IF '$DATA(ER("MSG"))
- IF XMTRAN'=""
- DO TRAN
- +18 ; Script Complete.
- DO DOTRAN(42214)
- +19 ; Stopped because of error.
- IF ER
- DO DOTRAN(42215)
- +20 DO CLOSE^XMC1B
- +21 QUIT
- USESCR(XMINST,XMB) ; Function returns 1 if we should use the existing
- +1 ; script, or 0 if we should build a TCP/IP script.
- +2 ; Use it
- IF "^^SMTP^TCPCHAN^"'[(U_$PIECE(XMB("SCR REC"),U,4))
- QUIT 1
- +3 NEW XMNETREC
- +4 SET XMNETREC=$GET(^XMB(1,1,"NETWORK"))
- +5 ; Use it
- IF '$PIECE(XMNETREC,U,3)!'$PIECE(XMNETREC,U,4)
- QUIT 1
- +6 ;1=Use it; 0=Build it
- QUIT $ORDER(^DIC(4.2,XMINST,1,XMB("SCR IEN"),1,0))>0
- EN(XMINST,XMSITE,XMSCRN,XMROOT) ;
- +1 IF $$NEWERR^%ZTER
- NEW $ETRAP,$ESTACK
- SET $ETRAP="D C^XMCTRAP"
- +2 IF '$TEST
- SET X="C^XMCTRAP"
- SET @^%ZOSF("TRAP")
- +3 NEW XMCI
- +4 SET XMCI=0
- +5 FOR
- SET XMCI=$ORDER(@(XMROOT_XMCI_")"))
- IF 'XMCI
- QUIT
- DO INT(@(XMROOT_XMCI_",0)"),XMCI)
- IF ER
- QUIT
- +6 QUIT
- INT(X,XMCI) ; Interpret the script line
- +1 ; X script line
- +2 NEW XMC1
- +3 SET ER=0
- +4 IF $EXTRACT(X)?1L
- SET X=$$UP^XLFSTR(X)_$EXTRACT(X,2,999)
- +5 IF "EFCXOHMDLTSW"'[$EXTRACT(X)!(X="")
- Begin DoDot:1
- +6 ;Invalid script command '|1|' at line |2|
- DO ERTRAN(42216,X,XMCI)
- End DoDot:1
- QUIT
- +7 SET XMC1=$PIECE(X," ",2,999)
- +8 DO @$EXTRACT(X)
- +9 IF '$DATA(ER)
- SET ER=0
- +10 QUIT
- C ; Call a subroutine
- +1 DO DOTRAN(X)
- +2 NEW X,Y,DIC,XMNSCR,XMNSCRN,XMER
- +3 SET X=$PIECE(XMC1,"(")
- SET DIC="^XMB(4.6,"
- SET DIC(0)="O"
- DO ^DIC
- +4 IF Y<0
- Begin DoDot:1
- +5 ;Script '|1|' cannot be found in file 4.6
- DO ERTRAN(42217,X)
- End DoDot:1
- QUIT
- +6 SET XMNSCR=+Y
- SET XMNSCRN=$PIECE(Y,U,2)
- +7 ;Calling script '|1|' (file 4.6)
- DO DOTRAN(42218,XMNSCRN)
- +8 DO EN(XMINST,XMSITE,XMNSCRN,"^XMB(4.6,XMNSCR,1,")
- +9 ; XMER may be set by the transmission script in file 4.6
- IF ER
- Begin DoDot:1
- +10 IF $DATA(XMER)
- IF '$DATA(ER("MSG"))
- DO ERTRAN(XMER)
- End DoDot:1
- QUIT
- +11 ;Returning to script '|1|'.
- DO DOTRAN(42219,XMSCRN)
- +12 QUIT
- DI ; Dial phone
- +1 NEW XMC1,DIR,X,Y
- +2 SET DIR(0)="F^3:50"
- +3 ;Enter number(s) to dial
- SET DIR("A")=$$EZBLD^DIALOG(42220)
- +4 DO ^DIR
- IF $DATA(DIRUT)
- QUIT
- +5 SET XMC1=Y
- D ; Dial numbers sucessively (Strip all punctuation not in XMSTRIP string)
- +1 DO DIAL(XMC1)
- +2 QUIT
- DIAL(XMNUMS) ;
- +1 NEW XMSEP,XMI,XMNUM
- +2 SET XMSEP=$SELECT($LENGTH($GET(XMFIELD)):XMFIELD,1:$SELECT($GET(XMSTRIP)[",":";",1:","))
- +3 FOR XMI=1:1
- SET XMNUM=$PIECE(XMNUMS,XMSEP,XMI)
- IF XMNUM=""
- QUIT
- DO DIALTRY(XMNUM)
- IF 'ER
- QUIT
- +4 KILL XMSTRIP,XMFIELD
- +5 QUIT
- DIALTRY(XMNUM) ;
- +1 NEW XMPHONE,XMI,XMDIGIT,Y
- +2 SET XMPHONE=""
- +3 FOR XMI=1:1:$LENGTH(XMNUM)
- SET XMDIGIT=$EXTRACT(XMNUM,XMI)
- IF $SELECT(XMDIGIT'?1P:1,$GET(XMSTRIP)[XMDIGIT:1,1:0)
- SET XMPHONE=XMPHONE_XMDIGIT
- +4 SET ER=0
- +5 ;Dialing |1|
- DO DOTRAN(42221,XMPHONE)
- +6 ;Call failed: no XMDIAL
- IF '$DATA(XMDIAL)
- DO ERTRAN(42222)
- QUIT
- +7 XECUTE XMDIAL
- +8 ;Call failed: |1| or unknown reason
- IF ER
- DO ERTRAN($SELECT($DATA(Y):42222.1,1:42222.2),$GET(Y))
- +9 QUIT
- E ; Set error message to be displayed.
- +1 SET ER("MSG")=XMC1
- +2 ;Error message set to '|1|'
- DO DOTRAN(42223,ER("MSG"))
- +3 QUIT
- F ; Flush buffer
- +1 ;Flushing buffer
- DO DOTRAN(42224)
- +2 GOTO BUFLUSH^XML
- +3 QUIT
- H ; Hang up phone
- +1 ;Hanging up phone
- DO DOTRAN(42225)
- +2 IF '$DATA(XMHANG)
- QUIT
- +3 XECUTE XMHANG
- +4 QUIT
- L ; Look for string
- +1 DO LOOK^XMC1A
- +2 QUIT
- M ; Send mail
- +1 ;Beginning sender-SMTP service
- DO DOTRAN(42226)
- +2 DO ENTER^XMS
- +3 IF ER
- DO DOTRAN("ER="_ER_" - ER(""MSG"")="_$GET(ER("MSG")))
- +4 QUIT
- O ; Open device, protocol, and host
- +1 DO DOTRAN(X)
- +2 DO OPEN^XMC1B
- IF 'ER
- XECUTE XMOPEN
- +3 ;Open failed
- IF ER
- DO DOTRAN(42227)
- QUIT
- +4 ;Channel opened to |1|
- DO DOTRAN(42228,XMSITE)
- +5 DO FLUSH
- +6 ;Device '|1|', Protocol '|2|' (file 3.4)
- DO DOTRAN(42229,XMC("DEVICE"),XMPROT)
- +7 NEW XMFDA,XMIENS
- +8 SET XMIENS=XMINST_","
- +9 SET XMFDA(4.2999,XMIENS,1)=$HOROLOG
- +10 ; Device
- SET XMFDA(4.2999,XMIENS,6)=IO
- +11 DO FILE^DIE("","XMFDA")
- +12 QUIT
- FLUSH ; Flush buffer
- +1 IF '$DATA(XMBFLUSH)
- QUIT
- +2 NEW XMLX
- +3 FOR
- READ XMLX:0
- IF '$TEST
- QUIT
- +4 QUIT
- S ; Send line
- +1 IF XMC1?1"@".E
- Begin DoDot:1
- +2 NEW XMSAVE
- +3 SET XMSAVE=XMC1
- +4 DO INDIR(.XMC1)
- IF ER
- QUIT
- +5 ;Transforming '|1|' to '|2|'
- DO DOTRAN(42230,XMSAVE,XMC1)
- End DoDot:1
- IF ER
- QUIT
- +6 IF XMC("SHOW TRAN")["S"
- DO DOTRAN("S: "_XMC1)
- +7 IF XMC1["~"
- SET XMC1=$$RTRAN^XMCU1(XMC1)
- +8 WRITE XMC1,$CHAR(13)
- +9 QUIT
- INDIR(XMC1) ; GET INDIRECT REFERENCE
- +1 NEW XMREF
- +2 SET XMREF=$PIECE(XMC1,"@",2,99)
- +3 ;Undefined reference to |1|
- IF '$DATA(@XMREF)
- DO ERTRAN(42231,XMREF)
- QUIT
- +4 SET XMC1=@XMREF
- +5 QUIT
- T ;
- +1 IF '$DATA(XMC("TALKMODE"))
- QUIT
- +2 SET XMCI=999999
- +3 ;Entering Talk mode
- DO DOTRAN(42232)
- +4 QUIT
- W ; Wait a number of seconds
- +1 ;Waiting |1| seconds
- DO DOTRAN(42233,XMC1)
- +2 HANG +XMC1
- +3 QUIT
- X ; Execute a line of code
- +1 ;Xecuting |1|
- DO DOTRAN(42234,XMC1)
- +2 XECUTE XMC1
- +3 IF 'ER
- QUIT
- +4 IF $EXTRACT(XMC1,1,2)'="O "
- IF $EXTRACT(XMC1,1,14)'="D CALL^%ZISTCP"
- QUIT
- +5 ;Can't connect using IP address |1|
- DO ERTRAN(42235,XMHOST)
- SET ER=25
- +6 QUIT
- ERTRAN(XMDIALOG,XM1,XM2,XM3) ;
- +1 DO DOTRAN(XMDIALOG,.XM1,.XM2,.XM3)
- +2 SET ER=1
- +3 IF '$DATA(ER("MSG"))
- SET ER("MSG")=XMTRAN
- +4 QUIT
- DOTRAN(XMDIALOG,XM1,XM2,XM3) ;
- +1 NEW XMPARM
- +2 IF $DATA(XM1)
- SET XMPARM(1)=XM1
- IF $DATA(XM2)
- SET XMPARM(2)=XM2
- IF $DATA(XM3)
- SET XMPARM(3)=XM3
- +3 SET XMTRAN=$SELECT(+XMDIALOG=XMDIALOG:$$EZBLD^DIALOG(XMDIALOG,.XMPARM),1:XMDIALOG)
- +4 ; fall through...
- TRAN ;
- +1 NEW XMTIME,XMAUDIT
- +2 SET XMTIME=$PIECE($HOROLOG,",",2)
- +3 SET XMAUDIT=$EXTRACT($TRANSLATE($JUSTIFY(XMTIME\3600,2)_":"_$JUSTIFY(XMTIME#3600\60,2)_":"_$JUSTIFY(XMTIME#60,2)," ","0")_" "_XMTRAN,1,245)
- +4 ; Trace / Debug transmission problems
- +5 ; Field 8.2 in file 4.3 says whether to audit.
- +6 IF $GET(XMC("AUDIT"))
- SET XMC("AUDIT","I")=$GET(XMC("AUDIT","I"))+1
- SET ^TMP("XMC",XMC("AUDIT"),XMC("AUDIT","I"),0)=XMAUDIT
- +7 IF $GET(XM)'["D"
- QUIT
- +8 USE IO(0)
- +9 WRITE !,XMAUDIT
- +10 IF $GET(XMLER)
- WRITE "("_XMLER_")"
- +11 IF IO'=""
- IF IOT'="RES"
- USE IO
- +12 QUIT
- RESUME ; Resume script processing
- +1 NEW I,DIR,X,Y
- +2 IF '$DATA(XMCI)
- SET XMCI=0
- +3 DO ^%ZIS
- IF POP
- QUIT
- +4 SET I=0
- +5 FOR
- SET I=$ORDER(^DIC(4.2,XMINST,1,XMB("SCR IEN"),1,I))
- IF I=""
- QUIT
- WRITE !,$JUSTIFY(I,2),$SELECT(I=XMCI:"->",1:" "),^(I,0)
- +6 SET DIR(0)="N^1:"_$ORDER(^DIC(4.2,XMINST,1,XMB("SCR IEN"),1,""),-1)
- +7 ;Resume script processing from line
- SET DIR("A")=$$EZBLD^DIALOG(42236)
- +8 SET DIR("B")=XMCI
- +9 DO ^DIR
- IF $DATA(DIRUT)
- QUIT
- +10 SET XMCI=Y
- +11 ;Resuming script from line |1|
- DO DOTRAN(42237,XMCI)
- +12 SET XMCI=XMCI-.1
- +13 USE IO
- +14 GOTO IN
- +15 QUIT