- 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 Feb 18, 2025@23:38:25 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