- XMJML ;ISC-SF/GMB-List messages in basket (can't read) ;04/17/2002 10:03
- ;;8.0;MailMan;;Jun 28, 2002
- ; Replaces 1^XMAL0 (ISC-WASH/THM/CAP)
- LIST(XMDUZ,XMK,XMKN,XMKZ,XMDETAIL) ; List messages in one basket
- ; (This routine does NOT let the user read the messages.)
- ; XMDETAIL 0=Summary; 1=Detailed
- N XMLEN,XMORDER,XMHDLINE,XMABORT
- I XMDUZ=.5,XMK>999 S XMORDER=XMV("ORDER"),XMV("ORDER")=1
- S XMABORT=0
- D INIT(XMDUZ,XMK,XMKN,XMDETAIL,.XMLEN,1)
- S XMHDLINE=$$HEADLINE(XMDUZ,XMK,XMKN)
- D HEADER(XMDETAIL,.XMLEN,XMHDLINE)
- S:XMKZ'="" XMKZ=XMKZ-XMV("ORDER")
- F S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ),XMV("ORDER")) Q:XMKZ="" D Q:XMABORT
- . S XMZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ,""))
- . I '$D(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)) D ADDITC^XMUT4A(XMDUZ,XMK,XMZ,XMKZ)
- . I '$D(^XMB(3.9,XMZ,0)) D ZAPIT^XMXMSGS2(XMDUZ,XMK,XMZ) Q
- . I $Y+4>IOSL D PAGE^XMXUTIL(.XMABORT) Q:XMABORT D
- . . D HEADER(XMDETAIL,.XMLEN,XMHDLINE)
- . D LISTMSG(XMK,XMKN,XMKZ,XMZ,XMDETAIL,.XMLEN)
- I $D(XMORDER) S XMV("ORDER")=XMORDER
- Q
- LISTNEW(XMDUZ,XMK,XMKN) ; List new messages in one basket
- ; (This routine does NOT let the user read the messages.)
- ; XMDETAIL 0=Summary; 1=Detailed
- I '$O(^XMB(3.7,XMDUZ,"N0",XMK,0)) D Q
- . I $P(^XMB(3.7,XMDUZ,2,XMK,0),U,2) S $P(^(0),U,2)=0
- . W !!,$C(7),$$EZBLD^DIALOG(34013),! ;No NEW messages
- N XMKZ,XMZ,XMLEN,XMDETAIL,XMTYPE,XMHDLINE,XMABORT
- S XMDETAIL=1,XMTYPE="N0",XMABORT=0
- D INIT(XMDUZ,XMK,XMKN,XMDETAIL,.XMLEN,1)
- S XMHDLINE=$$HEADLINE^XMJMLN(XMDUZ,0,XMK,XMKN,XMTYPE)
- D HEADER(XMDETAIL,.XMLEN,XMHDLINE)
- S XMZ=""
- F S XMZ=$O(^XMB(3.7,XMDUZ,XMTYPE,XMK,XMZ),XMV("ORDER")) Q:XMZ="" D Q:XMABORT
- . S XMKZ=$P($G(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)),U,2)
- . I 'XMKZ D
- . . D ADDITN^XMUT4A(XMDUZ,XMTYPE,XMK,XMZ)
- . . S XMKZ=$P($G(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)),U,2)
- . I '$D(^XMB(3.9,XMZ,0)) D ZAPIT^XMXMSGS2(XMDUZ,XMK,XMZ) Q
- . I $Y+4>IOSL D PAGE^XMXUTIL(.XMABORT) Q:XMABORT D
- . . D HEADER(XMDETAIL,.XMLEN,XMHDLINE)
- . D LISTMSG(XMK,XMKN,XMKZ,XMZ,XMDETAIL,.XMLEN)
- Q
- LISTPRI(XMDUZ) ; List priority messages in all baskets (Replaces PRIO^XMAL0)
- ; (This routine does NOT let the user read the messages.)
- ; XMDETAIL 0=Summary; 1=Detailed
- N XMK,XMKN,XMKZ,XMZ,XMLEN,XMDETAIL,XMTYPE,XMHDLINE,XMABORT
- S XMDETAIL=1,XMTYPE="N",XMABORT=0
- D INIT^XMJMLN(XMDUZ,XMTYPE,XMDETAIL,1,.XMLEN)
- S XMHDLINE=$$HEADLINE^XMJMLN(XMDUZ,1,"","",XMTYPE)
- D HEADER(XMDETAIL,.XMLEN,XMHDLINE)
- S XMK=""
- F S XMK=$O(^XMB(3.7,XMDUZ,XMTYPE,XMK)) Q:XMK="" D Q:XMABORT
- . S XMZ="",XMKN=$P(^XMB(3.7,XMDUZ,2,XMK,0),U,1)
- . F S XMZ=$O(^XMB(3.7,XMDUZ,XMTYPE,XMK,XMZ),XMV("ORDER")) Q:XMZ="" D Q:XMABORT
- . . S XMKZ=$P($G(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)),U,2)
- . . I 'XMKZ D
- . . . D ADDITN^XMUT4A(XMDUZ,XMTYPE,XMK,XMZ)
- . . . S XMKZ=$P($G(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)),U,2)
- . . I '$D(^XMB(3.9,XMZ,0)) D ZAPIT^XMXMSGS2(XMDUZ,XMK,XMZ) Q
- . . I $Y+4>IOSL D PAGE^XMXUTIL(.XMABORT) Q:XMABORT D
- . . . D HEADER(XMDETAIL,.XMLEN,XMHDLINE)
- . . D LISTMSG(XMK,XMKN,XMKZ,XMZ,XMDETAIL,.XMLEN)
- Q
- INIT(XMDUZ,XMK,XMKN,XMDETAIL,XMLEN,XMONE) ;
- N XMLEFT
- S XMLEFT=79
- I XMDETAIL D
- . S XMLEN("XMZ")=$L($O(^XMB(3.9,":"),-1))+2
- . ;S XMLEN("XMZ")=$L($O(^XMB(3.7,XMDUZ,2,XMK,1,":"),-1))+2
- . S XMLEN("LINE")=5
- . I '$G(XMONE),'$D(XMLEN("BSKT")) S XMLEN("BSKT")=$$MIN^XLFMTH($L(XMKN),10)
- . S XMLEN("RESP")=9
- . S XMLEN("DATE")=$L($$MMDT^XMXUTIL1(DT))
- . S XMLEFT=XMLEFT-XMLEN("XMZ")-XMLEN("LINE")-$G(XMLEN("BSKT"))-XMLEN("RESP")-XMLEN("DATE")-3+$S($G(XMLEN("BSKT")):0,1:1)
- S:'$D(XMLEN("XMKZ")) XMLEN("XMKZ")=$L($O(^XMB(3.7,XMDUZ,2,XMK,1,"C",""),-1))
- S XMLEFT=XMLEFT-XMLEN("XMKZ")-5
- S XMLEN("SUBJ")=XMLEFT*2\3
- S XMLEN("FROM")=XMLEFT-XMLEN("SUBJ")
- Q
- LISTMSG(XMK,XMKN,XMKZ,XMZ,XMDETAIL,XMLEN) ;
- N XMZREC
- S XMZREC=$G(^XMB(3.9,XMZ,0))
- I XMDUZ=.5,XMK>999 D
- . N XMTPRI ; Transmit priority
- . S XMTPRI=$P($G(^XMB(3.7,.5,2,XMK,1,XMZ,0)),U,6)
- . W !,$S($D(^TMP("XM",$J,".",XMKZ)):">",1:" "),$S('XMTPRI:" ",XMTPRI=1:"^",1:"v"),$J(XMKZ,XMLEN("XMKZ")),". "
- E W !,$S($D(^TMP("XM",$J,".",XMKZ)):">",1:" "),$S('$D(^XMB(3.7,XMDUZ,"N0",XMK,XMZ)):" ",$P(XMZREC,U,7)["P":"!",1:"*"),$J(XMKZ,XMLEN("XMKZ")),". "
- I XMDETAIL D
- . W:$D(XMLEN("BSKT")) $$LJ^XLFSTR($E(XMKN,1,XMLEN("BSKT")),XMLEN("BSKT"))," "
- . W $J("["_XMZ_"]",XMLEN("XMZ"))," ",$$DATE^XMXUTIL2(XMZREC,0)
- . W " ",$$MELD^XMXUTIL1($$SUBJ^XMXUTIL2(XMZREC),$$LINES(XMZ),XMLEN("SUBJ")+XMLEN("LINE"))
- . W " ",$$MELD^XMXUTIL1($$NAME^XMXUTIL($P(XMZREC,U,2)),$$RESPONSE(XMDUZ,XMK,XMZ),XMLEN("FROM")+9)
- E D
- . W $$LJ^XLFSTR($E($$SUBJ^XMXUTIL2(XMZREC),1,XMLEN("SUBJ")),XMLEN("SUBJ"))," ",$E($$NAME^XMXUTIL($P(XMZREC,U,2)),1,XMLEN("FROM"))
- Q
- HEADLINE(XMDUZ,XMK,XMKN) ;
- N XMNEWCNT,XMCNT
- S XMNEWCNT=$P(^XMB(3.7,XMDUZ,2,XMK,0),U,2)
- S XMCNT=$P(^XMB(3.7,XMDUZ,2,XMK,1,0),U,4)
- ;Basket / messages / message / new
- Q XMKN_" "_$$EZBLD^DIALOG(34011)_", "_XMCNT_$S(XMCNT>1:$$EZBLD^DIALOG(34007.1)_" ("_$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",0))_"-"_$O(^(""),-1)_")",1:$$EZBLD^DIALOG(34007))_$S(XMNEWCNT:", "_XMNEWCNT_$$EZBLD^DIALOG(34008),1:"")
- I $D(XMHDLINE) W @IOF,XMHDLINE,!
- E W @IOF
- I XMDETAIL D
- . W $$LJ^XLFSTR($$EZBLD^DIALOG(34001),XMLEN("XMZ")+$G(XMLEN("BSKT"),-1)+XMLEN("XMKZ")+XMLEN("DATE")+7,".") ;*=New/!=Priority
- . W $$COMBO($$EZBLD^DIALOG(34002),$$EZBLD^DIALOG(34003.1),XMLEN("SUBJ")+XMLEN("LINE")) ;Subject / Lines
- . W "."
- . W $$COMBO($$EZBLD^DIALOG(34006),$$EZBLD^DIALOG(34004),XMLEN("FROM")+XMLEN("RESP")) ;From / Read/Rcvd
- E D
- . W $$LJ^XLFSTR($$EZBLD^DIALOG(34005),79-XMLEN("FROM"),"."),$$LJ^XLFSTR($$EZBLD^DIALOG(34006),XMLEN("FROM"),".") ;*=New/!=Priority.......Subject / From
- Q
- COMBO(XMSTR1,XMSTR2,XMLEN) ;
- Q $$LJ^XLFSTR($E(XMSTR1,1,XMLEN-$L(XMSTR2)-1),XMLEN-$L(XMSTR2),".")_XMSTR2
- LINES(XMZ) ;
- Q +$P($G(^XMB(3.9,XMZ,2,0)),U,4)
- RESPONSE(XMDUZ,XMK,XMZ) ;
- I XMDUZ=.5,XMK>999 Q ""
- N XMPTR,XMRESP,XMRESPS
- S XMRESPS=+$P($G(^XMB(3.9,XMZ,3,0)),U,4)
- I XMRESPS=0 Q ""
- ;S XMPTR=$O(^XMB(3.9,XMZ,1,"C",$S(XMDUZ=.6:DUZ,1:XMDUZ),0))
- S XMPTR=+$O(^XMB(3.9,XMZ,1,"C",XMDUZ,0))
- S XMRESP=+$P($G(^XMB(3.9,XMZ,1,XMPTR,0)),U,2)
- Q XMRESP_"/"_XMRESPS
- LISTTMP ; List messages in ^TMP global
- ; (This routine does NOT let the user read the messages.)
- ; The following variables are expected to exist:
- ; XMDETAIL 0=Summary; 1=Detailed
- ; XMLEN
- N XMK,XMKN,XMKZ,XMZ,XMABORT,XMREC
- S XMABORT=0
- D HEADER(XMDETAIL,.XMLEN)
- S XMKZ=0
- F S XMKZ=$O(^TMP("XM",$J,"MSG",XMKZ)) Q:XMKZ="" D Q:XMABORT
- . I $Y+4>IOSL D PAGE^XMXUTIL(.XMABORT) Q:XMABORT D
- . . D HEADER(XMDETAIL,.XMLEN)
- . S XMREC=^TMP("XM",$J,"MSG",XMKZ)
- . S XMK=$P(XMREC,U,1),XMKN=$P(XMREC,U,2),XMZ=$P(XMREC,U,3)
- . D LISTMSG(XMK,XMKN,XMKZ,XMZ,XMDETAIL,.XMLEN)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMJML 6718 printed Jan 18, 2025@03:13:04 Page 2
- XMJML ;ISC-SF/GMB-List messages in basket (can't read) ;04/17/2002 10:03
- +1 ;;8.0;MailMan;;Jun 28, 2002
- +2 ; Replaces 1^XMAL0 (ISC-WASH/THM/CAP)
- LIST(XMDUZ,XMK,XMKN,XMKZ,XMDETAIL) ; List messages in one basket
- +1 ; (This routine does NOT let the user read the messages.)
- +2 ; XMDETAIL 0=Summary; 1=Detailed
- +3 NEW XMLEN,XMORDER,XMHDLINE,XMABORT
- +4 IF XMDUZ=.5
- IF XMK>999
- SET XMORDER=XMV("ORDER")
- SET XMV("ORDER")=1
- +5 SET XMABORT=0
- +6 DO INIT(XMDUZ,XMK,XMKN,XMDETAIL,.XMLEN,1)
- +7 SET XMHDLINE=$$HEADLINE(XMDUZ,XMK,XMKN)
- +8 DO HEADER(XMDETAIL,.XMLEN,XMHDLINE)
- +9 if XMKZ'=""
- SET XMKZ=XMKZ-XMV("ORDER")
- +10 FOR
- SET XMKZ=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ),XMV("ORDER"))
- if XMKZ=""
- QUIT
- Begin DoDot:1
- +11 SET XMZ=$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ,""))
- +12 IF '$DATA(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0))
- DO ADDITC^XMUT4A(XMDUZ,XMK,XMZ,XMKZ)
- +13 IF '$DATA(^XMB(3.9,XMZ,0))
- DO ZAPIT^XMXMSGS2(XMDUZ,XMK,XMZ)
- QUIT
- +14 IF $Y+4>IOSL
- DO PAGE^XMXUTIL(.XMABORT)
- if XMABORT
- QUIT
- Begin DoDot:2
- +15 DO HEADER(XMDETAIL,.XMLEN,XMHDLINE)
- End DoDot:2
- +16 DO LISTMSG(XMK,XMKN,XMKZ,XMZ,XMDETAIL,.XMLEN)
- End DoDot:1
- if XMABORT
- QUIT
- +17 IF $DATA(XMORDER)
- SET XMV("ORDER")=XMORDER
- +18 QUIT
- LISTNEW(XMDUZ,XMK,XMKN) ; List new messages in one basket
- +1 ; (This routine does NOT let the user read the messages.)
- +2 ; XMDETAIL 0=Summary; 1=Detailed
- +3 IF '$ORDER(^XMB(3.7,XMDUZ,"N0",XMK,0))
- Begin DoDot:1
- +4 IF $PIECE(^XMB(3.7,XMDUZ,2,XMK,0),U,2)
- SET $PIECE(^(0),U,2)=0
- +5 ;No NEW messages
- WRITE !!,$CHAR(7),$$EZBLD^DIALOG(34013),!
- End DoDot:1
- QUIT
- +6 NEW XMKZ,XMZ,XMLEN,XMDETAIL,XMTYPE,XMHDLINE,XMABORT
- +7 SET XMDETAIL=1
- SET XMTYPE="N0"
- SET XMABORT=0
- +8 DO INIT(XMDUZ,XMK,XMKN,XMDETAIL,.XMLEN,1)
- +9 SET XMHDLINE=$$HEADLINE^XMJMLN(XMDUZ,0,XMK,XMKN,XMTYPE)
- +10 DO HEADER(XMDETAIL,.XMLEN,XMHDLINE)
- +11 SET XMZ=""
- +12 FOR
- SET XMZ=$ORDER(^XMB(3.7,XMDUZ,XMTYPE,XMK,XMZ),XMV("ORDER"))
- if XMZ=""
- QUIT
- Begin DoDot:1
- +13 SET XMKZ=$PIECE($GET(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)),U,2)
- +14 IF 'XMKZ
- Begin DoDot:2
- +15 DO ADDITN^XMUT4A(XMDUZ,XMTYPE,XMK,XMZ)
- +16 SET XMKZ=$PIECE($GET(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)),U,2)
- End DoDot:2
- +17 IF '$DATA(^XMB(3.9,XMZ,0))
- DO ZAPIT^XMXMSGS2(XMDUZ,XMK,XMZ)
- QUIT
- +18 IF $Y+4>IOSL
- DO PAGE^XMXUTIL(.XMABORT)
- if XMABORT
- QUIT
- Begin DoDot:2
- +19 DO HEADER(XMDETAIL,.XMLEN,XMHDLINE)
- End DoDot:2
- +20 DO LISTMSG(XMK,XMKN,XMKZ,XMZ,XMDETAIL,.XMLEN)
- End DoDot:1
- if XMABORT
- QUIT
- +21 QUIT
- LISTPRI(XMDUZ) ; List priority messages in all baskets (Replaces PRIO^XMAL0)
- +1 ; (This routine does NOT let the user read the messages.)
- +2 ; XMDETAIL 0=Summary; 1=Detailed
- +3 NEW XMK,XMKN,XMKZ,XMZ,XMLEN,XMDETAIL,XMTYPE,XMHDLINE,XMABORT
- +4 SET XMDETAIL=1
- SET XMTYPE="N"
- SET XMABORT=0
- +5 DO INIT^XMJMLN(XMDUZ,XMTYPE,XMDETAIL,1,.XMLEN)
- +6 SET XMHDLINE=$$HEADLINE^XMJMLN(XMDUZ,1,"","",XMTYPE)
- +7 DO HEADER(XMDETAIL,.XMLEN,XMHDLINE)
- +8 SET XMK=""
- +9 FOR
- SET XMK=$ORDER(^XMB(3.7,XMDUZ,XMTYPE,XMK))
- if XMK=""
- QUIT
- Begin DoDot:1
- +10 SET XMZ=""
- SET XMKN=$PIECE(^XMB(3.7,XMDUZ,2,XMK,0),U,1)
- +11 FOR
- SET XMZ=$ORDER(^XMB(3.7,XMDUZ,XMTYPE,XMK,XMZ),XMV("ORDER"))
- if XMZ=""
- QUIT
- Begin DoDot:2
- +12 SET XMKZ=$PIECE($GET(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)),U,2)
- +13 IF 'XMKZ
- Begin DoDot:3
- +14 DO ADDITN^XMUT4A(XMDUZ,XMTYPE,XMK,XMZ)
- +15 SET XMKZ=$PIECE($GET(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)),U,2)
- End DoDot:3
- +16 IF '$DATA(^XMB(3.9,XMZ,0))
- DO ZAPIT^XMXMSGS2(XMDUZ,XMK,XMZ)
- QUIT
- +17 IF $Y+4>IOSL
- DO PAGE^XMXUTIL(.XMABORT)
- if XMABORT
- QUIT
- Begin DoDot:3
- +18 DO HEADER(XMDETAIL,.XMLEN,XMHDLINE)
- End DoDot:3
- +19 DO LISTMSG(XMK,XMKN,XMKZ,XMZ,XMDETAIL,.XMLEN)
- End DoDot:2
- if XMABORT
- QUIT
- End DoDot:1
- if XMABORT
- QUIT
- +20 QUIT
- INIT(XMDUZ,XMK,XMKN,XMDETAIL,XMLEN,XMONE) ;
- +1 NEW XMLEFT
- +2 SET XMLEFT=79
- +3 IF XMDETAIL
- Begin DoDot:1
- +4 SET XMLEN("XMZ")=$LENGTH($ORDER(^XMB(3.9,":"),-1))+2
- +5 ;S XMLEN("XMZ")=$L($O(^XMB(3.7,XMDUZ,2,XMK,1,":"),-1))+2
- +6 SET XMLEN("LINE")=5
- +7 IF '$GET(XMONE)
- IF '$DATA(XMLEN("BSKT"))
- SET XMLEN("BSKT")=$$MIN^XLFMTH($LENGTH(XMKN),10)
- +8 SET XMLEN("RESP")=9
- +9 SET XMLEN("DATE")=$LENGTH($$MMDT^XMXUTIL1(DT))
- +10 SET XMLEFT=XMLEFT-XMLEN("XMZ")-XMLEN("LINE")-$GET(XMLEN("BSKT"))-XMLEN("RESP")-XMLEN("DATE")-3+$SELECT($GET(XMLEN("BSKT")):0,1:1)
- End DoDot:1
- +11 if '$DATA(XMLEN("XMKZ"))
- SET XMLEN("XMKZ")=$LENGTH($ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",""),-1))
- +12 SET XMLEFT=XMLEFT-XMLEN("XMKZ")-5
- +13 SET XMLEN("SUBJ")=XMLEFT*2\3
- +14 SET XMLEN("FROM")=XMLEFT-XMLEN("SUBJ")
- +15 QUIT
- LISTMSG(XMK,XMKN,XMKZ,XMZ,XMDETAIL,XMLEN) ;
- +1 NEW XMZREC
- +2 SET XMZREC=$GET(^XMB(3.9,XMZ,0))
- +3 IF XMDUZ=.5
- IF XMK>999
- Begin DoDot:1
- +4 ; Transmit priority
- NEW XMTPRI
- +5 SET XMTPRI=$PIECE($GET(^XMB(3.7,.5,2,XMK,1,XMZ,0)),U,6)
- +6 WRITE !,$SELECT($DATA(^TMP("XM",$JOB,".",XMKZ)):">",1:" "),$SELECT('XMTPRI:" ",XMTPRI=1:"^",1:"v"),$JUSTIFY(XMKZ,XMLEN("XMKZ")),". "
- End DoDot:1
- +7 IF '$TEST
- WRITE !,$SELECT($DATA(^TMP("XM",$JOB,".",XMKZ)):">",1:" "),$SELECT('$DATA(^XMB(3.7,XMDUZ,"N0",XMK,XMZ)):" ",$PIECE(XMZREC,U,7)["P":"!",1:"*"),$JUSTIFY(XMKZ,XMLEN("XMKZ")),". "
- +8 IF XMDETAIL
- Begin DoDot:1
- +9 if $DATA(XMLEN("BSKT"))
- WRITE $$LJ^XLFSTR($EXTRACT(XMKN,1,XMLEN("BSKT")),XMLEN("BSKT"))," "
- +10 WRITE $JUSTIFY("["_XMZ_"]",XMLEN("XMZ"))," ",$$DATE^XMXUTIL2(XMZREC,0)
- +11 WRITE " ",$$MELD^XMXUTIL1($$SUBJ^XMXUTIL2(XMZREC),$$LINES(XMZ),XMLEN("SUBJ")+XMLEN("LINE"))
- +12 WRITE " ",$$MELD^XMXUTIL1($$NAME^XMXUTIL($PIECE(XMZREC,U,2)),$$RESPONSE(XMDUZ,XMK,XMZ),XMLEN("FROM")+9)
- End DoDot:1
- +13 IF '$TEST
- Begin DoDot:1
- +14 WRITE $$LJ^XLFSTR($EXTRACT($$SUBJ^XMXUTIL2(XMZREC),1,XMLEN("SUBJ")),XMLEN("SUBJ"))," ",$EXTRACT($$NAME^XMXUTIL($PIECE(XMZREC,U,2)),1,XMLEN("FROM"))
- End DoDot:1
- +15 QUIT
- HEADLINE(XMDUZ,XMK,XMKN) ;
- +1 NEW XMNEWCNT,XMCNT
- +2 SET XMNEWCNT=$PIECE(^XMB(3.7,XMDUZ,2,XMK,0),U,2)
- +3 SET XMCNT=$PIECE(^XMB(3.7,XMDUZ,2,XMK,1,0),U,4)
- +4 ;Basket / messages / message / new
- +5 QUIT XMKN_" "_$$EZBLD^DIALOG(34011)_", "_XMCNT_$SELECT(XMCNT>1:$$EZBLD^DIALOG(34007.1)_" ("_$ORDER(^XMB(3.7,XMDUZ,2,XMK,1,"C",0))_"-"_$ORDER(^(""),-1)_")",1:$$EZBLD^DIALOG(34007))_$SELECT(XMNEWCNT:", "_XMNEWCNT_$$EZBLD^DIALOG(34008),1:"")
- +1 IF $DATA(XMHDLINE)
- WRITE @IOF,XMHDLINE,!
- +2 IF '$TEST
- WRITE @IOF
- +3 IF XMDETAIL
- Begin DoDot:1
- +4 ;*=New/!=Priority
- WRITE $$LJ^XLFSTR($$EZBLD^DIALOG(34001),XMLEN("XMZ")+$GET(XMLEN("BSKT"),-1)+XMLEN("XMKZ")+XMLEN("DATE")+7,".")
- +5 ;Subject / Lines
- WRITE $$COMBO($$EZBLD^DIALOG(34002),$$EZBLD^DIALOG(34003.1),XMLEN("SUBJ")+XMLEN("LINE"))
- +6 WRITE "."
- +7 ;From / Read/Rcvd
- WRITE $$COMBO($$EZBLD^DIALOG(34006),$$EZBLD^DIALOG(34004),XMLEN("FROM")+XMLEN("RESP"))
- End DoDot:1
- +8 IF '$TEST
- Begin DoDot:1
- +9 ;*=New/!=Priority.......Subject / From
- WRITE $$LJ^XLFSTR($$EZBLD^DIALOG(34005),79-XMLEN("FROM"),"."),$$LJ^XLFSTR($$EZBLD^DIALOG(34006),XMLEN("FROM"),".")
- End DoDot:1
- +10 QUIT
- COMBO(XMSTR1,XMSTR2,XMLEN) ;
- +1 QUIT $$LJ^XLFSTR($EXTRACT(XMSTR1,1,XMLEN-$LENGTH(XMSTR2)-1),XMLEN-$LENGTH(XMSTR2),".")_XMSTR2
- LINES(XMZ) ;
- +1 QUIT +$PIECE($GET(^XMB(3.9,XMZ,2,0)),U,4)
- RESPONSE(XMDUZ,XMK,XMZ) ;
- +1 IF XMDUZ=.5
- IF XMK>999
- QUIT ""
- +2 NEW XMPTR,XMRESP,XMRESPS
- +3 SET XMRESPS=+$PIECE($GET(^XMB(3.9,XMZ,3,0)),U,4)
- +4 IF XMRESPS=0
- QUIT ""
- +5 ;S XMPTR=$O(^XMB(3.9,XMZ,1,"C",$S(XMDUZ=.6:DUZ,1:XMDUZ),0))
- +6 SET XMPTR=+$ORDER(^XMB(3.9,XMZ,1,"C",XMDUZ,0))
- +7 SET XMRESP=+$PIECE($GET(^XMB(3.9,XMZ,1,XMPTR,0)),U,2)
- +8 QUIT XMRESP_"/"_XMRESPS
- LISTTMP ; List messages in ^TMP global
- +1 ; (This routine does NOT let the user read the messages.)
- +2 ; The following variables are expected to exist:
- +3 ; XMDETAIL 0=Summary; 1=Detailed
- +4 ; XMLEN
- +5 NEW XMK,XMKN,XMKZ,XMZ,XMABORT,XMREC
- +6 SET XMABORT=0
- +7 DO HEADER(XMDETAIL,.XMLEN)
- +8 SET XMKZ=0
- +9 FOR
- SET XMKZ=$ORDER(^TMP("XM",$JOB,"MSG",XMKZ))
- if XMKZ=""
- QUIT
- Begin DoDot:1
- +10 IF $Y+4>IOSL
- DO PAGE^XMXUTIL(.XMABORT)
- if XMABORT
- QUIT
- Begin DoDot:2
- +11 DO HEADER(XMDETAIL,.XMLEN)
- End DoDot:2
- +12 SET XMREC=^TMP("XM",$JOB,"MSG",XMKZ)
- +13 SET XMK=$PIECE(XMREC,U,1)
- SET XMKN=$PIECE(XMREC,U,2)
- SET XMZ=$PIECE(XMREC,U,3)
- +14 DO LISTMSG(XMK,XMKN,XMKZ,XMZ,XMDETAIL,.XMLEN)
- End DoDot:1
- if XMABORT
- QUIT
- +15 QUIT