- XMXMSGS ;ISC-SF/GMB-Message APIs ;08/06/2002 06:45
- ;;8.0;MailMan;;Jun 28, 2002
- DELMSG(XMDUZ,XMK,XMKZA,XMMSG) ; Delete msgs in mailbox
- K XMERR,^TMP("XMERR",$J)
- I XMDUZ'=DUZ,'$$RPRIV^XMXSEC Q
- D ACTMSG("XDEL^XMXMSGS2",34302) ;,XMDUZ,XMK,.XMKZA,"",.XMMSG)
- Q
- FLTRMSG(XMDUZ,XMK,XMKZA,XMMSG) ; Filter msgs
- K XMERR,^TMP("XMERR",$J)
- I XMDUZ'=DUZ,'$$RPRIV^XMXSEC Q
- N XMKN,XMKTO,XMKNTO
- I $G(XMK)'=.5,'$G(XMK),'$D(^XMB(3.7,XMDUZ,15,"AF")) D ERRSET^XMXUTIL(37204.1) Q ; You have no message filters defined.
- I $G(XMK) S XMKN=$P(^XMB(3.7,XMDUZ,2,XMK,0),U,1)
- D ACTMSG("XFLTR^XMXMSGS2",34306) ;,XMDUZ,XMK,XMKN,.XMKZA,"",.XMMSG)
- Q
- FWDMSG(XMDUZ,XMK,XMKZA,XMTO,XMINSTR,XMMSG) ; Forward msgs
- ; XMINSTR("SHARE DATE") delete date if SHARED,MAIL is recipient
- ; XMINSTR("SHARE BSKT") basket if SHARED,MAIL is recipient
- K XMERR,^TMP("XMERR",$J)
- I XMDUZ'=DUZ,'$$RPRIV^XMXSEC Q
- N XMRTN
- I $$ONEMSG(.XMKZA) D
- . S XMRTN="XFWDONE^XMXMSGS1" ; just one msg
- E D
- . S XMRTN="XFWD^XMXMSGS1"
- . I $G(XMINSTR("ADDR FLAGS"))'["I" D INIT^XMXADDR
- . D CHKADDR^XMXADDR(XMDUZ,.XMTO,.XMINSTR)
- D ACTMSG(XMRTN,34309) ;,XMDUZ,XMK,.XMKZA,.XMINSTR,.XMMSG)
- D CLEANUP^XMXADDR
- Q
- ONEMSG(XMKZA) ; Function decides if just one message
- N XMONE,XMMSGS
- I $G(XMKZA)]"" D Q XMONE
- . I $O(XMKZA(""))="",+XMKZA=XMKZA S XMONE=1 Q
- . S XMONE=0
- S XMMSGS=$O(XMKZA(""))
- I $O(XMKZA(XMMSGS))'="" Q 0
- I +XMMSGS=XMMSGS Q 1
- Q 0
- LATERMSG(XMDUZ,XMK,XMKZA,XMINSTR,XMMSG) ; Later msgs
- ; XMINSTR("LATER") FM date/time when msg should be made new.
- K XMERR,^TMP("XMERR",$J)
- Q:'$$LATER^XMXSEC(XMDUZ)
- N XMWHEN
- S XMWHEN=$G(XMINSTR("LATER"),$G(XMINSTR))
- D ACTMSG("XLATER^XMXMSGS2",34312) ;,XMDUZ,XMK,.XMKZA,.XMINSTR,.XMMSG)
- Q
- MOVEMSG(XMDUZ,XMK,XMKZA,XMKTO,XMMSG) ; Move msgs to a basket
- K XMERR,^TMP("XMERR",$J)
- I XMDUZ'=DUZ,'$$RPRIV^XMXSEC Q
- Q:$G(XMK)=XMKTO
- D ACTMSG("XMOVE^XMXMSGS2",34324) ;,XMDUZ,XMK,.XMKZA,XMKTO,.XMMSG)
- Q
- NTOGLMSG(XMDUZ,XMK,XMKZA,XMMSG) ; New toggle msgs
- K XMERR,^TMP("XMERR",$J)
- Q:'$$LATER^XMXSEC(XMDUZ)
- N XMKN,XMKTO,XMKNTO
- S:XMK XMKN=$P(^XMB(3.7,XMDUZ,2,XMK,0),U,1)
- D ACTMSG("XNTOGL^XMXMSGS2",34315) ;,XMDUZ,XMK,XMKN,.XMKZA,"",.XMMSG)
- Q
- PRTMSG(XMDUZ,XMK,XMKZA,XMPRTTO,XMINSTR,XMMSG,XMTASK,XMSUBJ,XMTO) ; Print msgs
- K XMERR,^TMP("XMERR",$J),^TMP("XM",$J,"XMZ")
- D ACTMSG("XPRT^XMXMSGS1",34320) ;,XMDUZ,XMK,.XMKZA,.XMINSTR,.XMMSG)
- Q:+XMMSG=0
- I +XMMSG=1 D
- . D PRINT1^XMXPRT(XMDUZ,$O(^TMP("XM",$J,"XMZ","")),XMPRTTO,.XMINSTR,.XMTASK,.XMSUBJ,.XMTO)
- E D
- . D PRINTM^XMXPRT(XMDUZ,XMPRTTO,.XMINSTR,.XMTASK,.XMSUBJ,.XMTO)
- K ^TMP("XM",$J,"XMZ")
- Q:$D(XMTASK)
- S XMMSG=$$EZBLD^DIALOG(34321) ; 0 messages sent to printer. TaskMan Problem.
- D ERRSET^XMXUTIL(34311) ; Task creation not successful.
- Q
- TERMMSG(XMDUZ,XMK,XMKZA,XMMSG) ; Terminate msgs
- K XMERR,^TMP("XMERR",$J)
- I XMDUZ'=DUZ,'$$RPRIV^XMXSEC Q
- D ACTMSG("XTERM^XMXMSGS2",34329) ;,XMDUZ,XMK,.XMKZA,"",.XMMSG)
- Q
- VAPORMSG(XMDUZ,XMK,XMKZA,XMINSTR,XMMSG) ; Set vaporize dates for msgs in mailbox
- K XMERR,^TMP("XMERR",$J)
- I XMDUZ'=DUZ,'$$RPRIV^XMXSEC Q
- N XMWHEN
- S XMWHEN=$G(XMINSTR("VAPOR"),$G(XMINSTR))
- D ACTMSG("XVAPOR^XMXMSGS2",$S(XMWHEN="@":34337.2,1:34337)) ;,XMDUZ,XMK,.XMKZA,XMWHEN,.XMMSG)
- Q
- XPMSG(XMDUZ,XMK,XMKZA,XMINSTR,XMMSG) ; Postmaster transmit priority toggle
- K XMERR,^TMP("XMERR",$J)
- I XMDUZ'=DUZ,'$$RPRIV^XMXSEC Q
- I XMDUZ'=.5!(XMK'>999) D ERRSET^XMXUTIL(37219.5) Q ;Transmission Priority toggle valid only for Postmaster Transmission Queues.
- N XMTPRI
- S XMTPRI=$G(XMINSTR("XMIT PRI"),$G(XMINSTR))
- D ACTMSG("XXP^XMXMSGS1",34334) ;,XMDUZ,XMK,.XMKZA,XMTPRI,.XMMSG)
- Q
- ACTMSG(XMRTN,XMSUM) ;,XMDUZ,XMK,XMKZA,XMKTO,XMMSG)
- ; XMKZA Array of msg numbers DEL("1-3,7,11-15")
- ; XMKZL List of msg numbers 1-3,7,11-15
- ; (It is OK if the list ends with a comma)
- ; XMKZR Range of msg numbers 1-3
- ; XMKZ1 First number in range 1
- ; XMKZN Last number in range 3
- ; XMKZ Message number
- N XMCNT,XMI,XMZ,XMPIECES
- S XMCNT=0
- I $G(XMK) D
- . N XMKZ,XMKZL,XMKZR,XMKZ1,XMKZN
- . ; is this an array or a variable?
- . I $G(XMKZA)]"",$O(XMKZA(""))="" S XMKZA(XMKZA)=""
- . S XMKZL=""
- . F S XMKZL=$O(XMKZA(XMKZL)) Q:XMKZL="" D
- . . S XMPIECES=$L(XMKZL,",")
- . . S:$P(XMKZL,",",XMPIECES)="" XMPIECES=XMPIECES-1
- . . F XMI=1:1:XMPIECES D
- . . . S XMKZR=$P(XMKZL,",",XMI)
- . . . I XMKZR["-" D
- . . . . ; deal with a range of msg #s
- . . . . S XMKZ1=$P(XMKZR,"-",1)
- . . . . S XMKZN=$P(XMKZR,"-",2)
- . . . . I XMKZ1>XMKZN D Q
- . . . . . N XMPARM
- . . . . . S XMPARM(1)=XMKZ1,XMPARM(2)=XMKZN
- . . . . . D ERRSET^XMXUTIL(34350,.XMPARM) ; Range '_XMKZ1_-_XMKZN_' invalid.
- . . . . S XMKZ=XMKZ1-.1
- . . . . F S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ)) Q:'XMKZ!(XMKZ>XMKZN) D
- . . . . . S XMZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ,""))
- . . . . . I 'XMZ D Q
- . . . . . . N XMPARM
- . . . . . . S XMPARM(1)=XMKZ,XMPARM(2)=XMK
- . . . . . . D ERRSET^XMXUTIL(34351,.XMPARM) ; Message _XMKZ_ in basket _XMK_ does not exist.
- . . . . . I '$D(^XMB(3.9,XMZ,0)) D Q
- . . . . . . N XMPARM
- . . . . . . S XMPARM(1)=XMZ,XMPARM(2)=XMKZ,XMPARM(3)=XMK
- . . . . . . D ERRSET^XMXUTIL(34352,.XMPARM) ; Message '_XMZ_' (message _XMKZ_ in basket _XMK_) does not exist.
- . . . . . D @XMRTN ;(XMDUZ,XMK,XMZ)
- . . . E D
- . . . . S XMKZ=XMKZR
- . . . . S XMZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ,""))
- . . . . I 'XMZ D Q
- . . . . . N XMPARM
- . . . . . S XMPARM(1)=XMKZ,XMPARM(2)=XMK
- . . . . . D ERRSET^XMXUTIL(34351,.XMPARM) ; Message _XMKZ_ in basket _XMK_ does not exist.
- . . . . I '$D(^XMB(3.9,XMZ,0)) D Q
- . . . . . N XMPARM
- . . . . . S XMPARM(1)=XMZ,XMPARM(2)=XMKZ,XMPARM(3)=XMK
- . . . . . D ERRSET^XMXUTIL(34352,.XMPARM) ; Message '_XMZ_' (message _XMKZ_ in basket _XMK_) does not exist.
- . . . . D @XMRTN ;(XMDUZ,XMK,XMZ)
- E D
- . N XMZL,XMZREC
- . ; is this an array or a variable?
- . I $G(XMKZA)]"",$O(XMKZA(""))="" S XMKZA(XMKZA)=""
- . S XMZL=""
- . F S XMZL=$O(XMKZA(XMZL)) Q:XMZL="" D
- . . I XMZL["-" D ERRSET^XMXUTIL(34353) Q ; XMZ message ranges are not allowed.
- . . S XMPIECES=$L(XMZL,",")
- . . S:'$P(XMZL,",",XMPIECES) XMPIECES=XMPIECES-1
- . . F XMI=1:1:XMPIECES D
- . . . N XMK
- . . . S XMZ=$P(XMZL,",",XMI)
- . . . I '$D(^XMB(3.9,XMZ,0)) D ERRSET^XMXUTIL(34354,XMZ) Q ; Message '_XMZ_' does not exist."
- . . . S XMZREC=$G(^XMB(3.9,XMZ,0))
- . . . Q:'$$ACCESS^XMXSEC(XMDUZ,XMZ,XMZREC)
- . . . D @XMRTN ;(XMDUZ,XMK,XMZ)
- S XMMSG=$$EZBLD^DIALOG($S(XMCNT=1:XMSUM+.1,1:XMSUM),XMCNT)
- D INCRDECR(XMDUZ,.XMCNT)
- Q
- INCRDECR(XMDUZ,XMCNT) ; Update the "new messages" counts.
- N XMK
- S XMK=0
- F S XMK=$O(XMCNT(XMK)) Q:'XMK D
- . S XMCNT=$G(XMCNT(XMK,"INCR"))-$G(XMCNT(XMK,"DECR"))
- . Q:'XMCNT
- . I XMCNT<0 D DECRNEW^XMXUTIL(XMDUZ,XMK,-XMCNT) Q
- . D INCRNEW^XMXUTIL(XMDUZ,XMK,XMCNT)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMXMSGS 6822 printed Feb 18, 2025@23:40:26 Page 2
- XMXMSGS ;ISC-SF/GMB-Message APIs ;08/06/2002 06:45
- +1 ;;8.0;MailMan;;Jun 28, 2002
- DELMSG(XMDUZ,XMK,XMKZA,XMMSG) ; Delete msgs in mailbox
- +1 KILL XMERR,^TMP("XMERR",$JOB)
- +2 IF XMDUZ'=DUZ
- IF '$$RPRIV^XMXSEC
- QUIT
- +3 ;,XMDUZ,XMK,.XMKZA,"",.XMMSG)
- DO ACTMSG("XDEL^XMXMSGS2",34302)
- +4 QUIT
- FLTRMSG(XMDUZ,XMK,XMKZA,XMMSG) ; Filter msgs
- +1 KILL XMERR,^TMP("XMERR",$JOB)
- +2 IF XMDUZ'=DUZ
- IF '$$RPRIV^XMXSEC
- QUIT
- +3 NEW XMKN,XMKTO,XMKNTO
- +4 ; You have no message filters defined.
- IF $GET(XMK)'=.5
- IF '$GET(XMK)
- IF '$DATA(^XMB(3.7,XMDUZ,15,"AF"))
- DO ERRSET^XMXUTIL(37204.1)
- QUIT
- +5 IF $GET(XMK)
- SET XMKN=$PIECE(^XMB(3.7,XMDUZ,2,XMK,0),U,1)
- +6 ;,XMDUZ,XMK,XMKN,.XMKZA,"",.XMMSG)
- DO ACTMSG("XFLTR^XMXMSGS2",34306)
- +7 QUIT
- FWDMSG(XMDUZ,XMK,XMKZA,XMTO,XMINSTR,XMMSG) ; Forward msgs
- +1 ; XMINSTR("SHARE DATE") delete date if SHARED,MAIL is recipient
- +2 ; XMINSTR("SHARE BSKT") basket if SHARED,MAIL is recipient
- +3 KILL XMERR,^TMP("XMERR",$JOB)
- +4 IF XMDUZ'=DUZ
- IF '$$RPRIV^XMXSEC
- QUIT
- +5 NEW XMRTN
- +6 IF $$ONEMSG(.XMKZA)
- Begin DoDot:1
- +7 ; just one msg
- SET XMRTN="XFWDONE^XMXMSGS1"
- End DoDot:1
- +8 IF '$TEST
- Begin DoDot:1
- +9 SET XMRTN="XFWD^XMXMSGS1"
- +10 IF $GET(XMINSTR("ADDR FLAGS"))'["I"
- DO INIT^XMXADDR
- +11 DO CHKADDR^XMXADDR(XMDUZ,.XMTO,.XMINSTR)
- End DoDot:1
- +12 ;,XMDUZ,XMK,.XMKZA,.XMINSTR,.XMMSG)
- DO ACTMSG(XMRTN,34309)
- +13 DO CLEANUP^XMXADDR
- +14 QUIT
- ONEMSG(XMKZA) ; Function decides if just one message
- +1 NEW XMONE,XMMSGS
- +2 IF $GET(XMKZA)]""
- Begin DoDot:1
- +3 IF $ORDER(XMKZA(""))=""
- IF +XMKZA=XMKZA
- SET XMONE=1
- QUIT
- +4 SET XMONE=0
- End DoDot:1
- QUIT XMONE
- +5 SET XMMSGS=$ORDER(XMKZA(""))
- +6 IF $ORDER(XMKZA(XMMSGS))'=""
- QUIT 0
- +7 IF +XMMSGS=XMMSGS
- QUIT 1
- +8 QUIT 0
- LATERMSG(XMDUZ,XMK,XMKZA,XMINSTR,XMMSG) ; Later msgs
- +1 ; XMINSTR("LATER") FM date/time when msg should be made new.
- +2 KILL XMERR,^TMP("XMERR",$JOB)
- +3 if '$$LATER^XMXSEC(XMDUZ)
- QUIT
- +4 NEW XMWHEN
- +5 SET XMWHEN=$GET(XMINSTR("LATER"),$GET(XMINSTR))
- +6 ;,XMDUZ,XMK,.XMKZA,.XMINSTR,.XMMSG)
- DO ACTMSG("XLATER^XMXMSGS2",34312)
- +7 QUIT
- MOVEMSG(XMDUZ,XMK,XMKZA,XMKTO,XMMSG) ; Move msgs to a basket
- +1 KILL XMERR,^TMP("XMERR",$JOB)
- +2 IF XMDUZ'=DUZ
- IF '$$RPRIV^XMXSEC
- QUIT
- +3 if $GET(XMK)=XMKTO
- QUIT
- +4 ;,XMDUZ,XMK,.XMKZA,XMKTO,.XMMSG)
- DO ACTMSG("XMOVE^XMXMSGS2",34324)
- +5 QUIT
- NTOGLMSG(XMDUZ,XMK,XMKZA,XMMSG) ; New toggle msgs
- +1 KILL XMERR,^TMP("XMERR",$JOB)
- +2 if '$$LATER^XMXSEC(XMDUZ)
- QUIT
- +3 NEW XMKN,XMKTO,XMKNTO
- +4 if XMK
- SET XMKN=$PIECE(^XMB(3.7,XMDUZ,2,XMK,0),U,1)
- +5 ;,XMDUZ,XMK,XMKN,.XMKZA,"",.XMMSG)
- DO ACTMSG("XNTOGL^XMXMSGS2",34315)
- +6 QUIT
- PRTMSG(XMDUZ,XMK,XMKZA,XMPRTTO,XMINSTR,XMMSG,XMTASK,XMSUBJ,XMTO) ; Print msgs
- +1 KILL XMERR,^TMP("XMERR",$JOB),^TMP("XM",$JOB,"XMZ")
- +2 ;,XMDUZ,XMK,.XMKZA,.XMINSTR,.XMMSG)
- DO ACTMSG("XPRT^XMXMSGS1",34320)
- +3 if +XMMSG=0
- QUIT
- +4 IF +XMMSG=1
- Begin DoDot:1
- +5 DO PRINT1^XMXPRT(XMDUZ,$ORDER(^TMP("XM",$JOB,"XMZ","")),XMPRTTO,.XMINSTR,.XMTASK,.XMSUBJ,.XMTO)
- End DoDot:1
- +6 IF '$TEST
- Begin DoDot:1
- +7 DO PRINTM^XMXPRT(XMDUZ,XMPRTTO,.XMINSTR,.XMTASK,.XMSUBJ,.XMTO)
- End DoDot:1
- +8 KILL ^TMP("XM",$JOB,"XMZ")
- +9 if $DATA(XMTASK)
- QUIT
- +10 ; 0 messages sent to printer. TaskMan Problem.
- SET XMMSG=$$EZBLD^DIALOG(34321)
- +11 ; Task creation not successful.
- DO ERRSET^XMXUTIL(34311)
- +12 QUIT
- TERMMSG(XMDUZ,XMK,XMKZA,XMMSG) ; Terminate msgs
- +1 KILL XMERR,^TMP("XMERR",$JOB)
- +2 IF XMDUZ'=DUZ
- IF '$$RPRIV^XMXSEC
- QUIT
- +3 ;,XMDUZ,XMK,.XMKZA,"",.XMMSG)
- DO ACTMSG("XTERM^XMXMSGS2",34329)
- +4 QUIT
- VAPORMSG(XMDUZ,XMK,XMKZA,XMINSTR,XMMSG) ; Set vaporize dates for msgs in mailbox
- +1 KILL XMERR,^TMP("XMERR",$JOB)
- +2 IF XMDUZ'=DUZ
- IF '$$RPRIV^XMXSEC
- QUIT
- +3 NEW XMWHEN
- +4 SET XMWHEN=$GET(XMINSTR("VAPOR"),$GET(XMINSTR))
- +5 ;,XMDUZ,XMK,.XMKZA,XMWHEN,.XMMSG)
- DO ACTMSG("XVAPOR^XMXMSGS2",$SELECT(XMWHEN="@":34337.2,1:34337))
- +6 QUIT
- XPMSG(XMDUZ,XMK,XMKZA,XMINSTR,XMMSG) ; Postmaster transmit priority toggle
- +1 KILL XMERR,^TMP("XMERR",$JOB)
- +2 IF XMDUZ'=DUZ
- IF '$$RPRIV^XMXSEC
- QUIT
- +3 ;Transmission Priority toggle valid only for Postmaster Transmission Queues.
- IF XMDUZ'=.5!(XMK'>999)
- DO ERRSET^XMXUTIL(37219.5)
- QUIT
- +4 NEW XMTPRI
- +5 SET XMTPRI=$GET(XMINSTR("XMIT PRI"),$GET(XMINSTR))
- +6 ;,XMDUZ,XMK,.XMKZA,XMTPRI,.XMMSG)
- DO ACTMSG("XXP^XMXMSGS1",34334)
- +7 QUIT
- ACTMSG(XMRTN,XMSUM) ;,XMDUZ,XMK,XMKZA,XMKTO,XMMSG)
- +1 ; XMKZA Array of msg numbers DEL("1-3,7,11-15")
- +2 ; XMKZL List of msg numbers 1-3,7,11-15
- +3 ; (It is OK if the list ends with a comma)
- +4 ; XMKZR Range of msg numbers 1-3
- +5 ; XMKZ1 First number in range 1
- +6 ; XMKZN Last number in range 3
- +7 ; XMKZ Message number
- +8 NEW XMCNT,XMI,XMZ,XMPIECES
- +9 SET XMCNT=0
- +10 IF $GET(XMK)
- Begin DoDot:1
- +11 NEW XMKZ,XMKZL,XMKZR,XMKZ1,XMKZN
- +12 ; is this an array or a variable?
- +13 IF $GET(XMKZA)]""
- IF $ORDER(XMKZA(""))=""
- SET XMKZA(XMKZA)=""
- +14 SET XMKZL=""
- +15 FOR
- SET XMKZL=$ORDER(XMKZA(XMKZL))
- if XMKZL=""
- QUIT
- Begin DoDot:2
- +16 SET XMPIECES=$LENGTH(XMKZL,",")
- +17 if $PIECE(XMKZL,",",XMPIECES)=""
- SET XMPIECES=XMPIECES-1
- +18 FOR XMI=1:1:XMPIECES
- Begin DoDot:3
- +19 SET XMKZR=$PIECE(XMKZL,",",XMI)
- +20 IF XMKZR["-"
- Begin DoDot:4
- +21 ; deal with a range of msg #s
- +22 SET XMKZ1=$PIECE(XMKZR,"-",1)
- +23 SET XMKZN=$PIECE(XMKZR,"-",2)
- +24 IF XMKZ1>XMKZN
- Begin DoDot:5
- +25 NEW XMPARM
- +26 SET XMPARM(1)=XMKZ1
- SET XMPARM(2)=XMKZN
- +27 ; Range '_XMKZ1_-_XMKZN_' invalid.
- DO ERRSET^XMXUTIL(34350,.XMPARM)
- End DoDot:5
- QUIT
- +28 SET XMKZ=XMKZ1-.1
- +29 FOR
- SET XMKZ=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ))
- if 'XMKZ!(XMKZ>XMKZN)
- QUIT
- Begin DoDot:5
- +30 SET XMZ=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ,""))
- +31 IF 'XMZ
- Begin DoDot:6
- +32 NEW XMPARM
- +33 SET XMPARM(1)=XMKZ
- SET XMPARM(2)=XMK
- +34 ; Message _XMKZ_ in basket _XMK_ does not exist.
- DO ERRSET^XMXUTIL(34351,.XMPARM)
- End DoDot:6
- QUIT
- +35 IF '$DATA(^XMB(3.9,XMZ,0))
- Begin DoDot:6
- +36 NEW XMPARM
- +37 SET XMPARM(1)=XMZ
- SET XMPARM(2)=XMKZ
- SET XMPARM(3)=XMK
- +38 ; Message '_XMZ_' (message _XMKZ_ in basket _XMK_) does not exist.
- DO ERRSET^XMXUTIL(34352,.XMPARM)
- End DoDot:6
- QUIT
- +39 ;(XMDUZ,XMK,XMZ)
- DO @XMRTN
- End DoDot:5
- End DoDot:4
- +40 IF '$TEST
- Begin DoDot:4
- +41 SET XMKZ=XMKZR
- +42 SET XMZ=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ,""))
- +43 IF 'XMZ
- Begin DoDot:5
- +44 NEW XMPARM
- +45 SET XMPARM(1)=XMKZ
- SET XMPARM(2)=XMK
- +46 ; Message _XMKZ_ in basket _XMK_ does not exist.
- DO ERRSET^XMXUTIL(34351,.XMPARM)
- End DoDot:5
- QUIT
- +47 IF '$DATA(^XMB(3.9,XMZ,0))
- Begin DoDot:5
- +48 NEW XMPARM
- +49 SET XMPARM(1)=XMZ
- SET XMPARM(2)=XMKZ
- SET XMPARM(3)=XMK
- +50 ; Message '_XMZ_' (message _XMKZ_ in basket _XMK_) does not exist.
- DO ERRSET^XMXUTIL(34352,.XMPARM)
- End DoDot:5
- QUIT
- +51 ;(XMDUZ,XMK,XMZ)
- DO @XMRTN
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +52 IF '$TEST
- Begin DoDot:1
- +53 NEW XMZL,XMZREC
- +54 ; is this an array or a variable?
- +55 IF $GET(XMKZA)]""
- IF $ORDER(XMKZA(""))=""
- SET XMKZA(XMKZA)=""
- +56 SET XMZL=""
- +57 FOR
- SET XMZL=$ORDER(XMKZA(XMZL))
- if XMZL=""
- QUIT
- Begin DoDot:2
- +58 ; XMZ message ranges are not allowed.
- IF XMZL["-"
- DO ERRSET^XMXUTIL(34353)
- QUIT
- +59 SET XMPIECES=$LENGTH(XMZL,",")
- +60 if '$PIECE(XMZL,",",XMPIECES)
- SET XMPIECES=XMPIECES-1
- +61 FOR XMI=1:1:XMPIECES
- Begin DoDot:3
- +62 NEW XMK
- +63 SET XMZ=$PIECE(XMZL,",",XMI)
- +64 ; Message '_XMZ_' does not exist."
- IF '$DATA(^XMB(3.9,XMZ,0))
- DO ERRSET^XMXUTIL(34354,XMZ)
- QUIT
- +65 SET XMZREC=$GET(^XMB(3.9,XMZ,0))
- +66 if '$$ACCESS^XMXSEC(XMDUZ,XMZ,XMZREC)
- QUIT
- +67 ;(XMDUZ,XMK,XMZ)
- DO @XMRTN
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +68 SET XMMSG=$$EZBLD^DIALOG($SELECT(XMCNT=1:XMSUM+.1,1:XMSUM),XMCNT)
- +69 DO INCRDECR(XMDUZ,.XMCNT)
- +70 QUIT
- INCRDECR(XMDUZ,XMCNT) ; Update the "new messages" counts.
- +1 NEW XMK
- +2 SET XMK=0
- +3 FOR
- SET XMK=$ORDER(XMCNT(XMK))
- if 'XMK
- QUIT
- Begin DoDot:1
- +4 SET XMCNT=$GET(XMCNT(XMK,"INCR"))-$GET(XMCNT(XMK,"DECR"))
- +5 if 'XMCNT
- QUIT
- +6 IF XMCNT<0
- DO DECRNEW^XMXUTIL(XMDUZ,XMK,-XMCNT)
- QUIT
- +7 DO INCRNEW^XMXUTIL(XMDUZ,XMK,XMCNT)
- End DoDot:1
- +8 QUIT