XMXSEC ;ISC-SF/GMB-Message security and restrictions ;05/17/2002 13:25
;;8.0;MailMan;;Jun 28, 2002
; All entry points covered by DBIA 2731.
BCAST(XMZ) ; 0=msg was not broadcast; 1=msg was broadcast
N XMBCAST
S XMBCAST=$$EZBLD^DIALOG(39006) ; * (Broadcast to all local users)
Q:$D(^XMB(3.9,XMZ,1,"C",$E(XMBCAST,1,30))) 1
Q:$D(^XMB(3.9,XMZ,1,"C",XMBCAST)) 1
Q 0
ZCLOSED(XMZ) ;
Q $$CLOSED($G(^XMB(3.9,XMZ,0)))
CLOSED(XMZREC) ; 0=msg is not closed; 1=msg is closed
Q "^Y^y^"[(U_$P(XMZREC,U,9)_U)
ZCONFID(XMZ) ;
Q $$CONFID($G(^XMB(3.9,XMZ,0)))
CONFID(XMZREC) ; 0=msg is not confidential; 1=msg is confidential
Q "^Y^y^"[(U_$P(XMZREC,U,11)_U)
ZCONFIRM(XMZ) ;
Q $$CONFIRM($G(^XMB(3.9,XMZ,0)))
CONFIRM(XMZREC) ; 0=msg is not confirm receipt requested; 1=msg is confirm
Q "^Y^y^"[(U_$P(XMZREC,U,5)_U)
ZINFO(XMZ) ;
Q $$INFO($G(^XMB(3.9,XMZ,0)))
INFO(XMZREC) ; 0=msg is not information only; 1=msg is information only
Q "^Y^y^"[(U_$P(XMZREC,U,12)_U)
ZORIGIN8(XMDUZ,XMZ) ;
Q $$ORIGIN8R(XMDUZ,$G(^XMB(3.9,XMZ,0)))
ORIGIN8R(XMDUZ,XMZREC) ; Did the user send the message?
; 1=user is the originator ; 0=user is NOT the originator
Q:XMDUZ=$P(XMZREC,U,2) 1
Q:XMDUZ=$P(XMZREC,U,4) 1
Q:XMDUZ=DUZ 0
Q:DUZ=$P(XMZREC,U,2) 1
Q:DUZ=$P(XMZREC,U,4) 1
Q 0
ZPRI(XMZ) ;
Q $$PRIORITY($G(^XMB(3.9,XMZ,0)))
PRIORITY(XMZREC) ; 0=msg is not priority; 1=msg is priority
Q $P(XMZREC,U,7)["P"
SURRCONF(XMDUZ,XMZ) ; 0=msg is not confidential; 1=msg is confidential, and surrogate may not read it.
; We already know that XMDUZ'=DUZ.
; But the surrogate may read a confidential message if it was the
; surrogate who sent it.
Q:"^Y^y^"'[(U_$P($G(^XMB(3.9,+XMZ,0)),U,11)_U) 0
Q:DUZ=$P(^(0),U,2) 0 ; naked ref from above
Q:DUZ=$P(^(0),U,4) 0 ; naked ref from above
Q 1
ACCESS(XMDUZ,XMZ,XMZREC) ; Determines user access to a message.
; 1=user may access; 0=user may not access
Q:$D(^XMB(3.7,"M",XMZ,XMDUZ)) $S(XMDUZ=DUZ:1,1:$$SURRACC(XMDUZ,"",XMZ,$G(XMZREC))) ; Message is in user's mailbox
N XMPRE
S XMPRE=$P(^XMB(3.7,XMDUZ,0),U,7)
I XMPRE,$P($G(^XMB(3.9,XMZ,.6)),U,1)<XMPRE D Q 0
. D ERRSET^XMXUTIL(37100,$$MMDT^XMXUTIL1(XMPRE),XMZ) ; You may not access any message prior to _X_ unless someone forwards it to you.
Q:$D(^XMB(3.9,XMZ,1,"C",XMDUZ)) $S(XMDUZ=DUZ:1,1:$$SURRACC(XMDUZ,"",XMZ,$G(XMZREC))) ; User is recipient
;Q:$D(^XMB(3.9,XMZ,1,"C",DUZ)) 1 ; Surrogate is a recipient.
; We comment out the above line, because it's not enough that the
; surrogate is a recipient of the message. If the surrogate wants to
; access the message as XMDUZ, and the message is not in the mailbox
; of XMDUZ, then the message must have been sent by or to XMDUZ.
Q:$$BCAST(XMZ) 1
I $G(XMZREC)="" S XMZREC=$G(^XMB(3.9,XMZ,0))
I $P(XMZREC,U,8) D Q 0
. N XMPARM
. S XMPARM(1)=XMZ,XMPARM(2)=$P(XMZREC,U,8)
. D ERRSET^XMXUTIL(37101,.XMPARM,XMZ) ; Message _XMZ_ is a response to message _$P(XMZREC,U,8)_.
; User (XMDUZ) is not a recipient. Investigate further.
Q $$ACCESS2^XMXSEC1(XMDUZ,XMZ,XMZREC)
SURRACC(XMDUZ,XMACCESS,XMZ,XMZREC) ; Determines surrogate access to a message.
; Assumes that we already know that XMDUZ is authorized to see this
; message, and that XMDUZ'=DUZ. Now we want to know if DUZ may see it.
; 1=surrogate may access; 0=surrogate may not access
I $G(XMZREC)="" S XMZREC=$G(^XMB(3.9,XMZ,0))
Q:'$$CONFID(XMZREC) 1 ; Message isn't confidential.
Q:DUZ=$P(XMZREC,U,2) 1 ; Surrogate sent the message.
Q:DUZ=$P(XMZREC,U,4) 1 ; Surrogate sent the message.
;Q:$D(^XMB(3.9,XMZ,1,"C",DUZ)) 1 ; Surrogate is a recipient.
I $G(XMACCESS)'="" D ERRSET^XMXUTIL(37452,XMACCESS,XMZ) Q 0 ; Surrogates may not _XMACCESS_ CONFIDENTIAL messages.
D ERRSET^XMXUTIL(37451,XMZ) ; Surrogates may not access or do anything to Confidential messages.
Q 0
ANSWER(XMDUZ,XMZ,XMZREC) ; Answer (1=may, 0=may not)
I DUZ=.6!(XMDUZ=.6) D ERRSET^XMXUTIL(37462,"",XMZ) Q 0 ; You may not do this in SHARED,MAIL.
I XMDUZ'=DUZ Q:'$$WPRIV 0 Q:'$$SURRACC(XMDUZ,"",XMZ,.XMZREC) 0 ; "answer"
I $G(XMZREC)="" S XMZREC=$G(^XMB(3.9,XMZ,0))
I $$PAKMAN^XMXSEC1(XMZ,XMZREC) D ERRSET^XMXUTIL(37401.4,"",XMZ) Q 0 ; May not answer a PackMan message.
I $D(^XMB(3.9,XMZ,"K")) D ERRSET^XMXUTIL(47401.2,"",XMZ) Q 0 ; May not answer a scrambled message. Use Reply.
I '$$GOTNS^XMVVITA(XMDUZ) D ERRSET^XMXUTIL($S(XMDUZ=DUZ:37401.1,1:37401.3),XMV("NAME"),XMZ) Q 0 ; You / X must have a network signature in order to answer a message.
Q 1
COPY(XMDUZ,XMZ,XMZREC) ; Copy (1=may, 0=may not)
I XMDUZ'=DUZ Q:'$$WPRIV 0 Q:'$$SURRACC(XMDUZ,"",XMZ,.XMZREC) 0 ; "copy"
I $G(XMZREC)="" S XMZREC=$G(^XMB(3.9,XMZ,0))
I $$CLOSED(XMZREC),'$$ORIGIN8R(XMDUZ,XMZREC) D ERRSET^XMXUTIL(37403.1,"",XMZ) Q 0 ; Only the message originator may copy CLOSED messages.
I XMDUZ=.6,DUZ'=$P(XMZREC,U,2),DUZ'=$P(XMZREC,U,4) D ERRSET^XMXUTIL(37403.6,"",XMZ) Q 0 ; Only the originator may copy messages in SHARED,MAIL.
I $D(^XMB(3.9,XMZ,"K")) D ERRSET^XMXUTIL(37403.2,"",XMZ) Q 0 ; May not copy a scrambled message.
Q 1
INCLUDE(XMDUZ,XMZ,XMZREC) ; Include message XMZ as part of another message (1=may, 0=may not)
; If XMDUZ'=DUZ, assumes that surrogate has the privilege to
; send a new message, or reply to a message.
Q:'$$ACCESS(XMDUZ,XMZ,.XMZREC) 0
I $G(XMZREC)="" S XMZREC=$G(^XMB(3.9,XMZ,0))
I $$CLOSED(XMZREC),'$$ORIGIN8R(XMDUZ,XMZREC) D ERRSET^XMXUTIL(37403.1,"",XMZ) Q 0 ; Only the message originator may copy CLOSED messages.
I $D(^XMB(3.9,XMZ,"K")) D ERRSET^XMXUTIL(37403.2,"",XMZ) Q 0 ; May not copy a scrambled message.
Q 1
DELETE(XMDUZ,XMK,XMZ,XMZREC) ; Delete, Terminate (1=may, 0=may not)
Q:XMDUZ=DUZ 1
Q:'$$RWPRIV 0
;I XMDUZ=.5,$G(XMK,$O(^XMB(3.7,"M",XMZ,XMDUZ,"")))>999 Q 1
I XMDUZ=.5 Q 1
Q:'$$SURRACC(XMDUZ,"",XMZ,.XMZREC) 0 ; "delete"
I $G(XMZREC)="" S XMZREC=$G(^XMB(3.9,XMZ,0))
I XMDUZ=.6,DUZ'=$P(XMZREC,U,2),DUZ'=$P(XMZREC,U,4),'$D(^XUSEC("XMMGR",DUZ)),'$D(^XMB(3.7,"AB",DUZ,.5,0)) D Q 0
. D ERRSET^XMXUTIL(37461,"",XMZ) ; Only the originator, postmaster surrogate, or XMMGR key holder may do this in SHARED,MAIL.
Q 1
FORWARD(XMDUZ,XMZ,XMZREC) ; Forward (1=may, 0=may not)
I XMDUZ'=DUZ Q:'$$RWPRIV 0 Q:'$$SURRACC(XMDUZ,"",XMZ,.XMZREC) 0 ; "forward"
I $G(XMZREC)="" S XMZREC=$G(^XMB(3.9,XMZ,0))
I $$CLOSED(XMZREC),'$$ORIGIN8R(XMDUZ,XMZREC) D ERRSET^XMXUTIL(37406.1,"",XMZ) Q 0 ; Only the message originator may forward CLOSED messages.
I XMDUZ=.6,DUZ'=$P(XMZREC,U,2),DUZ'=$P(XMZREC,U,4) D ERRSET^XMXUTIL(37406.6,"",XMZ) Q 0 ; Only the originator may forward messages in SHARED,MAIL.
Q 1
LATER(XMDUZ) ; Later or New Toggle (1=may, 0=may not)
I DUZ=.6!(XMDUZ=.6) D ERRSET^XMXUTIL(37462) Q 0 ; SHARED,MAIL may not 'later' or 'new toggle' a message.
Q:XMDUZ=DUZ 1
Q $$RWPRIV
MOVE(XMDUZ,XMZ,XMZREC) ; Save or Filter (1=may, 0=may not)
Q:XMDUZ=DUZ 1
Q:'$$RWPRIV 0
;Q:'$$SURRACC(XMDUZ,"",XMZ,.XMZREC) 0 ; "save"
I $G(XMZREC)="" S XMZREC=$G(^XMB(3.9,XMZ,0))
I XMDUZ=.6,DUZ'=$P(XMZREC,U,2),DUZ'=$P(XMZREC,U,4),'$D(^XUSEC("XMMGR",DUZ)),'$D(^XMB(3.7,"AB",DUZ,.5,0)) D Q 0
. D ERRSET^XMXUTIL(37461,"",XMZ) ; Only the originator, postmaster surrogate, or XMMGR key holder may do this in SHARED,MAIL.
Q 1
READ(XMDUZ,XMZ,XMZREC) ; Read or Print (1=may, 0=may not)
Q:XMDUZ=DUZ 1
Q $$SURRACC(XMDUZ,"",XMZ,.XMZREC) ; "access"
REPLY(XMDUZ,XMZ,XMZREC) ; Reply (1=may, 0=may not)
; Should we make sure XMZ is an original msg and not a reply?
; Should we make sure the msg has recipients?
I DUZ=.6 D ERRSET^XMXUTIL(37422.6,"",XMZ) Q 0 ; May not reply to message as SHARED,MAIL.
I XMDUZ'=DUZ Q:'$$RWPRIV 0 Q:'$$SURRACC(XMDUZ,"",XMZ,.XMZREC) 0 ; "reply to"
I $G(XMZREC)="" S XMZREC=$G(^XMB(3.9,XMZ,0))
I $D(^XMB(3.9,XMZ,"K")),$$PAKMAN^XMXSEC1(XMZ,XMZREC) D ERRSET^XMXUTIL(37422.4,"",XMZ) Q 0 ; May not reply to secure PackMan message.
Q:$$ORIGIN8R(XMDUZ,XMZREC) 1
I $$INFO(XMZREC) D ERRSET^XMXUTIL(37422.1,"",XMZ) Q 0 ; Only originator may reply to 'INFORMATION ONLY' message.
I $P($G(^XMB(3.9,XMZ,1,+$O(^XMB(3.9,XMZ,1,"C",XMDUZ,0)),"T")),U,1)["I" D ERRSET^XMXUTIL(37422.2,"",XMZ) Q 0 ; 'INFORMATION ONLY' recipient may not reply to message.
I $P(XMZREC,U,2)["POSTMASTER@" D ERRSET^XMXUTIL(37422.5,"",XMZ) Q 0 ; You may not reply to a message from a remote Postmaster."
Q 1
SEND(XMDUZ,XMINSTR) ; Send (1=may, 0=may not)
I DUZ=.6!(XMDUZ=.6) D ERRSET^XMXUTIL(37462) Q 0 ; You may not do this in SHARED,MAIL.
Q:XMDUZ=DUZ 1
Q:$D(XMINSTR("FROM")) 1
Q:XMDUZ=.5 1
Q $$WPRIV
RWPRIV() ; Does the surrogate have 'read' or 'send' privilege? (1=yes, 0=no)
Q:$G(XMV("PRIV"))["R"!($G(XMV("PRIV"))["W") 1
D ERRSET^XMXUTIL(37457,XMV("NAME")) ; You do not have 'read' or 'send' privilege for "_XMV("NAME")
Q 0
RPRIV() ; Does the surrogate have 'read' privilege? (1=yes, 0=no)
Q:$G(XMV("PRIV"))["R" 1
D ERRSET^XMXUTIL(37455,XMV("NAME")) ; You do not have 'read' privilege for "_XMV("NAME")
Q 0
WPRIV() ; Does the surrogate have 'send' privilege? (1=yes, 0=no)
Q:$G(XMV("PRIV"))["W" 1
D ERRSET^XMXUTIL(37456,XMV("NAME")) ; You do not have 'send' privilege for "_XMV("NAME")
Q 0
POSTPRIV() ; Perform postmaster actions (1=may, 0=may not)
; This includes permission to perform group message actions in Shared,Mail.
I '$D(^XUSEC("XMMGR",DUZ)),'$D(^XMB(3.7,"AB",DUZ,.5)) D ERRSET^XMXUTIL(37458) Q 0 ; Only a POSTMASTER surrogate or XMMGR key holder may do this.
Q 1
ZPOSTPRV() ; Perform postmaster actions (1=may, 0=may not)
; This includes permission to perform group message actions in Shared,Mail.
Q:$D(^XUSEC("XMMGR",DUZ)) 1
Q:$D(^XMB(3.7,"AB",DUZ,.5)) 1
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMXSEC 9663 printed Apr 09, 2024@21:12:54 Page 2
XMXSEC ;ISC-SF/GMB-Message security and restrictions ;05/17/2002 13:25
+1 ;;8.0;MailMan;;Jun 28, 2002
+2 ; All entry points covered by DBIA 2731.
BCAST(XMZ) ; 0=msg was not broadcast; 1=msg was broadcast
+1 NEW XMBCAST
+2 ; * (Broadcast to all local users)
SET XMBCAST=$$EZBLD^DIALOG(39006)
+3 if $DATA(^XMB(3.9,XMZ,1,"C",$EXTRACT(XMBCAST,1,30)))
QUIT 1
+4 if $DATA(^XMB(3.9,XMZ,1,"C",XMBCAST))
QUIT 1
+5 QUIT 0
ZCLOSED(XMZ) ;
+1 QUIT $$CLOSED($GET(^XMB(3.9,XMZ,0)))
CLOSED(XMZREC) ; 0=msg is not closed; 1=msg is closed
+1 QUIT "^Y^y^"[(U_$PIECE(XMZREC,U,9)_U)
ZCONFID(XMZ) ;
+1 QUIT $$CONFID($GET(^XMB(3.9,XMZ,0)))
CONFID(XMZREC) ; 0=msg is not confidential; 1=msg is confidential
+1 QUIT "^Y^y^"[(U_$PIECE(XMZREC,U,11)_U)
ZCONFIRM(XMZ) ;
+1 QUIT $$CONFIRM($GET(^XMB(3.9,XMZ,0)))
CONFIRM(XMZREC) ; 0=msg is not confirm receipt requested; 1=msg is confirm
+1 QUIT "^Y^y^"[(U_$PIECE(XMZREC,U,5)_U)
ZINFO(XMZ) ;
+1 QUIT $$INFO($GET(^XMB(3.9,XMZ,0)))
INFO(XMZREC) ; 0=msg is not information only; 1=msg is information only
+1 QUIT "^Y^y^"[(U_$PIECE(XMZREC,U,12)_U)
ZORIGIN8(XMDUZ,XMZ) ;
+1 QUIT $$ORIGIN8R(XMDUZ,$GET(^XMB(3.9,XMZ,0)))
ORIGIN8R(XMDUZ,XMZREC) ; Did the user send the message?
+1 ; 1=user is the originator ; 0=user is NOT the originator
+2 if XMDUZ=$PIECE(XMZREC,U,2)
QUIT 1
+3 if XMDUZ=$PIECE(XMZREC,U,4)
QUIT 1
+4 if XMDUZ=DUZ
QUIT 0
+5 if DUZ=$PIECE(XMZREC,U,2)
QUIT 1
+6 if DUZ=$PIECE(XMZREC,U,4)
QUIT 1
+7 QUIT 0
ZPRI(XMZ) ;
+1 QUIT $$PRIORITY($GET(^XMB(3.9,XMZ,0)))
PRIORITY(XMZREC) ; 0=msg is not priority; 1=msg is priority
+1 QUIT $PIECE(XMZREC,U,7)["P"
SURRCONF(XMDUZ,XMZ) ; 0=msg is not confidential; 1=msg is confidential, and surrogate may not read it.
+1 ; We already know that XMDUZ'=DUZ.
+2 ; But the surrogate may read a confidential message if it was the
+3 ; surrogate who sent it.
+4 if "^Y^y^"'[(U_$PIECE($GET(^XMB(3.9,+XMZ,0)),U,11)_U)
QUIT 0
+5 ; naked ref from above
if DUZ=$PIECE(^(0),U,2)
QUIT 0
+6 ; naked ref from above
if DUZ=$PIECE(^(0),U,4)
QUIT 0
+7 QUIT 1
ACCESS(XMDUZ,XMZ,XMZREC) ; Determines user access to a message.
+1 ; 1=user may access; 0=user may not access
+2 ; Message is in user's mailbox
if $DATA(^XMB(3.7,"M",XMZ,XMDUZ))
QUIT $SELECT(XMDUZ=DUZ:1,1:$$SURRACC(XMDUZ,"",XMZ,$GET(XMZREC)))
+3 NEW XMPRE
+4 SET XMPRE=$PIECE(^XMB(3.7,XMDUZ,0),U,7)
+5 IF XMPRE
IF $PIECE($GET(^XMB(3.9,XMZ,.6)),U,1)<XMPRE
Begin DoDot:1
+6 ; You may not access any message prior to _X_ unless someone forwards it to you.
DO ERRSET^XMXUTIL(37100,$$MMDT^XMXUTIL1(XMPRE),XMZ)
End DoDot:1
QUIT 0
+7 ; User is recipient
if $DATA(^XMB(3.9,XMZ,1,"C",XMDUZ))
QUIT $SELECT(XMDUZ=DUZ:1,1:$$SURRACC(XMDUZ,"",XMZ,$GET(XMZREC)))
+8 ;Q:$D(^XMB(3.9,XMZ,1,"C",DUZ)) 1 ; Surrogate is a recipient.
+9 ; We comment out the above line, because it's not enough that the
+10 ; surrogate is a recipient of the message. If the surrogate wants to
+11 ; access the message as XMDUZ, and the message is not in the mailbox
+12 ; of XMDUZ, then the message must have been sent by or to XMDUZ.
+13 if $$BCAST(XMZ)
QUIT 1
+14 IF $GET(XMZREC)=""
SET XMZREC=$GET(^XMB(3.9,XMZ,0))
+15 IF $PIECE(XMZREC,U,8)
Begin DoDot:1
+16 NEW XMPARM
+17 SET XMPARM(1)=XMZ
SET XMPARM(2)=$PIECE(XMZREC,U,8)
+18 ; Message _XMZ_ is a response to message _$P(XMZREC,U,8)_.
DO ERRSET^XMXUTIL(37101,.XMPARM,XMZ)
End DoDot:1
QUIT 0
+19 ; User (XMDUZ) is not a recipient. Investigate further.
+20 QUIT $$ACCESS2^XMXSEC1(XMDUZ,XMZ,XMZREC)
SURRACC(XMDUZ,XMACCESS,XMZ,XMZREC) ; Determines surrogate access to a message.
+1 ; Assumes that we already know that XMDUZ is authorized to see this
+2 ; message, and that XMDUZ'=DUZ. Now we want to know if DUZ may see it.
+3 ; 1=surrogate may access; 0=surrogate may not access
+4 IF $GET(XMZREC)=""
SET XMZREC=$GET(^XMB(3.9,XMZ,0))
+5 ; Message isn't confidential.
if '$$CONFID(XMZREC)
QUIT 1
+6 ; Surrogate sent the message.
if DUZ=$PIECE(XMZREC,U,2)
QUIT 1
+7 ; Surrogate sent the message.
if DUZ=$PIECE(XMZREC,U,4)
QUIT 1
+8 ;Q:$D(^XMB(3.9,XMZ,1,"C",DUZ)) 1 ; Surrogate is a recipient.
+9 ; Surrogates may not _XMACCESS_ CONFIDENTIAL messages.
IF $GET(XMACCESS)'=""
DO ERRSET^XMXUTIL(37452,XMACCESS,XMZ)
QUIT 0
+10 ; Surrogates may not access or do anything to Confidential messages.
DO ERRSET^XMXUTIL(37451,XMZ)
+11 QUIT 0
ANSWER(XMDUZ,XMZ,XMZREC) ; Answer (1=may, 0=may not)
+1 ; You may not do this in SHARED,MAIL.
IF DUZ=.6!(XMDUZ=.6)
DO ERRSET^XMXUTIL(37462,"",XMZ)
QUIT 0
+2 ; "answer"
IF XMDUZ'=DUZ
if '$$WPRIV
QUIT 0
if '$$SURRACC(XMDUZ,"",XMZ,.XMZREC)
QUIT 0
+3 IF $GET(XMZREC)=""
SET XMZREC=$GET(^XMB(3.9,XMZ,0))
+4 ; May not answer a PackMan message.
IF $$PAKMAN^XMXSEC1(XMZ,XMZREC)
DO ERRSET^XMXUTIL(37401.4,"",XMZ)
QUIT 0
+5 ; May not answer a scrambled message. Use Reply.
IF $DATA(^XMB(3.9,XMZ,"K"))
DO ERRSET^XMXUTIL(47401.2,"",XMZ)
QUIT 0
+6 ; You / X must have a network signature in order to answer a message.
IF '$$GOTNS^XMVVITA(XMDUZ)
DO ERRSET^XMXUTIL($SELECT(XMDUZ=DUZ:37401.1,1:37401.3),XMV("NAME"),XMZ)
QUIT 0
+7 QUIT 1
COPY(XMDUZ,XMZ,XMZREC) ; Copy (1=may, 0=may not)
+1 ; "copy"
IF XMDUZ'=DUZ
if '$$WPRIV
QUIT 0
if '$$SURRACC(XMDUZ,"",XMZ,.XMZREC)
QUIT 0
+2 IF $GET(XMZREC)=""
SET XMZREC=$GET(^XMB(3.9,XMZ,0))
+3 ; Only the message originator may copy CLOSED messages.
IF $$CLOSED(XMZREC)
IF '$$ORIGIN8R(XMDUZ,XMZREC)
DO ERRSET^XMXUTIL(37403.1,"",XMZ)
QUIT 0
+4 ; Only the originator may copy messages in SHARED,MAIL.
IF XMDUZ=.6
IF DUZ'=$PIECE(XMZREC,U,2)
IF DUZ'=$PIECE(XMZREC,U,4)
DO ERRSET^XMXUTIL(37403.6,"",XMZ)
QUIT 0
+5 ; May not copy a scrambled message.
IF $DATA(^XMB(3.9,XMZ,"K"))
DO ERRSET^XMXUTIL(37403.2,"",XMZ)
QUIT 0
+6 QUIT 1
INCLUDE(XMDUZ,XMZ,XMZREC) ; Include message XMZ as part of another message (1=may, 0=may not)
+1 ; If XMDUZ'=DUZ, assumes that surrogate has the privilege to
+2 ; send a new message, or reply to a message.
+3 if '$$ACCESS(XMDUZ,XMZ,.XMZREC)
QUIT 0
+4 IF $GET(XMZREC)=""
SET XMZREC=$GET(^XMB(3.9,XMZ,0))
+5 ; Only the message originator may copy CLOSED messages.
IF $$CLOSED(XMZREC)
IF '$$ORIGIN8R(XMDUZ,XMZREC)
DO ERRSET^XMXUTIL(37403.1,"",XMZ)
QUIT 0
+6 ; May not copy a scrambled message.
IF $DATA(^XMB(3.9,XMZ,"K"))
DO ERRSET^XMXUTIL(37403.2,"",XMZ)
QUIT 0
+7 QUIT 1
DELETE(XMDUZ,XMK,XMZ,XMZREC) ; Delete, Terminate (1=may, 0=may not)
+1 if XMDUZ=DUZ
QUIT 1
+2 if '$$RWPRIV
QUIT 0
+3 ;I XMDUZ=.5,$G(XMK,$O(^XMB(3.7,"M",XMZ,XMDUZ,"")))>999 Q 1
+4 IF XMDUZ=.5
QUIT 1
+5 ; "delete"
if '$$SURRACC(XMDUZ,"",XMZ,.XMZREC)
QUIT 0
+6 IF $GET(XMZREC)=""
SET XMZREC=$GET(^XMB(3.9,XMZ,0))
+7 IF XMDUZ=.6
IF DUZ'=$PIECE(XMZREC,U,2)
IF DUZ'=$PIECE(XMZREC,U,4)
IF '$DATA(^XUSEC("XMMGR",DUZ))
IF '$DATA(^XMB(3.7,"AB",DUZ,.5,0))
Begin DoDot:1
+8 ; Only the originator, postmaster surrogate, or XMMGR key holder may do this in SHARED,MAIL.
DO ERRSET^XMXUTIL(37461,"",XMZ)
End DoDot:1
QUIT 0
+9 QUIT 1
FORWARD(XMDUZ,XMZ,XMZREC) ; Forward (1=may, 0=may not)
+1 ; "forward"
IF XMDUZ'=DUZ
if '$$RWPRIV
QUIT 0
if '$$SURRACC(XMDUZ,"",XMZ,.XMZREC)
QUIT 0
+2 IF $GET(XMZREC)=""
SET XMZREC=$GET(^XMB(3.9,XMZ,0))
+3 ; Only the message originator may forward CLOSED messages.
IF $$CLOSED(XMZREC)
IF '$$ORIGIN8R(XMDUZ,XMZREC)
DO ERRSET^XMXUTIL(37406.1,"",XMZ)
QUIT 0
+4 ; Only the originator may forward messages in SHARED,MAIL.
IF XMDUZ=.6
IF DUZ'=$PIECE(XMZREC,U,2)
IF DUZ'=$PIECE(XMZREC,U,4)
DO ERRSET^XMXUTIL(37406.6,"",XMZ)
QUIT 0
+5 QUIT 1
LATER(XMDUZ) ; Later or New Toggle (1=may, 0=may not)
+1 ; SHARED,MAIL may not 'later' or 'new toggle' a message.
IF DUZ=.6!(XMDUZ=.6)
DO ERRSET^XMXUTIL(37462)
QUIT 0
+2 if XMDUZ=DUZ
QUIT 1
+3 QUIT $$RWPRIV
MOVE(XMDUZ,XMZ,XMZREC) ; Save or Filter (1=may, 0=may not)
+1 if XMDUZ=DUZ
QUIT 1
+2 if '$$RWPRIV
QUIT 0
+3 ;Q:'$$SURRACC(XMDUZ,"",XMZ,.XMZREC) 0 ; "save"
+4 IF $GET(XMZREC)=""
SET XMZREC=$GET(^XMB(3.9,XMZ,0))
+5 IF XMDUZ=.6
IF DUZ'=$PIECE(XMZREC,U,2)
IF DUZ'=$PIECE(XMZREC,U,4)
IF '$DATA(^XUSEC("XMMGR",DUZ))
IF '$DATA(^XMB(3.7,"AB",DUZ,.5,0))
Begin DoDot:1
+6 ; Only the originator, postmaster surrogate, or XMMGR key holder may do this in SHARED,MAIL.
DO ERRSET^XMXUTIL(37461,"",XMZ)
End DoDot:1
QUIT 0
+7 QUIT 1
READ(XMDUZ,XMZ,XMZREC) ; Read or Print (1=may, 0=may not)
+1 if XMDUZ=DUZ
QUIT 1
+2 ; "access"
QUIT $$SURRACC(XMDUZ,"",XMZ,.XMZREC)
REPLY(XMDUZ,XMZ,XMZREC) ; Reply (1=may, 0=may not)
+1 ; Should we make sure XMZ is an original msg and not a reply?
+2 ; Should we make sure the msg has recipients?
+3 ; May not reply to message as SHARED,MAIL.
IF DUZ=.6
DO ERRSET^XMXUTIL(37422.6,"",XMZ)
QUIT 0
+4 ; "reply to"
IF XMDUZ'=DUZ
if '$$RWPRIV
QUIT 0
if '$$SURRACC(XMDUZ,"",XMZ,.XMZREC)
QUIT 0
+5 IF $GET(XMZREC)=""
SET XMZREC=$GET(^XMB(3.9,XMZ,0))
+6 ; May not reply to secure PackMan message.
IF $DATA(^XMB(3.9,XMZ,"K"))
IF $$PAKMAN^XMXSEC1(XMZ,XMZREC)
DO ERRSET^XMXUTIL(37422.4,"",XMZ)
QUIT 0
+7 if $$ORIGIN8R(XMDUZ,XMZREC)
QUIT 1
+8 ; Only originator may reply to 'INFORMATION ONLY' message.
IF $$INFO(XMZREC)
DO ERRSET^XMXUTIL(37422.1,"",XMZ)
QUIT 0
+9 ; 'INFORMATION ONLY' recipient may not reply to message.
IF $PIECE($GET(^XMB(3.9,XMZ,1,+$ORDER(^XMB(3.9,XMZ,1,"C",XMDUZ,0)),"T")),U,1)["I"
DO ERRSET^XMXUTIL(37422.2,"",XMZ)
QUIT 0
+10 ; You may not reply to a message from a remote Postmaster."
IF $PIECE(XMZREC,U,2)["POSTMASTER@"
DO ERRSET^XMXUTIL(37422.5,"",XMZ)
QUIT 0
+11 QUIT 1
SEND(XMDUZ,XMINSTR) ; Send (1=may, 0=may not)
+1 ; You may not do this in SHARED,MAIL.
IF DUZ=.6!(XMDUZ=.6)
DO ERRSET^XMXUTIL(37462)
QUIT 0
+2 if XMDUZ=DUZ
QUIT 1
+3 if $DATA(XMINSTR("FROM"))
QUIT 1
+4 if XMDUZ=.5
QUIT 1
+5 QUIT $$WPRIV
RWPRIV() ; Does the surrogate have 'read' or 'send' privilege? (1=yes, 0=no)
+1 if $GET(XMV("PRIV"))["R"!($GET(XMV("PRIV"))["W")
QUIT 1
+2 ; You do not have 'read' or 'send' privilege for "_XMV("NAME")
DO ERRSET^XMXUTIL(37457,XMV("NAME"))
+3 QUIT 0
RPRIV() ; Does the surrogate have 'read' privilege? (1=yes, 0=no)
+1 if $GET(XMV("PRIV"))["R"
QUIT 1
+2 ; You do not have 'read' privilege for "_XMV("NAME")
DO ERRSET^XMXUTIL(37455,XMV("NAME"))
+3 QUIT 0
WPRIV() ; Does the surrogate have 'send' privilege? (1=yes, 0=no)
+1 if $GET(XMV("PRIV"))["W"
QUIT 1
+2 ; You do not have 'send' privilege for "_XMV("NAME")
DO ERRSET^XMXUTIL(37456,XMV("NAME"))
+3 QUIT 0
POSTPRIV() ; Perform postmaster actions (1=may, 0=may not)
+1 ; This includes permission to perform group message actions in Shared,Mail.
+2 ; Only a POSTMASTER surrogate or XMMGR key holder may do this.
IF '$DATA(^XUSEC("XMMGR",DUZ))
IF '$DATA(^XMB(3.7,"AB",DUZ,.5))
DO ERRSET^XMXUTIL(37458)
QUIT 0
+3 QUIT 1
ZPOSTPRV() ; Perform postmaster actions (1=may, 0=may not)
+1 ; This includes permission to perform group message actions in Shared,Mail.
+2 if $DATA(^XUSEC("XMMGR",DUZ))
QUIT 1
+3 if $DATA(^XMB(3.7,"AB",DUZ,.5))
QUIT 1
+4 QUIT 0
