XMA2.m

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

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