XMA2 ;ISC-SF/GMB-Create Message Stub API ;04/19/2002 12:35
;;8.0;MailMan;;Jun 28, 2002
; Was (WASH ISC)/CAP/THM
;
; Entry points (DBIA 10066):
; GET get a message number
; XMZ get a message number
XMZ ; Create stub/return error
; In:
; XMDUZ User's DUZ or free text
; XMSUB Message subject
; Out:
; XMZ Message number (-1 if error)
D MAKESTUB($G(XMDUZ),XMSUB,.XMZ,1)
Q
GET ; Create stub
; In:
; XMDUZ User's DUZ or free text
; XMSUB Message subject
; Out:
; XMZ Message number (HALT if error)
D MAKESTUB($G(XMDUZ),XMSUB,.XMZ)
Q
MAKESTUB(XMDUZ,XMSUBJ,XMZ,XMRETURN) ;
N XMZREC,XMSENDR
I '$G(DUZ) N DUZ D DUZ^XUP(.5)
I XMDUZ=0!(XMDUZ="") S XMDUZ=DUZ
I $L(XMSUBJ)>65 S XMSUBJ=$E(XMSUBJ,1,65)
I $L(XMSUBJ)<3 S XMSUBJ=XMSUBJ_"..."
D VSUBJ^XMXPARM(.XMSUBJ)
I $D(XMERR) D Q
. S XMZ=-1
. D:'$D(ZTQUEUED) SHOW^XMJERR
. I '$G(XMRETURN) G ABORT
D CRE8XMZ^XMXSEND(XMSUBJ,.XMZ,1)
I XMZ<1 D Q
. I '$G(XMRETURN) G ABORT
. K XMERR,^TMP("XMERR",$J)
S XMZREC=^XMB(3.9,XMZ,0)
I XMDUZ=.6 S XMDUZ=DUZ,XMSENDR=.6
E S XMSENDR=DUZ
I XMDUZ=.5,XMSENDR'=.5 S $P(XMZREC,U,12)="y" ;Info Only / sent by Postmaster
S $P(XMZREC,U,2,4)=XMDUZ_U_$$NOW^XLFDT()_U_$S(XMDUZ'=XMSENDR&+XMDUZ:XMSENDR,1:"")
S ^XMB(3.9,XMZ,0)=XMZREC
Q
ABORT ;
S X=^TMP("XMERR",$J,1,"TEXT",1)
K XMERR,^TMP("XMERR",$J)
X X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMA2 1374 printed Dec 13, 2024@02:10:48 Page 2
XMA2 ;ISC-SF/GMB-Create Message Stub API ;04/19/2002 12:35
+1 ;;8.0;MailMan;;Jun 28, 2002
+2 ; Was (WASH ISC)/CAP/THM
+3 ;
+4 ; Entry points (DBIA 10066):
+5 ; GET get a message number
+6 ; XMZ get a message number
XMZ ; Create stub/return error
+1 ; In:
+2 ; XMDUZ User's DUZ or free text
+3 ; XMSUB Message subject
+4 ; Out:
+5 ; XMZ Message number (-1 if error)
+6 DO MAKESTUB($GET(XMDUZ),XMSUB,.XMZ,1)
+7 QUIT
GET ; Create stub
+1 ; In:
+2 ; XMDUZ User's DUZ or free text
+3 ; XMSUB Message subject
+4 ; Out:
+5 ; XMZ Message number (HALT if error)
+6 DO MAKESTUB($GET(XMDUZ),XMSUB,.XMZ)
+7 QUIT
MAKESTUB(XMDUZ,XMSUBJ,XMZ,XMRETURN) ;
+1 NEW XMZREC,XMSENDR
+2 IF '$GET(DUZ)
NEW DUZ
DO DUZ^XUP(.5)
+3 IF XMDUZ=0!(XMDUZ="")
SET XMDUZ=DUZ
+4 IF $LENGTH(XMSUBJ)>65
SET XMSUBJ=$EXTRACT(XMSUBJ,1,65)
+5 IF $LENGTH(XMSUBJ)<3
SET XMSUBJ=XMSUBJ_"..."
+6 DO VSUBJ^XMXPARM(.XMSUBJ)
+7 IF $DATA(XMERR)
Begin DoDot:1
+8 SET XMZ=-1
+9 if '$DATA(ZTQUEUED)
DO SHOW^XMJERR
+10 IF '$GET(XMRETURN)
GOTO ABORT
End DoDot:1
QUIT
+11 DO CRE8XMZ^XMXSEND(XMSUBJ,.XMZ,1)
+12 IF XMZ<1
Begin DoDot:1
+13 IF '$GET(XMRETURN)
GOTO ABORT
+14 KILL XMERR,^TMP("XMERR",$JOB)
End DoDot:1
QUIT
+15 SET XMZREC=^XMB(3.9,XMZ,0)
+16 IF XMDUZ=.6
SET XMDUZ=DUZ
SET XMSENDR=.6
+17 IF '$TEST
SET XMSENDR=DUZ
+18 ;Info Only / sent by Postmaster
IF XMDUZ=.5
IF XMSENDR'=.5
SET $PIECE(XMZREC,U,12)="y"
+19 SET $PIECE(XMZREC,U,2,4)=XMDUZ_U_$$NOW^XLFDT()_U_$SELECT(XMDUZ'=XMSENDR&+XMDUZ:XMSENDR,1:"")
+20 SET ^XMB(3.9,XMZ,0)=XMZREC
+21 QUIT
ABORT ;
+1 SET X=^TMP("XMERR",$JOB,1,"TEXT",1)
+2 KILL XMERR,^TMP("XMERR",$JOB)
+3 XECUTE X
+4 QUIT
