XMXPARM ;ISC-SF/GMB-Parameter check ;03/26/2003 08:00
;;8.0;MailMan;**15,45**;Jun 28, 2002;Build 8
ACTMSGS(XMDUZ,XMK,XMKZA) ;
K XMERR,^TMP("XMERR",$J)
D XMDUZ(.XMDUZ,.XMV)
I $G(XMK)'="" S XMK=$$XMK(XMDUZ,"XMK",XMK)
D XMKZA^XMXPARM1(.XMKZA)
Q
ACTMSG(XMDUZ,XMK,XMKZ) ;
K XMERR,^TMP("XMERR",$J)
D XMDUZ(.XMDUZ,.XMV)
I $G(XMK)'="" D
. S XMK=$$XMK(XMDUZ,"XMK",XMK)
. D XMKZ^XMXPARM1(XMK,.XMKZ)
E D XMZ(.XMKZ)
Q
ANSRMSG(XMDUZ,XMK,XMKZ,XMSUBJ,XMBODY,XMTO,XMINSTR) ;
D ACTMSG(.XMDUZ,.XMK,.XMKZ)
I $G(XMSUBJ)'="" S XMSUBJ=$$XMSUBJ("XMSUBJ",$G(XMSUBJ))
D XMBODY^XMXPARM1(.XMBODY)
D:$D(XMTO) XMTO^XMXPARM1(.XMTO,$G(XMINSTR("ADDR FLAGS"))["I") ; truly optional
D:$D(XMINSTR) XMINSTR(.XMINSTR)
Q
BULLETIN(XMDUZ,XMBN,XMPARM,XMBODY,XMTO,XMINSTR,XMATTACH) ;
K XMERR,^TMP("XMERR",$J)
D XMDUZ(.XMDUZ,.XMV)
D XMBN^XMXPARM1(.XMBN)
D:$D(XMBODY) XMBODY^XMXPARM1(.XMBODY,1)
D:$D(XMTO) XMTO^XMXPARM1(.XMTO,$G(XMINSTR("ADDR FLAGS"))["I") ; truly optional
D:$D(XMINSTR) XMINSTR(.XMINSTR)
Q
FWDMSG(XMDUZ,XMK,XMKZA,XMTO,XMINSTR) ;
D ACTMSGS(.XMDUZ,.XMK,.XMKZA)
D XMTO^XMXPARM1(.XMTO,$G(XMINSTR("ADDR FLAGS"))["I") ; need at least one
D:$D(XMINSTR) XMINSTR(.XMINSTR)
Q
LATERMSG(XMDUZ,XMK,XMKZA,XMINSTR) ;
D ACTMSGS(.XMDUZ,.XMK,.XMKZA)
I $D(XMINSTR("LATER")) D Q
. ;I XMINSTR("LATER")="@" Q
. S XMINSTR("LATER")=$$XMDATE("XMINSTR(""LATER"")",XMINSTR("LATER"))
I $G(XMINSTR)'="" D Q
. ;I XMINSTR="@" Q
. S XMINSTR=$$XMDATE("LATER",XMINSTR)
D ERRSET^XMXUTIL(39419) ;Later date must be supplied.
Q
MOVEMSG(XMDUZ,XMK,XMKZA,XMKTO) ;
D ACTMSGS(.XMDUZ,.XMK,.XMKZA)
D XMKTO(XMDUZ,.XMKTO)
Q
PRTMSG(XMDUZ,XMK,XMKZA,XMPRTTO,XMINSTR,XMSUBJ,XMTO) ;
D ACTMSGS(.XMDUZ,.XMK,.XMKZA)
Q:'$D(XMINSTR)
I $D(XMINSTR("WHEN")) S XMINSTR("WHEN")=$$XMDATE("XMINSTR(""WHEN"")",XMINSTR("WHEN"))
I $D(XMINSTR("HDR")) D XMCODE^XMXPARM1("XMINSTR(""HDR"")",XMINSTR("HDR"),"^0^1^")
I $D(XMINSTR("RECIPS")) D XMCODE^XMXPARM1("XMINSTR(""RECIPS"")",XMINSTR("RECIPS"),"^0^1^2^")
I $G(XMSUBJ)'="" S XMSUBJ=$$XMSUBJ("XMSUBJ",$G(XMSUBJ))
I $D(XMTO) D XMTO^XMXPARM1(.XMTO,$G(XMINSTR("ADDR FLAGS"))["I") ; ok
Q
REPLYMSG(XMDUZ,XMK,XMKZ,XMBODY,XMINSTR) ;
D ACTMSG(.XMDUZ,.XMK,.XMKZ)
D XMBODY^XMXPARM1(.XMBODY)
D:$D(XMINSTR) XMINSTR(.XMINSTR)
I $G(XMINSTR("NET REPLY")),$G(XMINSTR("NET SUBJ"))'="" S XMINSTR("NET SUBJ")=$$XMSUBJ("XMINSTR(""NET SUBJ"")",XMINSTR("NET SUBJ"))
Q
SENDMSG(XMDUZ,XMSUBJ,XMBODY,XMTO,XMINSTR,XMATTACH) ;
K XMERR,^TMP("XMERR",$J)
D XMDUZ(.XMDUZ,.XMV)
S XMSUBJ=$$XMSUBJ("XMSUBJ",$G(XMSUBJ))
D XMBODY^XMXPARM1(.XMBODY)
D XMTO^XMXPARM1(.XMTO,$G(XMINSTR("ADDR FLAGS"))["I") ; need at least one
D:$D(XMINSTR) XMINSTR(.XMINSTR)
D:$D(XMATTACH) XMATTACH^XMXPARM1(.XMATTACH)
Q
VAPORMSG(XMDUZ,XMK,XMKZA,XMINSTR) ;
D ACTMSGS(.XMDUZ,.XMK,.XMKZA)
I $D(XMINSTR("VAPOR")) D Q
. I XMINSTR("VAPOR")="@" Q
. S XMINSTR("VAPOR")=$$XMDATE("XMINSTR(""VAPOR"")",XMINSTR("VAPOR"))
I $G(XMINSTR)'="" D Q
. I XMINSTR="@" Q
. S XMINSTR=$$XMDATE("VAPOR",XMINSTR)
D ERRSET^XMXUTIL(39417) ;Vaporize date must be supplied.
Q
ADDRNSND(XMDUZ,XMZ,XMTO,XMINSTR) ;
K XMERR,^TMP("XMERR",$J)
D XMDUZ(.XMDUZ,.XMV)
D XMZ(.XMZ)
D XMTO^XMXPARM1(.XMTO,$G(XMINSTR("ADDR FLAGS"))["I") ; need at least one
D:$D(XMINSTR) XMINSTR(.XMINSTR)
Q
MOVEBODY(XMZ,XMBODY) ;
K XMERR,^TMP("XMERR",$J)
D XMZ(.XMZ)
D XMBODY^XMXPARM1(.XMBODY)
Q
VSUBJ(XMSUBJ) ;
K XMERR,^TMP("XMERR",$J)
S XMSUBJ=$$XMSUBJ("XMSUBJ",$G(XMSUBJ))
Q
ITOWHOM(XMDUZ,XMZ,XMTYPE,XMINSTR) ;
K XMERR,^TMP("XMERR",$J)
D XMDUZ(.XMDUZ,.XMV)
D XMFLAG("XMTYPE",XMTYPE,"SF")
I XMTYPE'="S",XMINSTR("ADDR FLAGS")'["R" D XMZ(.XMZ)
D:$D(XMINSTR) XMINSTR(.XMINSTR)
Q
TOWHOM(XMDUZ,XMZ,XMTYPE,XMTO,XMINSTR) ;
D ITOWHOM(.XMDUZ,.XMZ,.XMTYPE,.XMINSTR)
D XMTO^XMXPARM1(XMTO,$G(XMINSTR("ADDR FLAGS"))["I") ; need at least one
Q
XMDUZ(XMDUZ,XMV) ;
S:$G(XMDUZ)="" XMDUZ=DUZ
D CHKUSER^XMXPARM1(.XMDUZ)
; Need XMV "NAME","DUZ NAME", "NETNAME", "VERSION"
; ^XMB("NETNAME"),^XMB("NUM"),^XMB("VIA")
I XMDUZ'=DUZ D
. I $D(^XUSEC("XMNOPRIV",DUZ)) D Q ;You have been given the XMNOPRIV
. . D ERRSET^XMXUTIL(38053) ;key and may not become anyone's surrogate.
. I XMDUZ'=.6,'$D(^XMB(3.7,"AB",DUZ,XMDUZ)) D Q
. . ;You are not authorized to be a surrogate of DUZ |1|.
. . D ERRSET^XMXUTIL(39401,XMDUZ)
I $D(XMV("VERSION")),$G(XMV("DUZ NAME"))=$$NAME^XMXUTIL(DUZ),$G(XMV("NAME"))=$$NAME^XMXUTIL(XMDUZ) Q
D INITAPI^XMVVITAE
Q
XMSUBJ(XMPARM,XMSUBJ) ; Validate a prospective message subject
;I $G(XMSUBJ)="" D ERRSET^XMXUTIL(39402) Q "" ;No subject.
I XMSUBJ?.E1C.E S XMSUBJ=$$CTRL^XMXUTIL1(XMSUBJ)
I $E(XMSUBJ,1)=" "!($E(XMSUBJ,$L(XMSUBJ))=" ") S XMSUBJ=$$STRIP^XMXUTIL1(XMSUBJ)
I XMSUBJ[" " S XMSUBJ=$$MAXBLANK^XMXUTIL1(XMSUBJ)
I $G(XMSUBJ)="" Q $$EZBLD^DIALOG(34012) ;* No Subject *
I $L(XMSUBJ)+(2*($L(XMSUBJ,U)-1))>65!($L(XMSUBJ)<3) D Q XMSUBJ
. D ERRSET^XMXUTIL(39403) ;Subject must be from 3 to 65 characters long.
I XMSUBJ?1"R".N D Q XMSUBJ
. D ERRSET^XMXUTIL(39404) ;Subject 'Rnnn' reserved.
;D CHK^DIE(3.9,.01,"H",XMSUBJ)
Q XMSUBJ
XMINSTR(XMINSTR) ; Validate special instructions
S:$D(XMINSTR("RCPT BSKT")) XMINSTR("RCPT BSKT")=$$XMKN^XMXPARMB(XMDUZ,"XMINSTR(""RCPT BSKT"")",XMINSTR("RCPT BSKT"),1)
S:$D(XMINSTR("SELF BSKT")) XMINSTR("SELF BSKT")=$$XMK(XMDUZ,"XMINSTR(""SELF BSKT"")",XMINSTR("SELF BSKT"),1)
I $D(XMINSTR("SHARE DATE")) S XMINSTR("SHARE DATE")=$$XMDATE("XMINSTR(""SHARE DATE"")",XMINSTR("SHARE DATE"))
S:$D(XMINSTR("SHARE BSKT")) XMINSTR("SHARE BSKT")=$$XMK(.6,"XMINSTR(""SHARE BSKT"")",XMINSTR("SHARE BSKT"),1)
I $D(XMINSTR("VAPOR")) S XMINSTR("VAPOR")=$$XMDATE("XMINSTR(""VAPOR"")",XMINSTR("VAPOR"))
I $D(XMINSTR("LATER")) S XMINSTR("LATER")=$$XMDATE("XMINSTR(""LATER"")",XMINSTR("LATER"))
I $D(XMINSTR("FROM")) S XMINSTR("FROM")=$$XMFROM("XMINSTR(""FROM"")",XMINSTR("FROM"))
I $D(XMINSTR("FWD BY")) S XMINSTR("FWD BY")=$$XMFROM("XMINSTR(""FWD BY"")",XMINSTR("FWD BY"))
D:$D(XMINSTR("FLAGS")) XMFLAG("XMINSTR(""FLAGS"")",XMINSTR("FLAGS"),"CIPRSX")
I $D(XMINSTR("SCR KEY"))!$D(XMINSTR("SCR HINT")) D
. D XMKEY^XMXPARM1($G(XMINSTR("SCR KEY")))
. D XMHINT^XMXPARM1($G(XMINSTR("SCR HINT")))
D:$D(XMINSTR("TYPE")) XMTYPE(XMINSTR("TYPE"))
D:$D(XMINSTR("STRIP")) XMSTRIP^XMXPARM1(XMINSTR("STRIP"))
Q
XMDATE(XMPARM,XMDATE) ;
N %DT,Y,X
S X=XMDATE
S %DT="FT",%DT(0)="NOW"
D ^%DT
Q:Y>0 Y
N XMP
S XMP("PARAM","ID")=XMPARM
S XMP("PARAM","VALUE")=XMDATE
D ERRSET^XMXUTIL(39409,.XMP) ;Must be a date in the future.
Q XMDATE
XMFROM(XMPARM,XMFROM) ;
;Code below is preventing valid new person file entries from Processing
;N XMHOLD
Q:XMFROM=.5 XMFROM
I +XMFROM=XMFROM!(XMFROM[U)!($L(XMFROM)>65)!(XMFROM="") D Q XMFROM
. N XMP S XMP("PARAM","ID")=XMPARM,XMP("PARAM","VALUE")=XMFROM
. ;S XMP("PARAM","FILE")=X,XMP("PARAM","FIELD")=Y
. ;Must be from 1 to 65 characters, no # or ^.
. D ERRSET^XMXUTIL(39410,.XMP)
;S XMHOLD=XMFROM
;S XMFROM=$$CTRL^XMXUTIL1(XMFROM)
;S XMFROM=$$STRIP^XMXUTIL1(XMFROM)
;S XMFROM=$$MAXBLANK^XMXUTIL1(XMFROM)
;Q:XMFROM["POSTMASTER" XMFROM
; "B^BB^C^D" = name^alias^initial^nickname
;I '$$FIND1^DIC(200,"","O",$$UP^XLFSTR(XMFROM),"B^BB^C^D")!$D(DIERR) D Q XMHOLD
;. N XMP S XMP("PARAM","ID")=XMPARM,XMP("PARAM","VALUE")=XMHOLD
;. ;S XMP("PARAM","FILE")=X,XMP("PARAM","FIELD")=Y
;. D ERRSET^XMXUTIL(39411,.XMP) ;May not be a real person.
Q XMFROM
XMTYPE(XMTYPE) ; Validate a message type
I $L(XMTYPE)'=1 D Q
. N XMP S XMP("PARAM","ID")="XMINSTR(""TYPE"")",XMP("PARAM","VALUE")=XMTYPE
. ;S XMPARM("PARAM","FILE")=3.9,XMPARM("PARAM","FIELD")=1.7
. D ERRSET^XMXUTIL(39412,.XMP) ;Must be 1 character.
D XMFLAG("XMINSTR(""TYPE"")",XMTYPE,"BDKOSX")
Q
XMFLAG(XMPARM,XMFLAG,FLAGSET) ;
N XMLEFT
S XMLEFT=$TR(XMFLAG,FLAGSET,"")
Q:XMLEFT=""
N XMP S XMP("PARAM","ID")=XMPARM,XMP("PARAM","VALUE")=XMFLAG,XMP(1)=XMLEFT
D ERRSET^XMXUTIL(39413,.XMP) ;|1| is not valid.
Q
XMKTO(XMDUZ,XMKTO) ;
I $G(XMKTO)="" D Q
. N XMP S XMP("PARAM","ID")="XMKTO",XMP("PARAM","VALUE")=""
. D ERRSET^XMXUTIL(39416,.XMP) ;Destination basket must be supplied.
S XMKTO=$$XMK(XMDUZ,"XMKTO",XMKTO)
Q
XMK(XMDUZ,XMPARM,XMK,XMOPTNL) ;
I +XMK=XMK,$D(^XMB(3.7,XMDUZ,2,XMK)) Q XMK
; Just in case a name was passed...
N XMKN
S XMKN=XMK
S XMK=$$FIND1^DIC(3.701,","_XMDUZ_",","OQ",XMKN)
Q:XMK XMK
I '$D(DIERR),$G(XMOPTNL) Q XMKN ; Basket not found. Will create on delivery.
N XMP S XMP("PARAM","ID")=XMPARM,XMP("PARAM","VALUE")=XMKN,XMP(1)=XMKN
;Basket name '|1|' ambiguous / not found.
D ERRSET^XMXUTIL($S($D(DIERR):39414,1:39415),.XMP)
Q XMKN
XMZ(XMZ) ;
I $G(XMZ),$D(^XMB(3.9,XMZ,0)) Q
D ERRSET^XMXUTIL(34353,XMZ) ;Message '|1|' does not exist.
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMXPARM 8789 printed Dec 13, 2024@02:14:18 Page 2
XMXPARM ;ISC-SF/GMB-Parameter check ;03/26/2003 08:00
+1 ;;8.0;MailMan;**15,45**;Jun 28, 2002;Build 8
ACTMSGS(XMDUZ,XMK,XMKZA) ;
+1 KILL XMERR,^TMP("XMERR",$JOB)
+2 DO XMDUZ(.XMDUZ,.XMV)
+3 IF $GET(XMK)'=""
SET XMK=$$XMK(XMDUZ,"XMK",XMK)
+4 DO XMKZA^XMXPARM1(.XMKZA)
+5 QUIT
ACTMSG(XMDUZ,XMK,XMKZ) ;
+1 KILL XMERR,^TMP("XMERR",$JOB)
+2 DO XMDUZ(.XMDUZ,.XMV)
+3 IF $GET(XMK)'=""
Begin DoDot:1
+4 SET XMK=$$XMK(XMDUZ,"XMK",XMK)
+5 DO XMKZ^XMXPARM1(XMK,.XMKZ)
End DoDot:1
+6 IF '$TEST
DO XMZ(.XMKZ)
+7 QUIT
ANSRMSG(XMDUZ,XMK,XMKZ,XMSUBJ,XMBODY,XMTO,XMINSTR) ;
+1 DO ACTMSG(.XMDUZ,.XMK,.XMKZ)
+2 IF $GET(XMSUBJ)'=""
SET XMSUBJ=$$XMSUBJ("XMSUBJ",$GET(XMSUBJ))
+3 DO XMBODY^XMXPARM1(.XMBODY)
+4 ; truly optional
if $DATA(XMTO)
DO XMTO^XMXPARM1(.XMTO,$GET(XMINSTR("ADDR FLAGS"))["I")
+5 if $DATA(XMINSTR)
DO XMINSTR(.XMINSTR)
+6 QUIT
BULLETIN(XMDUZ,XMBN,XMPARM,XMBODY,XMTO,XMINSTR,XMATTACH) ;
+1 KILL XMERR,^TMP("XMERR",$JOB)
+2 DO XMDUZ(.XMDUZ,.XMV)
+3 DO XMBN^XMXPARM1(.XMBN)
+4 if $DATA(XMBODY)
DO XMBODY^XMXPARM1(.XMBODY,1)
+5 ; truly optional
if $DATA(XMTO)
DO XMTO^XMXPARM1(.XMTO,$GET(XMINSTR("ADDR FLAGS"))["I")
+6 if $DATA(XMINSTR)
DO XMINSTR(.XMINSTR)
+7 QUIT
FWDMSG(XMDUZ,XMK,XMKZA,XMTO,XMINSTR) ;
+1 DO ACTMSGS(.XMDUZ,.XMK,.XMKZA)
+2 ; need at least one
DO XMTO^XMXPARM1(.XMTO,$GET(XMINSTR("ADDR FLAGS"))["I")
+3 if $DATA(XMINSTR)
DO XMINSTR(.XMINSTR)
+4 QUIT
LATERMSG(XMDUZ,XMK,XMKZA,XMINSTR) ;
+1 DO ACTMSGS(.XMDUZ,.XMK,.XMKZA)
+2 IF $DATA(XMINSTR("LATER"))
Begin DoDot:1
+3 ;I XMINSTR("LATER")="@" Q
+4 SET XMINSTR("LATER")=$$XMDATE("XMINSTR(""LATER"")",XMINSTR("LATER"))
End DoDot:1
QUIT
+5 IF $GET(XMINSTR)'=""
Begin DoDot:1
+6 ;I XMINSTR="@" Q
+7 SET XMINSTR=$$XMDATE("LATER",XMINSTR)
End DoDot:1
QUIT
+8 ;Later date must be supplied.
DO ERRSET^XMXUTIL(39419)
+9 QUIT
MOVEMSG(XMDUZ,XMK,XMKZA,XMKTO) ;
+1 DO ACTMSGS(.XMDUZ,.XMK,.XMKZA)
+2 DO XMKTO(XMDUZ,.XMKTO)
+3 QUIT
PRTMSG(XMDUZ,XMK,XMKZA,XMPRTTO,XMINSTR,XMSUBJ,XMTO) ;
+1 DO ACTMSGS(.XMDUZ,.XMK,.XMKZA)
+2 if '$DATA(XMINSTR)
QUIT
+3 IF $DATA(XMINSTR("WHEN"))
SET XMINSTR("WHEN")=$$XMDATE("XMINSTR(""WHEN"")",XMINSTR("WHEN"))
+4 IF $DATA(XMINSTR("HDR"))
DO XMCODE^XMXPARM1("XMINSTR(""HDR"")",XMINSTR("HDR"),"^0^1^")
+5 IF $DATA(XMINSTR("RECIPS"))
DO XMCODE^XMXPARM1("XMINSTR(""RECIPS"")",XMINSTR("RECIPS"),"^0^1^2^")
+6 IF $GET(XMSUBJ)'=""
SET XMSUBJ=$$XMSUBJ("XMSUBJ",$GET(XMSUBJ))
+7 ; ok
IF $DATA(XMTO)
DO XMTO^XMXPARM1(.XMTO,$GET(XMINSTR("ADDR FLAGS"))["I")
+8 QUIT
REPLYMSG(XMDUZ,XMK,XMKZ,XMBODY,XMINSTR) ;
+1 DO ACTMSG(.XMDUZ,.XMK,.XMKZ)
+2 DO XMBODY^XMXPARM1(.XMBODY)
+3 if $DATA(XMINSTR)
DO XMINSTR(.XMINSTR)
+4 IF $GET(XMINSTR("NET REPLY"))
IF $GET(XMINSTR("NET SUBJ"))'=""
SET XMINSTR("NET SUBJ")=$$XMSUBJ("XMINSTR(""NET SUBJ"")",XMINSTR("NET SUBJ"))
+5 QUIT
SENDMSG(XMDUZ,XMSUBJ,XMBODY,XMTO,XMINSTR,XMATTACH) ;
+1 KILL XMERR,^TMP("XMERR",$JOB)
+2 DO XMDUZ(.XMDUZ,.XMV)
+3 SET XMSUBJ=$$XMSUBJ("XMSUBJ",$GET(XMSUBJ))
+4 DO XMBODY^XMXPARM1(.XMBODY)
+5 ; need at least one
DO XMTO^XMXPARM1(.XMTO,$GET(XMINSTR("ADDR FLAGS"))["I")
+6 if $DATA(XMINSTR)
DO XMINSTR(.XMINSTR)
+7 if $DATA(XMATTACH)
DO XMATTACH^XMXPARM1(.XMATTACH)
+8 QUIT
VAPORMSG(XMDUZ,XMK,XMKZA,XMINSTR) ;
+1 DO ACTMSGS(.XMDUZ,.XMK,.XMKZA)
+2 IF $DATA(XMINSTR("VAPOR"))
Begin DoDot:1
+3 IF XMINSTR("VAPOR")="@"
QUIT
+4 SET XMINSTR("VAPOR")=$$XMDATE("XMINSTR(""VAPOR"")",XMINSTR("VAPOR"))
End DoDot:1
QUIT
+5 IF $GET(XMINSTR)'=""
Begin DoDot:1
+6 IF XMINSTR="@"
QUIT
+7 SET XMINSTR=$$XMDATE("VAPOR",XMINSTR)
End DoDot:1
QUIT
+8 ;Vaporize date must be supplied.
DO ERRSET^XMXUTIL(39417)
+9 QUIT
ADDRNSND(XMDUZ,XMZ,XMTO,XMINSTR) ;
+1 KILL XMERR,^TMP("XMERR",$JOB)
+2 DO XMDUZ(.XMDUZ,.XMV)
+3 DO XMZ(.XMZ)
+4 ; need at least one
DO XMTO^XMXPARM1(.XMTO,$GET(XMINSTR("ADDR FLAGS"))["I")
+5 if $DATA(XMINSTR)
DO XMINSTR(.XMINSTR)
+6 QUIT
MOVEBODY(XMZ,XMBODY) ;
+1 KILL XMERR,^TMP("XMERR",$JOB)
+2 DO XMZ(.XMZ)
+3 DO XMBODY^XMXPARM1(.XMBODY)
+4 QUIT
VSUBJ(XMSUBJ) ;
+1 KILL XMERR,^TMP("XMERR",$JOB)
+2 SET XMSUBJ=$$XMSUBJ("XMSUBJ",$GET(XMSUBJ))
+3 QUIT
ITOWHOM(XMDUZ,XMZ,XMTYPE,XMINSTR) ;
+1 KILL XMERR,^TMP("XMERR",$JOB)
+2 DO XMDUZ(.XMDUZ,.XMV)
+3 DO XMFLAG("XMTYPE",XMTYPE,"SF")
+4 IF XMTYPE'="S"
IF XMINSTR("ADDR FLAGS")'["R"
DO XMZ(.XMZ)
+5 if $DATA(XMINSTR)
DO XMINSTR(.XMINSTR)
+6 QUIT
TOWHOM(XMDUZ,XMZ,XMTYPE,XMTO,XMINSTR) ;
+1 DO ITOWHOM(.XMDUZ,.XMZ,.XMTYPE,.XMINSTR)
+2 ; need at least one
DO XMTO^XMXPARM1(XMTO,$GET(XMINSTR("ADDR FLAGS"))["I")
+3 QUIT
XMDUZ(XMDUZ,XMV) ;
+1 if $GET(XMDUZ)=""
SET XMDUZ=DUZ
+2 DO CHKUSER^XMXPARM1(.XMDUZ)
+3 ; Need XMV "NAME","DUZ NAME", "NETNAME", "VERSION"
+4 ; ^XMB("NETNAME"),^XMB("NUM"),^XMB("VIA")
+5 IF XMDUZ'=DUZ
Begin DoDot:1
+6 ;You have been given the XMNOPRIV
IF $DATA(^XUSEC("XMNOPRIV",DUZ))
Begin DoDot:2
+7 ;key and may not become anyone's surrogate.
DO ERRSET^XMXUTIL(38053)
End DoDot:2
QUIT
+8 IF XMDUZ'=.6
IF '$DATA(^XMB(3.7,"AB",DUZ,XMDUZ))
Begin DoDot:2
+9 ;You are not authorized to be a surrogate of DUZ |1|.
+10 DO ERRSET^XMXUTIL(39401,XMDUZ)
End DoDot:2
QUIT
End DoDot:1
+11 IF $DATA(XMV("VERSION"))
IF $GET(XMV("DUZ NAME"))=$$NAME^XMXUTIL(DUZ)
IF $GET(XMV("NAME"))=$$NAME^XMXUTIL(XMDUZ)
QUIT
+12 DO INITAPI^XMVVITAE
+13 QUIT
XMSUBJ(XMPARM,XMSUBJ) ; Validate a prospective message subject
+1 ;I $G(XMSUBJ)="" D ERRSET^XMXUTIL(39402) Q "" ;No subject.
+2 IF XMSUBJ?.E1C.E
SET XMSUBJ=$$CTRL^XMXUTIL1(XMSUBJ)
+3 IF $EXTRACT(XMSUBJ,1)=" "!($EXTRACT(XMSUBJ,$LENGTH(XMSUBJ))=" ")
SET XMSUBJ=$$STRIP^XMXUTIL1(XMSUBJ)
+4 IF XMSUBJ[" "
SET XMSUBJ=$$MAXBLANK^XMXUTIL1(XMSUBJ)
+5 ;* No Subject *
IF $GET(XMSUBJ)=""
QUIT $$EZBLD^DIALOG(34012)
+6 IF $LENGTH(XMSUBJ)+(2*($LENGTH(XMSUBJ,U)-1))>65!($LENGTH(XMSUBJ)<3)
Begin DoDot:1
+7 ;Subject must be from 3 to 65 characters long.
DO ERRSET^XMXUTIL(39403)
End DoDot:1
QUIT XMSUBJ
+8 IF XMSUBJ?1"R".N
Begin DoDot:1
+9 ;Subject 'Rnnn' reserved.
DO ERRSET^XMXUTIL(39404)
End DoDot:1
QUIT XMSUBJ
+10 ;D CHK^DIE(3.9,.01,"H",XMSUBJ)
+11 QUIT XMSUBJ
XMINSTR(XMINSTR) ; Validate special instructions
+1 if $DATA(XMINSTR("RCPT BSKT"))
SET XMINSTR("RCPT BSKT")=$$XMKN^XMXPARMB(XMDUZ,"XMINSTR(""RCPT BSKT"")",XMINSTR("RCPT BSKT"),1)
+2 if $DATA(XMINSTR("SELF BSKT"))
SET XMINSTR("SELF BSKT")=$$XMK(XMDUZ,"XMINSTR(""SELF BSKT"")",XMINSTR("SELF BSKT"),1)
+3 IF $DATA(XMINSTR("SHARE DATE"))
SET XMINSTR("SHARE DATE")=$$XMDATE("XMINSTR(""SHARE DATE"")",XMINSTR("SHARE DATE"))
+4 if $DATA(XMINSTR("SHARE BSKT"))
SET XMINSTR("SHARE BSKT")=$$XMK(.6,"XMINSTR(""SHARE BSKT"")",XMINSTR("SHARE BSKT"),1)
+5 IF $DATA(XMINSTR("VAPOR"))
SET XMINSTR("VAPOR")=$$XMDATE("XMINSTR(""VAPOR"")",XMINSTR("VAPOR"))
+6 IF $DATA(XMINSTR("LATER"))
SET XMINSTR("LATER")=$$XMDATE("XMINSTR(""LATER"")",XMINSTR("LATER"))
+7 IF $DATA(XMINSTR("FROM"))
SET XMINSTR("FROM")=$$XMFROM("XMINSTR(""FROM"")",XMINSTR("FROM"))
+8 IF $DATA(XMINSTR("FWD BY"))
SET XMINSTR("FWD BY")=$$XMFROM("XMINSTR(""FWD BY"")",XMINSTR("FWD BY"))
+9 if $DATA(XMINSTR("FLAGS"))
DO XMFLAG("XMINSTR(""FLAGS"")",XMINSTR("FLAGS"),"CIPRSX")
+10 IF $DATA(XMINSTR("SCR KEY"))!$DATA(XMINSTR("SCR HINT"))
Begin DoDot:1
+11 DO XMKEY^XMXPARM1($GET(XMINSTR("SCR KEY")))
+12 DO XMHINT^XMXPARM1($GET(XMINSTR("SCR HINT")))
End DoDot:1
+13 if $DATA(XMINSTR("TYPE"))
DO XMTYPE(XMINSTR("TYPE"))
+14 if $DATA(XMINSTR("STRIP"))
DO XMSTRIP^XMXPARM1(XMINSTR("STRIP"))
+15 QUIT
XMDATE(XMPARM,XMDATE) ;
+1 NEW %DT,Y,X
+2 SET X=XMDATE
+3 SET %DT="FT"
SET %DT(0)="NOW"
+4 DO ^%DT
+5 if Y>0
QUIT Y
+6 NEW XMP
+7 SET XMP("PARAM","ID")=XMPARM
+8 SET XMP("PARAM","VALUE")=XMDATE
+9 ;Must be a date in the future.
DO ERRSET^XMXUTIL(39409,.XMP)
+10 QUIT XMDATE
XMFROM(XMPARM,XMFROM) ;
+1 ;Code below is preventing valid new person file entries from Processing
+2 ;N XMHOLD
+3 if XMFROM=.5
QUIT XMFROM
+4 IF +XMFROM=XMFROM!(XMFROM[U)!($LENGTH(XMFROM)>65)!(XMFROM="")
Begin DoDot:1
+5 NEW XMP
SET XMP("PARAM","ID")=XMPARM
SET XMP("PARAM","VALUE")=XMFROM
+6 ;S XMP("PARAM","FILE")=X,XMP("PARAM","FIELD")=Y
+7 ;Must be from 1 to 65 characters, no # or ^.
+8 DO ERRSET^XMXUTIL(39410,.XMP)
End DoDot:1
QUIT XMFROM
+9 ;S XMHOLD=XMFROM
+10 ;S XMFROM=$$CTRL^XMXUTIL1(XMFROM)
+11 ;S XMFROM=$$STRIP^XMXUTIL1(XMFROM)
+12 ;S XMFROM=$$MAXBLANK^XMXUTIL1(XMFROM)
+13 ;Q:XMFROM["POSTMASTER" XMFROM
+14 ; "B^BB^C^D" = name^alias^initial^nickname
+15 ;I '$$FIND1^DIC(200,"","O",$$UP^XLFSTR(XMFROM),"B^BB^C^D")!$D(DIERR) D Q XMHOLD
+16 ;. N XMP S XMP("PARAM","ID")=XMPARM,XMP("PARAM","VALUE")=XMHOLD
+17 ;. ;S XMP("PARAM","FILE")=X,XMP("PARAM","FIELD")=Y
+18 ;. D ERRSET^XMXUTIL(39411,.XMP) ;May not be a real person.
+19 QUIT XMFROM
XMTYPE(XMTYPE) ; Validate a message type
+1 IF $LENGTH(XMTYPE)'=1
Begin DoDot:1
+2 NEW XMP
SET XMP("PARAM","ID")="XMINSTR(""TYPE"")"
SET XMP("PARAM","VALUE")=XMTYPE
+3 ;S XMPARM("PARAM","FILE")=3.9,XMPARM("PARAM","FIELD")=1.7
+4 ;Must be 1 character.
DO ERRSET^XMXUTIL(39412,.XMP)
End DoDot:1
QUIT
+5 DO XMFLAG("XMINSTR(""TYPE"")",XMTYPE,"BDKOSX")
+6 QUIT
XMFLAG(XMPARM,XMFLAG,FLAGSET) ;
+1 NEW XMLEFT
+2 SET XMLEFT=$TRANSLATE(XMFLAG,FLAGSET,"")
+3 if XMLEFT=""
QUIT
+4 NEW XMP
SET XMP("PARAM","ID")=XMPARM
SET XMP("PARAM","VALUE")=XMFLAG
SET XMP(1)=XMLEFT
+5 ;|1| is not valid.
DO ERRSET^XMXUTIL(39413,.XMP)
+6 QUIT
XMKTO(XMDUZ,XMKTO) ;
+1 IF $GET(XMKTO)=""
Begin DoDot:1
+2 NEW XMP
SET XMP("PARAM","ID")="XMKTO"
SET XMP("PARAM","VALUE")=""
+3 ;Destination basket must be supplied.
DO ERRSET^XMXUTIL(39416,.XMP)
End DoDot:1
QUIT
+4 SET XMKTO=$$XMK(XMDUZ,"XMKTO",XMKTO)
+5 QUIT
XMK(XMDUZ,XMPARM,XMK,XMOPTNL) ;
+1 IF +XMK=XMK
IF $DATA(^XMB(3.7,XMDUZ,2,XMK))
QUIT XMK
+2 ; Just in case a name was passed...
+3 NEW XMKN
+4 SET XMKN=XMK
+5 SET XMK=$$FIND1^DIC(3.701,","_XMDUZ_",","OQ",XMKN)
+6 if XMK
QUIT XMK
+7 ; Basket not found. Will create on delivery.
IF '$DATA(DIERR)
IF $GET(XMOPTNL)
QUIT XMKN
+8 NEW XMP
SET XMP("PARAM","ID")=XMPARM
SET XMP("PARAM","VALUE")=XMKN
SET XMP(1)=XMKN
+9 ;Basket name '|1|' ambiguous / not found.
+10 DO ERRSET^XMXUTIL($SELECT($DATA(DIERR):39414,1:39415),.XMP)
+11 QUIT XMKN
XMZ(XMZ) ;
+1 IF $GET(XMZ)
IF $DATA(^XMB(3.9,XMZ,0))
QUIT
+2 ;Message '|1|' does not exist.
DO ERRSET^XMXUTIL(34353,XMZ)
+3 QUIT
