XMJMQ ;ISC-SF/GMB-Q,QD,QN Query recipients ;12/04/2002 11:21
;;8.0;MailMan;**10**;Jun 28, 2002
; Replaces ^XMA5,^XMA5A (ISC-WASH/THM/CAP)
Q(XMDUZ,XMK,XMKN,XMZ) ; Query
N XMRESPM,XMABORT
D QINIT^XMJMQ1(XMDUZ,XMK,XMKN,XMZ,.XMRESPM,.XMABORT)
D SUMMARY^XMJMQ1(XMZ,0,"","","",.XMABORT)
Q
QD(XMDUZ,XMK,XMKN,XMZ) ; Query Detail
N XMRESPM,XMABORT
D QINIT^XMJMQ1(XMDUZ,XMK,XMKN,XMZ,.XMRESPM,.XMABORT)
D DETAIL(XMZ,0,"","","",.XMABORT)
Q
QN(XMDUZ,XMK,XMKN,XMZ) ; Query Network
N XMRESPM,XMABORT
D QINIT^XMJMQ1(XMDUZ,XMK,XMKN,XMZ,.XMRESPM,.XMABORT)
D NETWORK^XMJMQ1(XMZ,.XMABORT) Q:XMABORT
D DETAIL(XMZ,0,"","","",.XMABORT)
Q
QX(XMDUZ,XMK,XMKN,XMZ,XMWHAT) ; Query Special
; XMWHAT = "QC" - show local users who are current
; "QNC" - show local users who are not current
; "QT" - show local users who have terminated
N XMRESPM,XMABORT,XMTO,XMIEN,XMTYPE,XMRESPS,XMCNT,XMTOTAL,XMPHDR
D QINIT^XMJMQ1(XMDUZ,XMK,XMKN,XMZ,.XMRESPM,.XMABORT)
I $Y+3>IOSL D PAGE(.XMABORT) Q:XMABORT
S XMRESPS=+$P($G(^XMB(3.9,XMZ,3,0)),U,4)
W !
S (XMPHDR,XMCNT,XMTOTAL,XMTO)=0
F S XMTO=$O(^XMB(3.9,XMZ,1,"C",XMTO)) Q:+XMTO'=XMTO D Q:XMABORT
. S XMTOTAL=XMTOTAL+1
. S XMIEN=$O(^XMB(3.9,XMZ,1,"C",XMTO,""))
. I XMWHAT="QC",$P(^XMB(3.9,XMZ,1,XMIEN,0),U,2)'=XMRESPS Q ; not current
. I XMWHAT="QNC",$P(^XMB(3.9,XMZ,1,XMIEN,0),U,2)=XMRESPS Q ; current
. I XMWHAT="QT",'$G(^XMB(3.9,XMZ,1,XMIEN,"D")) Q ; not terminated
. S XMCNT=XMCNT+1
. D WNAME(XMZ,$$NAME^XMXUTIL(XMTO),XMIEN,XMRESPM,.XMTYPE,.XMABORT)
Q:XMABORT
I $Y+3+(XMCNT>0)>IOSL D PAGE(.XMABORT) Q:XMABORT
N XMTEXT,XMPARM
I XMCNT W !
S XMPARM(1)=XMCNT,XMPARM(2)=XMTOTAL
D BLD^DIALOG($S(XMWHAT="QC":37431.9,XMWHAT="QNC":37432.9,1:37433.9),.XMPARM,"","XMTEXT","F")
D MSG^DIALOG("WM","",IOM,"","XMTEXT")
; Local recipients who are (not) current: |1| of |2|
; Local recipients who have terminated: |1| of |2|
Q
QNAME(XMDUZ,XMK,XMKN,XMZ) ; Query someone's name
N XMRESPM,XMABORT,DIR,Y,DIRUT,XMNAME
F D Q:$D(DIRUT)
. S DIR(0)="FO^1:30^K:"", ""[$E(X) X"
. S DIR("A")=$$EZBLD^DIALOG(34555) ; Enter the person's name or partial name
. D BLD^DIALOG(34556,"","","DIR(""?"")")
. ;Name must be from 1 to 30 characters,
. ;and must not contain ^, or begin with comma or space.
. D ^DIR Q:$D(DIRUT)
. S XMNAME=Y
. D QINIT^XMJMQ1(XMDUZ,XMK,XMKN,XMZ,.XMRESPM,.XMABORT)
. D SEARCH^XMJMQ1(XMZ,XMNAME,XMRESPM)
Q
QNAMEX(XMDUZ,XMK,XMKN,XMZ,XMNAME) ; Query someone's name (name is supplied)
N XMRESPM,XMABORT
I ($L(XMNAME)<1)!($L(XMNAME)>30)!(XMNAME[U)!(", "[$E(XMNAME,1)) D Q
. N XMTEXT
. W $C(7)
. D BLD^DIALOG(34556,"","","XMTEXT","F")
. D MSG^DIALOG("WH","","","","XMTEXT")
. ;Name must be from 1 to 30 characters,
. ;and must not contain ^, or begin with comma or space.
D QINIT^XMJMQ1(XMDUZ,XMK,XMKN,XMZ,.XMRESPM,.XMABORT)
D SEARCH^XMJMQ1(XMZ,XMNAME,XMRESPM)
Q
DETAIL(XMZ,XMPHDR,XMSUBJ,XMZSTR,XMPAGE,XMABORT) ;
; XMRESPM Last part msg: of Number of responses in msg
N XMTO,XMRESPM,XMNAME,XMIEN,XMTYPE
I $Y+3>IOSL D PAGE(.XMABORT) Q:XMABORT
W !
S XMRESPM=+$P($G(^XMB(3.9,XMZ,3,0)),U,4)
S XMRESPM=$$EZBLD^DIALOG($S(XMRESPM=1:34557.1,1:34557),XMRESPM) ; XMRESPM_ response / responses
S XMTO="*" ; Show broadcast first.
F S XMTO=$O(^XMB(3.9,XMZ,1,"C",XMTO)) Q:$E(XMTO,1,1)'="*" D Q:XMABORT
. S XMIEN=$O(^XMB(3.9,XMZ,1,"C",XMTO,""))
. S XMNAME=$P(^XMB(3.9,XMZ,1,XMIEN,0),U,1)
. D WNAME(XMZ,XMNAME,XMIEN,XMRESPM,.XMTYPE,.XMABORT)
Q:XMABORT
S XMTO=""
F S XMTO=$O(^XMB(3.9,XMZ,1,"C",XMTO)) Q:XMTO="" D Q:XMABORT
. S XMIEN=$O(^XMB(3.9,XMZ,1,"C",XMTO,""))
. I XMTO=+XMTO D
. . S XMNAME=$$NAME^XMXUTIL(XMTO)
. E D Q:$E(XMTO,1,1)="*"
. . I $L(XMTO)>29 S XMNAME=$P(^XMB(3.9,XMZ,1,XMIEN,0),U,1) Q
. . S XMNAME=XMTO
. D WNAME(XMZ,XMNAME,XMIEN,XMRESPM,.XMTYPE,.XMABORT)
Q
WNAME(XMZ,XMNAME,XMIEN,XMRESPM,XMTYPE,XMABORT) ;
N XMREC
S XMREC=^XMB(3.9,XMZ,1,XMIEN,0)
I $Y+3>IOSL D PAGE(.XMABORT) Q:XMABORT
W !
I $D(^XMB(3.9,XMZ,1,XMIEN,"T")) D ; CC: Info: Thru:
. S XMTYPE=$P(^XMB(3.9,XMZ,1,XMIEN,"T"),U,1)
. Q:XMTYPE=""
. S:'$D(XMTYPE(XMTYPE)) XMTYPE(XMTYPE)=$$EXTERNAL^DILFD(3.91,6.5,"",XMTYPE)
. W XMTYPE(XMTYPE),": "
W XMNAME
W:$X<18 ?18
I +$P(XMREC,U,1)=$P(XMREC,U,1) D Q ; local user
. I $P(XMREC,U,3)="" D
. . W $$EZBLD^DIALOG(34574) ; " Not read."
. E D Q:XMABORT
. . D W3(34575,$$MMDT^XMXUTIL1($P(XMREC,U,3)),.XMABORT) Q:XMABORT ; Last read:
. . I $P(XMREC,U,2) D Q:XMABORT
. . . N XMPARM
. . . S XMPARM(1)=$P(XMREC,U,2),XMPARM(2)=XMRESPM
. . . D W3(34576,.XMPARM,.XMABORT) ; (x of y responses)
. . I $P(XMREC,U,10)'="" D W3(34577,$$MMDT^XMXUTIL1($P(XMREC,U,10)),.XMABORT) Q:XMABORT ; [First read: x]
. . I $D(^XMB(3.9,XMZ,1,XMIEN,"C")) D W3(34578,$$MMDT^XMXUTIL1(^("C")),.XMABORT) Q:XMABORT ; Copied:
. . I $D(^XMB(3.9,XMZ,1,XMIEN,"S")) D W3(34580,^("S"),.XMABORT) Q:XMABORT ; Surrogate:
. . I $D(^XMB(3.9,XMZ,1,XMIEN,"D")),^("D") D W3(34581,$$MMDT^XMXUTIL1(^("D")),.XMABORT) Q:XMABORT ; Terminated:
. I $D(^XMB(3.9,XMZ,1,XMIEN,"F")) D FWD(XMZ,XMIEN,.XMABORT) Q:XMABORT
I $E(XMNAME,1,2)="F.",$P(XMREC,U,12)'=""!$P(XMREC,U,11) D Q
. I $P(XMREC,U,5)'="" D W3(34582,$$MMDT^XMXUTIL1($P(XMREC,U,5)),.XMABORT) Q:XMABORT ; Sent to fax:
. I $P(XMREC,U,6)'="" D W3(34583,$P(XMREC,U,6),.XMABORT) Q:XMABORT ; Status:
. I $P(XMREC,U,12)'="" D W3(34584,$P(XMREC,U,12),.XMABORT) Q:XMABORT ; Fax ID:
. I $D(^XMB(3.9,XMZ,1,XMIEN,"F")) D FWD(XMZ,XMIEN,.XMABORT) Q:XMABORT
I XMNAME["@" D Q
. I $P(XMREC,U,5)'="" D W3(34585,$$MMDT^XMXUTIL1($P(XMREC,U,5)),.XMABORT) Q:XMABORT ; Sent:
. I $P(XMREC,U,8)'="" D W3($S($P(XMREC,U,8)=1:34586,1:34587),$P(XMREC,U,8),.XMABORT) Q:XMABORT ; Time: x seconds
. I $P(XMREC,U,7)'="",$D(^DIC(4.2,$P(XMREC,U,7),0)) D W3(34588,$P(^(0),U),.XMABORT) Q:XMABORT ; Path:
. I $P(XMREC,U,4)'="" D W3(34590,$P(XMREC,U,4),.XMABORT) Q:XMABORT ; Message ID:
. I $P(XMREC,U,6)'="" D W3(34583,$P(XMREC,U,6),.XMABORT) Q:XMABORT ; Status:
. I $D(^XMB(3.9,XMZ,1,XMIEN,"F")) D FWD(XMZ,XMIEN,.XMABORT) Q:XMABORT
I $E(XMNAME,1,3)="* (" D Q ; Broadcast
. I $D(^XMB(3.9,XMZ,1,XMIEN,"F")) D FWD(XMZ,XMIEN,.XMABORT)
I ".D.H.S."[("."_$E(XMNAME,1,2)) D Q
. I $P(XMREC,U,3)'="" D W3(34591,$$MMDT^XMXUTIL1($P(XMREC,U,3)),.XMABORT) Q:XMABORT ; Date:
. I $P(XMREC,U,6)'="" D W3(34583,$P(XMREC,U,6),.XMABORT) Q:XMABORT ; Status:
. I $D(^XMB(3.9,XMZ,1,XMIEN,"F")) D FWD(XMZ,XMIEN,.XMABORT) Q:XMABORT
Q
FWD(XMZ,XMIEN,XMABORT) ;
N XMFWDREC,XMFWDBY,XMFWDTYP
S XMFWDREC=^XMB(3.9,XMZ,1,XMIEN,"F")
S XMFWDBY=$P(XMFWDREC,U)
I $E(XMFWDBY,1)=" " D W3(34592,XMFWDBY,.XMABORT) Q ; Forwarded on:
I $E(XMFWDBY,1)?1N!($E(XMFWDBY,1)=".") D W3(34593,$$NAME^XMXUTIL(+XMFWDBY)_" "_$P(XMFWDBY," ",2,99),.XMABORT) Q ; Forwarded by:
S XMFWDTYP=$P(XMFWDREC,U,3)
D W3($S(XMFWDTYP="A":34593.1,XMFWDTYP="F":34593.2,1:34593),XMFWDBY,.XMABORT) ; Auto-Forwarded / Filter-Forwarded / Forwarded by:
Q:$P(XMFWDREC,U,4)=""
N XMPARM
S XMPARM(1)=$$NAME^XMXUTIL($P(XMFWDREC,U,2))
S XMPARM(2)=$P(XMFWDREC,U,4)
S XMFWDTYP=$P(XMFWDREC,U,5)
; Filter-Forwarded / Forwarded to |1| by: |2|
D W3($S(XMFWDTYP="F":34594.1,1:34594),.XMPARM,.XMABORT)
Q
W3(XMPIECE,XMPARM,XMABORT) ;
S XMPIECE=$$EZBLD^DIALOG(XMPIECE,.XMPARM)
I 1+$L(XMPIECE)+$X>IOM D Q:XMABORT
. I $Y+3+($L(XMPIECE)-1\60)>IOSL D PAGE(.XMABORT) Q:XMABORT
. W !,?18
. Q:$L(XMPIECE)<61
. F D Q:$L(XMPIECE)<61
. . W " ",$E(XMPIECE,1,60),!,?18
. . S XMPIECE=$E(XMPIECE,61,999)
W " ",XMPIECE
Q
;PAGE(XMPHDR,XMSUBJ,XMZSTR,XMPAGE,XMABORT);
PAGE(XMABORT) ;
I $E($G(IOST),1,2)="C-" D PAGE^XMXUTIL(.XMABORT) Q:XMABORT
W @IOF
Q:'XMPHDR
D PAGE2HDR^XMJMP1(XMSUBJ,XMZSTR,.XMPAGE)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMJMQ 7757 printed Sep 23, 2025@19:48:14 Page 2
XMJMQ ;ISC-SF/GMB-Q,QD,QN Query recipients ;12/04/2002 11:21
+1 ;;8.0;MailMan;**10**;Jun 28, 2002
+2 ; Replaces ^XMA5,^XMA5A (ISC-WASH/THM/CAP)
Q(XMDUZ,XMK,XMKN,XMZ) ; Query
+1 NEW XMRESPM,XMABORT
+2 DO QINIT^XMJMQ1(XMDUZ,XMK,XMKN,XMZ,.XMRESPM,.XMABORT)
+3 DO SUMMARY^XMJMQ1(XMZ,0,"","","",.XMABORT)
+4 QUIT
QD(XMDUZ,XMK,XMKN,XMZ) ; Query Detail
+1 NEW XMRESPM,XMABORT
+2 DO QINIT^XMJMQ1(XMDUZ,XMK,XMKN,XMZ,.XMRESPM,.XMABORT)
+3 DO DETAIL(XMZ,0,"","","",.XMABORT)
+4 QUIT
QN(XMDUZ,XMK,XMKN,XMZ) ; Query Network
+1 NEW XMRESPM,XMABORT
+2 DO QINIT^XMJMQ1(XMDUZ,XMK,XMKN,XMZ,.XMRESPM,.XMABORT)
+3 DO NETWORK^XMJMQ1(XMZ,.XMABORT)
if XMABORT
QUIT
+4 DO DETAIL(XMZ,0,"","","",.XMABORT)
+5 QUIT
QX(XMDUZ,XMK,XMKN,XMZ,XMWHAT) ; Query Special
+1 ; XMWHAT = "QC" - show local users who are current
+2 ; "QNC" - show local users who are not current
+3 ; "QT" - show local users who have terminated
+4 NEW XMRESPM,XMABORT,XMTO,XMIEN,XMTYPE,XMRESPS,XMCNT,XMTOTAL,XMPHDR
+5 DO QINIT^XMJMQ1(XMDUZ,XMK,XMKN,XMZ,.XMRESPM,.XMABORT)
+6 IF $Y+3>IOSL
DO PAGE(.XMABORT)
if XMABORT
QUIT
+7 SET XMRESPS=+$PIECE($GET(^XMB(3.9,XMZ,3,0)),U,4)
+8 WRITE !
+9 SET (XMPHDR,XMCNT,XMTOTAL,XMTO)=0
+10 FOR
SET XMTO=$ORDER(^XMB(3.9,XMZ,1,"C",XMTO))
if +XMTO'=XMTO
QUIT
Begin DoDot:1
+11 SET XMTOTAL=XMTOTAL+1
+12 SET XMIEN=$ORDER(^XMB(3.9,XMZ,1,"C",XMTO,""))
+13 ; not current
IF XMWHAT="QC"
IF $PIECE(^XMB(3.9,XMZ,1,XMIEN,0),U,2)'=XMRESPS
QUIT
+14 ; current
IF XMWHAT="QNC"
IF $PIECE(^XMB(3.9,XMZ,1,XMIEN,0),U,2)=XMRESPS
QUIT
+15 ; not terminated
IF XMWHAT="QT"
IF '$GET(^XMB(3.9,XMZ,1,XMIEN,"D"))
QUIT
+16 SET XMCNT=XMCNT+1
+17 DO WNAME(XMZ,$$NAME^XMXUTIL(XMTO),XMIEN,XMRESPM,.XMTYPE,.XMABORT)
End DoDot:1
if XMABORT
QUIT
+18 if XMABORT
QUIT
+19 IF $Y+3+(XMCNT>0)>IOSL
DO PAGE(.XMABORT)
if XMABORT
QUIT
+20 NEW XMTEXT,XMPARM
+21 IF XMCNT
WRITE !
+22 SET XMPARM(1)=XMCNT
SET XMPARM(2)=XMTOTAL
+23 DO BLD^DIALOG($SELECT(XMWHAT="QC":37431.9,XMWHAT="QNC":37432.9,1:37433.9),.XMPARM,"","XMTEXT","F")
+24 DO MSG^DIALOG("WM","",IOM,"","XMTEXT")
+25 ; Local recipients who are (not) current: |1| of |2|
+26 ; Local recipients who have terminated: |1| of |2|
+27 QUIT
QNAME(XMDUZ,XMK,XMKN,XMZ) ; Query someone's name
+1 NEW XMRESPM,XMABORT,DIR,Y,DIRUT,XMNAME
+2 FOR
Begin DoDot:1
+3 SET DIR(0)="FO^1:30^K:"", ""[$E(X) X"
+4 ; Enter the person's name or partial name
SET DIR("A")=$$EZBLD^DIALOG(34555)
+5 DO BLD^DIALOG(34556,"","","DIR(""?"")")
+6 ;Name must be from 1 to 30 characters,
+7 ;and must not contain ^, or begin with comma or space.
+8 DO ^DIR
if $DATA(DIRUT)
QUIT
+9 SET XMNAME=Y
+10 DO QINIT^XMJMQ1(XMDUZ,XMK,XMKN,XMZ,.XMRESPM,.XMABORT)
+11 DO SEARCH^XMJMQ1(XMZ,XMNAME,XMRESPM)
End DoDot:1
if $DATA(DIRUT)
QUIT
+12 QUIT
QNAMEX(XMDUZ,XMK,XMKN,XMZ,XMNAME) ; Query someone's name (name is supplied)
+1 NEW XMRESPM,XMABORT
+2 IF ($LENGTH(XMNAME)<1)!($LENGTH(XMNAME)>30)!(XMNAME[U)!(", "[$EXTRACT(XMNAME,1))
Begin DoDot:1
+3 NEW XMTEXT
+4 WRITE $CHAR(7)
+5 DO BLD^DIALOG(34556,"","","XMTEXT","F")
+6 DO MSG^DIALOG("WH","","","","XMTEXT")
+7 ;Name must be from 1 to 30 characters,
+8 ;and must not contain ^, or begin with comma or space.
End DoDot:1
QUIT
+9 DO QINIT^XMJMQ1(XMDUZ,XMK,XMKN,XMZ,.XMRESPM,.XMABORT)
+10 DO SEARCH^XMJMQ1(XMZ,XMNAME,XMRESPM)
+11 QUIT
DETAIL(XMZ,XMPHDR,XMSUBJ,XMZSTR,XMPAGE,XMABORT) ;
+1 ; XMRESPM Last part msg: of Number of responses in msg
+2 NEW XMTO,XMRESPM,XMNAME,XMIEN,XMTYPE
+3 IF $Y+3>IOSL
DO PAGE(.XMABORT)
if XMABORT
QUIT
+4 WRITE !
+5 SET XMRESPM=+$PIECE($GET(^XMB(3.9,XMZ,3,0)),U,4)
+6 ; XMRESPM_ response / responses
SET XMRESPM=$$EZBLD^DIALOG($SELECT(XMRESPM=1:34557.1,1:34557),XMRESPM)
+7 ; Show broadcast first.
SET XMTO="*"
+8 FOR
SET XMTO=$ORDER(^XMB(3.9,XMZ,1,"C",XMTO))
if $EXTRACT(XMTO,1,1)'="*"
QUIT
Begin DoDot:1
+9 SET XMIEN=$ORDER(^XMB(3.9,XMZ,1,"C",XMTO,""))
+10 SET XMNAME=$PIECE(^XMB(3.9,XMZ,1,XMIEN,0),U,1)
+11 DO WNAME(XMZ,XMNAME,XMIEN,XMRESPM,.XMTYPE,.XMABORT)
End DoDot:1
if XMABORT
QUIT
+12 if XMABORT
QUIT
+13 SET XMTO=""
+14 FOR
SET XMTO=$ORDER(^XMB(3.9,XMZ,1,"C",XMTO))
if XMTO=""
QUIT
Begin DoDot:1
+15 SET XMIEN=$ORDER(^XMB(3.9,XMZ,1,"C",XMTO,""))
+16 IF XMTO=+XMTO
Begin DoDot:2
+17 SET XMNAME=$$NAME^XMXUTIL(XMTO)
End DoDot:2
+18 IF '$TEST
Begin DoDot:2
+19 IF $LENGTH(XMTO)>29
SET XMNAME=$PIECE(^XMB(3.9,XMZ,1,XMIEN,0),U,1)
QUIT
+20 SET XMNAME=XMTO
End DoDot:2
if $EXTRACT(XMTO,1,1)="*"
QUIT
+21 DO WNAME(XMZ,XMNAME,XMIEN,XMRESPM,.XMTYPE,.XMABORT)
End DoDot:1
if XMABORT
QUIT
+22 QUIT
WNAME(XMZ,XMNAME,XMIEN,XMRESPM,XMTYPE,XMABORT) ;
+1 NEW XMREC
+2 SET XMREC=^XMB(3.9,XMZ,1,XMIEN,0)
+3 IF $Y+3>IOSL
DO PAGE(.XMABORT)
if XMABORT
QUIT
+4 WRITE !
+5 ; CC: Info: Thru:
IF $DATA(^XMB(3.9,XMZ,1,XMIEN,"T"))
Begin DoDot:1
+6 SET XMTYPE=$PIECE(^XMB(3.9,XMZ,1,XMIEN,"T"),U,1)
+7 if XMTYPE=""
QUIT
+8 if '$DATA(XMTYPE(XMTYPE))
SET XMTYPE(XMTYPE)=$$EXTERNAL^DILFD(3.91,6.5,"",XMTYPE)
+9 WRITE XMTYPE(XMTYPE),": "
End DoDot:1
+10 WRITE XMNAME
+11 if $X<18
WRITE ?18
+12 ; local user
IF +$PIECE(XMREC,U,1)=$PIECE(XMREC,U,1)
Begin DoDot:1
+13 IF $PIECE(XMREC,U,3)=""
Begin DoDot:2
+14 ; " Not read."
WRITE $$EZBLD^DIALOG(34574)
End DoDot:2
+15 IF '$TEST
Begin DoDot:2
+16 ; Last read:
DO W3(34575,$$MMDT^XMXUTIL1($PIECE(XMREC,U,3)),.XMABORT)
if XMABORT
QUIT
+17 IF $PIECE(XMREC,U,2)
Begin DoDot:3
+18 NEW XMPARM
+19 SET XMPARM(1)=$PIECE(XMREC,U,2)
SET XMPARM(2)=XMRESPM
+20 ; (x of y responses)
DO W3(34576,.XMPARM,.XMABORT)
End DoDot:3
if XMABORT
QUIT
+21 ; [First read: x]
IF $PIECE(XMREC,U,10)'=""
DO W3(34577,$$MMDT^XMXUTIL1($PIECE(XMREC,U,10)),.XMABORT)
if XMABORT
QUIT
+22 ; Copied:
IF $DATA(^XMB(3.9,XMZ,1,XMIEN,"C"))
DO W3(34578,$$MMDT^XMXUTIL1(^("C")),.XMABORT)
if XMABORT
QUIT
+23 ; Surrogate:
IF $DATA(^XMB(3.9,XMZ,1,XMIEN,"S"))
DO W3(34580,^("S"),.XMABORT)
if XMABORT
QUIT
+24 ; Terminated:
IF $DATA(^XMB(3.9,XMZ,1,XMIEN,"D"))
IF ^("D")
DO W3(34581,$$MMDT^XMXUTIL1(^("D")),.XMABORT)
if XMABORT
QUIT
End DoDot:2
if XMABORT
QUIT
+25 IF $DATA(^XMB(3.9,XMZ,1,XMIEN,"F"))
DO FWD(XMZ,XMIEN,.XMABORT)
if XMABORT
QUIT
End DoDot:1
QUIT
+26 IF $EXTRACT(XMNAME,1,2)="F."
IF $PIECE(XMREC,U,12)'=""!$PIECE(XMREC,U,11)
Begin DoDot:1
+27 ; Sent to fax:
IF $PIECE(XMREC,U,5)'=""
DO W3(34582,$$MMDT^XMXUTIL1($PIECE(XMREC,U,5)),.XMABORT)
if XMABORT
QUIT
+28 ; Status:
IF $PIECE(XMREC,U,6)'=""
DO W3(34583,$PIECE(XMREC,U,6),.XMABORT)
if XMABORT
QUIT
+29 ; Fax ID:
IF $PIECE(XMREC,U,12)'=""
DO W3(34584,$PIECE(XMREC,U,12),.XMABORT)
if XMABORT
QUIT
+30 IF $DATA(^XMB(3.9,XMZ,1,XMIEN,"F"))
DO FWD(XMZ,XMIEN,.XMABORT)
if XMABORT
QUIT
End DoDot:1
QUIT
+31 IF XMNAME["@"
Begin DoDot:1
+32 ; Sent:
IF $PIECE(XMREC,U,5)'=""
DO W3(34585,$$MMDT^XMXUTIL1($PIECE(XMREC,U,5)),.XMABORT)
if XMABORT
QUIT
+33 ; Time: x seconds
IF $PIECE(XMREC,U,8)'=""
DO W3($SELECT($PIECE(XMREC,U,8)=1:34586,1:34587),$PIECE(XMREC,U,8),.XMABORT)
if XMABORT
QUIT
+34 ; Path:
IF $PIECE(XMREC,U,7)'=""
IF $DATA(^DIC(4.2,$PIECE(XMREC,U,7),0))
DO W3(34588,$PIECE(^(0),U),.XMABORT)
if XMABORT
QUIT
+35 ; Message ID:
IF $PIECE(XMREC,U,4)'=""
DO W3(34590,$PIECE(XMREC,U,4),.XMABORT)
if XMABORT
QUIT
+36 ; Status:
IF $PIECE(XMREC,U,6)'=""
DO W3(34583,$PIECE(XMREC,U,6),.XMABORT)
if XMABORT
QUIT
+37 IF $DATA(^XMB(3.9,XMZ,1,XMIEN,"F"))
DO FWD(XMZ,XMIEN,.XMABORT)
if XMABORT
QUIT
End DoDot:1
QUIT
+38 ; Broadcast
IF $EXTRACT(XMNAME,1,3)="* ("
Begin DoDot:1
+39 IF $DATA(^XMB(3.9,XMZ,1,XMIEN,"F"))
DO FWD(XMZ,XMIEN,.XMABORT)
End DoDot:1
QUIT
+40 IF ".D.H.S."[("."_$EXTRACT(XMNAME,1,2))
Begin DoDot:1
+41 ; Date:
IF $PIECE(XMREC,U,3)'=""
DO W3(34591,$$MMDT^XMXUTIL1($PIECE(XMREC,U,3)),.XMABORT)
if XMABORT
QUIT
+42 ; Status:
IF $PIECE(XMREC,U,6)'=""
DO W3(34583,$PIECE(XMREC,U,6),.XMABORT)
if XMABORT
QUIT
+43 IF $DATA(^XMB(3.9,XMZ,1,XMIEN,"F"))
DO FWD(XMZ,XMIEN,.XMABORT)
if XMABORT
QUIT
End DoDot:1
QUIT
+44 QUIT
FWD(XMZ,XMIEN,XMABORT) ;
+1 NEW XMFWDREC,XMFWDBY,XMFWDTYP
+2 SET XMFWDREC=^XMB(3.9,XMZ,1,XMIEN,"F")
+3 SET XMFWDBY=$PIECE(XMFWDREC,U)
+4 ; Forwarded on:
IF $EXTRACT(XMFWDBY,1)=" "
DO W3(34592,XMFWDBY,.XMABORT)
QUIT
+5 ; Forwarded by:
IF $EXTRACT(XMFWDBY,1)?1N!($EXTRACT(XMFWDBY,1)=".")
DO W3(34593,$$NAME^XMXUTIL(+XMFWDBY)_" "_$PIECE(XMFWDBY," ",2,99),.XMABORT)
QUIT
+6 SET XMFWDTYP=$PIECE(XMFWDREC,U,3)
+7 ; Auto-Forwarded / Filter-Forwarded / Forwarded by:
DO W3($SELECT(XMFWDTYP="A":34593.1,XMFWDTYP="F":34593.2,1:34593),XMFWDBY,.XMABORT)
+8 if $PIECE(XMFWDREC,U,4)=""
QUIT
+9 NEW XMPARM
+10 SET XMPARM(1)=$$NAME^XMXUTIL($PIECE(XMFWDREC,U,2))
+11 SET XMPARM(2)=$PIECE(XMFWDREC,U,4)
+12 SET XMFWDTYP=$PIECE(XMFWDREC,U,5)
+13 ; Filter-Forwarded / Forwarded to |1| by: |2|
+14 DO W3($SELECT(XMFWDTYP="F":34594.1,1:34594),.XMPARM,.XMABORT)
+15 QUIT
W3(XMPIECE,XMPARM,XMABORT) ;
+1 SET XMPIECE=$$EZBLD^DIALOG(XMPIECE,.XMPARM)
+2 IF 1+$LENGTH(XMPIECE)+$X>IOM
Begin DoDot:1
+3 IF $Y+3+($LENGTH(XMPIECE)-1\60)>IOSL
DO PAGE(.XMABORT)
if XMABORT
QUIT
+4 WRITE !,?18
+5 if $LENGTH(XMPIECE)<61
QUIT
+6 FOR
Begin DoDot:2
+7 WRITE " ",$EXTRACT(XMPIECE,1,60),!,?18
+8 SET XMPIECE=$EXTRACT(XMPIECE,61,999)
End DoDot:2
if $LENGTH(XMPIECE)<61
QUIT
End DoDot:1
if XMABORT
QUIT
+9 WRITE " ",XMPIECE
+10 QUIT
+11 ;PAGE(XMPHDR,XMSUBJ,XMZSTR,XMPAGE,XMABORT);
PAGE(XMABORT) ;
+1 IF $EXTRACT($GET(IOST),1,2)="C-"
DO PAGE^XMXUTIL(.XMABORT)
if XMABORT
QUIT
+2 WRITE @IOF
+3 if 'XMPHDR
QUIT
+4 DO PAGE2HDR^XMJMP1(XMSUBJ,XMZSTR,.XMPAGE)
+5 QUIT
