- XMJMP ;ISC-SF/GMB-Print,Backup messages ;12/04/2002 10:53
- ;;8.0;MailMan;**9**;Jun 28, 2002
- ; PRINT Replaces ENTPRT^XMA0,^XMA02,ENTPRT^XMAP,QE2^XMA5
- ; BACKUP Replaces E^XMA1,ENT8^XMAH,ENTR^XMAP,ENTBCK^XMAP
- ; (ISC-WASH/CAP/THM)
- PRINT(XMDUZ,XMK,XMZ,XMPRTHDR,XMBROWSE) ; Print
- ; XMPRTHDR 1=Print header
- ; 0=don't (headerless print)
- ; XMRECIPS 0=Don't print recipients
- ; 1=Print summary recipients
- ; 2=Print detail recipients
- ; XMBROWSE 0=Print normally
- ; 1=Direct the print to the VA FileMan Browser
- N XMWHICH,XMRESPS,XMABORT,XMRECIPS,XMSAVE,ZTSK
- S XMABORT=0
- I $G(XMBROWSE) S XMRECIPS=0
- E D QRECIP(.XMRECIPS,.XMABORT) Q:XMABORT
- S XMRESPS=$$RESP^XMXUTIL2(XMZ)
- I XMRESPS D Q:XMABORT
- . S XMWHICH="0-"_XMRESPS
- . D WHICH(XMZ,XMRESPS,$$EZBLD^DIALOG(34500),.XMWHICH,.XMABORT) ; Print
- . ; If responses includes from x through the end, then set it so that
- . ; if the user queues for later printing, any new add'l responses
- . ; will be printed, too.
- . I XMWHICH["-",$P(XMWHICH,"-",$L(XMWHICH,"-"))=XMRESPS S XMWHICH=$P(XMWHICH,"-",1,$L(XMWHICH,"-")-1)_"-"
- E S XMWHICH="0-"
- S:$G(XMPRTHDR)="" XMPRTHDR=1 ; default is to print with headers
- F I="DUZ","XMDUZ","XMV(","XMK","XMZ","XMWHICH","XMRECIPS","XMPRTHDR" S XMSAVE(I)=""
- I $D(XMSECURE) F I="XMPAKMAN","XMSECURE","XMSECURE(" S XMSAVE(I)=""
- I $G(XMBROWSE) N IOP,DDBDMSG S IOP="BROWSER",DDBDMSG=$$EZBLD^DIALOG(34537,XMZ)_" "_$$ZSUBJ^XMXUTIL2(XMZ) ; (Instead of "VA FileMan Browser")
- D EN^XUTMDEVQ("PRTMSGX^XMJMP",$$EZBLD^DIALOG(34501),.XMSAVE,,1) ; MailMan: Print
- I $D(ZTSK) W !,$$EZBLD^DIALOG(34501.1,ZTSK) ; Request queued. Task number: |1|
- Q
- PRTMSG(XMDUZ,XMK,XMZ,XMWHICH,XMRECIPS,XMPRTHDR) ;
- PRTMSGX ;
- PRINTMSG ;
- N XMKN,XMRESPS,XMZREC,XMPTR
- S XMZREC=$G(^XMB(3.9,XMZ,0)) Q:XMZREC=""
- D BSKT^XMJMP1(XMDUZ,XMZ,.XMK,.XMKN)
- D RESPONSE(XMDUZ,XMZ,.XMRESPS,.XMPTR)
- W:$E($G(IOST),1,2)="C-" @IOF
- D:XMPRTHDR IDHDR(XMDUZ)
- D PRINTIT^XMJMP1(XMDUZ,XMK,XMKN,XMZ,XMZREC,XMRESPS,XMPTR,XMWHICH,XMRECIPS,0,XMPRTHDR)
- I $D(ZTQUEUED) S ZTREQ="@" D ^%ZISC ; This close device is needed to preserve the temp global used by p-message.
- Q
- IDHDR(XMDUZ) ; Header: "MailMan msg for..."
- N XMREC,XMPARM
- S XMREC=$G(^VA(200,XMDUZ,0))
- W $C(13),$$EZBLD^DIALOG(34502,XMV("NAME")) ; MailMan message for
- I $P(XMREC,U,9)'="",$D(^DIC(3.1,+$P(XMREC,U,9),0)) W " ",$P(^(0),U,1) ; VA TITLE
- S XMPARM(1)=^XMB("NETNAME"),XMPARM(2)=$$MMDT^XMXUTIL1($$NOW^XLFDT)
- W !,$$EZBLD^DIALOG(34503,.XMPARM),! ; Printed at site date
- Q
- QRECIP(XMRECIPS,XMABORT) ;
- N DIR,DIRUT,Y,XMSUMRY
- S DIR(0)="Y"
- S DIR("A")=$$EZBLD^DIALOG(34504) ; Print recipient list
- S DIR("B")=$$EZBLD^DIALOG(39053) ; No
- D BLD^DIALOG(34505,"","","DIR(""?"")")
- D ^DIR I $D(DIRUT) S XMABORT=1 Q
- I Y=0 S XMRECIPS=0 Q
- S XMSUMRY=$$EZBLD^DIALOG(34507)
- S DIR(0)="SM^"_$$EZBLD^DIALOG(34506)_";"_XMSUMRY
- S DIR("A")=$$EZBLD^DIALOG(34508) ; Print Detail or Summary recipient chain
- S DIR("B")=$P(XMSUMRY,":",2,99) ; Summary
- D ^DIR I $D(DIRUT) S XMABORT=1 Q
- S XMRECIPS=$S(Y=$P(XMSUMRY,":",1):1,1:2)
- Q
- DISPMSG(XMDUZ,XMK,XMKN,XMZ,XMSECBAD,XMNOBACK) ; Display message
- N XMRESPS,XMRESP,XMPTR,XMZREC,XMBACKUP
- S XMZREC=^XMB(3.9,XMZ,0)
- S XMPAKMAN=$$PAKMAN^XMXSEC1(XMZ,XMZREC)
- D RESPONSE(XMDUZ,XMZ,.XMRESPS,.XMPTR,.XMRESP)
- I XMRESP'="",XMRESPS S XMRESP=XMRESP+1 I XMRESP>XMRESPS,'$G(XMNOBACK) S XMBACKUP=1
- I XMDUZ=.5,XMK>999 S XMRESP=XMRESPS+1 K:$D(XMBACKUP) XMBACKUP
- E I $D(^XMB(3.9,XMZ,"K")),'$D(XMSECURE),'$$KEYOK^XMJMCODE(XMZ,$P(XMZREC,U,10)) S XMSECBAD=1 Q
- W @IOF
- D PRINTIT^XMJMP1(XMDUZ,XMK,XMKN,XMZ,XMZREC,XMRESPS,XMPTR,+XMRESP_"-",0,1,1)
- I $G(XMBACKUP) W !!,$$EZBLD^DIALOG(34509) ; You are at the end of this message. Enter 'B' to Backup and review it.
- Q
- RESPONSE(XMDUZ,XMZ,XMRESPS,XMPTR,XMRESP) ;
- ; XMRESP="" if the user hasn't read the message at all
- ; 0 if the user has read the original message only
- ; n if the user has read thru response n
- S XMRESPS=+$P($G(^XMB(3.9,XMZ,3,0)),U,4)
- ;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
- CHKRESP(XMDUZ,XMZO,XMRESPSO,XMRESP) ;
- N XMRESPS
- S XMRESPS=+$P($G(^XMB(3.9,XMZO,3,0)),U,4)
- Q:XMRESPS=+XMRESP ; No new responses
- I XMRESPSO>XMRESP D Q:XMRESPSO=XMRESPS
- . I XMRESPSO-1>XMRESP D
- . . ; >> You haven't read responses |1|-|2|. You may backup to see them. <<
- . . N XMPARM
- . . S XMPARM(1)=XMRESP+1,XMPARM(2)=XMRESPSO
- . . W !,$$EZBLD^DIALOG(34510,.XMPARM)
- . E W !,$$EZBLD^DIALOG(34511,XMRESP+1) ; >> You haven't read response |1|. You may backup to see it. <<
- . S XMRESP=XMRESPSO
- N XMZ
- F S XMRESP=$O(^XMB(3.9,XMZO,3,XMRESP)) Q:'XMRESP S XMZ=$P($G(^(XMRESP,0)),U,1) I XMZ,$P($G(^XMB(3.9,XMZ,0)),U,2)'=XMDUZ Q
- Q:'XMRESP
- W !,$$EZBLD^DIALOG(34512,XMRESP) ; >> Response |1| has arrived - you may backup to see it. <<
- Q
- BACKUP(XMDUZ,XMK,XMKN,XMZ) ; Backup
- N XMWHICH,XMRESPS,XMABORT,XMZREC,XMPTR
- S XMZREC=^XMB(3.9,XMZ,0)
- I $D(^XMB(3.9,XMZ,"K")),'$D(XMSECURE) Q:'$$KEYOK^XMJMCODE(XMZ,$P(XMZREC,U,10))
- S XMABORT=0
- D RESPONSE(XMDUZ,XMZ,.XMRESPS,.XMPTR,.XMWHICH)
- I XMRESPS D HOWMUCH^XMJMP1(XMZ,XMRESPS,.XMWHICH,.XMABORT) Q:XMABORT
- W @IOF
- D PRINTIT^XMJMP1(XMDUZ,XMK,XMKN,XMZ,XMZREC,XMRESPS,XMPTR,XMWHICH,0,1,1)
- Q
- WHICH(XMZ,XMRESPS,XMVERB,XMWHICH,XMABORT) ;
- N DIR,DIRUT,Y,XMTEXT
- ; There is 1 response. / There are X responses. Response 0 is the original message. (?? shows index)
- D BLD^DIALOG($S(XMRESPS=1:34514,1:34515),XMRESPS,"","XMTEXT")
- M DIR("A")=XMTEXT
- S DIR("A")=$$EZBLD^DIALOG(34516,XMVERB) ; Select the responses to |1|:
- S:$D(XMWHICH) DIR("B")=XMWHICH
- S DIR("PRE")="I X?.E1N1""-"" S X=X_XMRESPS W XMRESPS"
- S DIR(0)="LACO^0:"_XMRESPS
- S DIR("??")="^D HELPRESP^XMJMP1(XMZ,XMRESPS)"
- D ^DIR I $D(DTOUT)!$D(DUOUT) S XMABORT=1 Q
- S:X'="" XMWHICH=$E(Y,1,$L(Y)-1)
- Q
- PONE(XMDUZ,XMK,XMZ,XMPRTHDR,XMABORT) ;
- PONEX ; Print one message. Check it to see if
- ; the user is allowed to see it. (confidential, scrambled)
- ; If not, print an error message.
- N XMZREC
- I $G(XMK)="" S XMK=$$BSKT^XMXUTIL2(XMDUZ,XMZ)
- I '$D(^XMB(3.9,XMZ,0)),XMK D ZAPIT^XMJBM(XMDUZ,XMK,XMZ) S XMABORT=1 Q
- S XMZREC=^XMB(3.9,XMZ,0)
- I XMDUZ'=DUZ,'$$SURRACC^XMXSEC(XMDUZ,"",XMZ,XMZREC) D Q ; "access"
- . D SHOW^XMJERR
- . S XMABORT=1
- N XMSECURE,XMPAKMAN ; Important 'new' - part of scramble and packman handling
- S XMPAKMAN=$$PAKMAN^XMXSEC1(XMZ,XMZREC)
- I $D(^XMB(3.9,XMZ,"K")),'$$KEYOK^XMJMCODE(XMZ,$P(XMZREC,U,10)) S XMABORT=1 Q
- N XMRECIPS,XMRESPS,XMWHICH
- D QRECIP(.XMRECIPS,.XMABORT) Q:XMABORT
- D RESPONSE(XMDUZ,XMZ,.XMRESPS,"",.XMWHICH)
- I XMRESPS D Q:XMABORT
- . N XMRESP
- . S XMRESP=XMWHICH
- . I $D(^XMB(3.7,XMDUZ,"N0",XMK,XMZ)),XMRESP S:XMRESP'=XMRESPS XMRESP=XMRESP+1
- . E S XMRESP=0
- . I XMRESP=XMRESPS S XMWHICH=XMRESP
- . E S XMWHICH=XMRESP_"-"_XMRESPS
- . D WHICH(XMZ,XMRESPS,$$EZBLD^DIALOG(34500),.XMWHICH,.XMABORT) ; Print
- E S XMWHICH=0
- F I="DUZ","XMDUZ","XMV(","XMK","XMZ","XMWHICH","XMRECIPS","XMPRTHDR" S XMSAVE(I)=""
- I $D(XMSECURE) F I="XMPAKMAN","XMSECURE","XMSECURE(" S XMSAVE(I)=""
- D EN^XUTMDEVQ("PRTMSGX^XMJMP",$$EZBLD^DIALOG(34501),.XMSAVE) ; MailMan: Print
- I $G(POP) S XMABORT=1
- Q
- ;PLIST(XMDUZ,XMZLIST,XMRECIPS,XMPRTHDR,XMMSG)
- PLISTX ;
- ; Print a list of messages.
- ; Check each message as we come to it to see if
- ; the user is allowed to see it. (confidential, scrambled)
- ; If not, print an error message.
- N I,J,XMK,XMKN,XMZ,XMFIRST,XMCNT,XMABORT
- S XMFIRST=1,(XMCNT,XMABORT,I)=0
- F S I=$O(XMZLIST(I)) Q:'I D Q:XMABORT
- . F J=1:1:$L(XMZLIST(I),",") D Q:XMABORT
- . . S XMZ=$P(XMZLIST(I),",",J)
- . . Q:'$D(^XMB(3.9,XMZ,0))
- . . D BSKT^XMJMP1(XMDUZ,XMZ,.XMK,.XMKN)
- . . D PRTMULT(XMDUZ,XMK,XMKN,XMZ,XMRECIPS,XMPRTHDR,.XMFIRST,.XMCNT,.XMABORT)
- Q:$D(ZTQUEUED)
- S XMMSG=$$EZBLD^DIALOG($S(XMCNT=1:34318.1,1:34318),XMCNT)
- Q
- PRTMULT(XMDUZ,XMK,XMKN,XMZ,XMRECIPS,XMPRTHDR,XMFIRST,XMCNT,XMABORT) ; Multiple message print
- N XMNOGO,XMZREC,XMRESPS,XMRESP,XMPTR,XMSECURE,XMPAKMAN
- I $D(ZTQUEUED) S ZTREQ="@"
- S XMNOGO=0
- S XMZREC=$G(^XMB(3.9,XMZ,0))
- I XMZREC="" D ZAPIT^XMXMSGS2(XMDUZ,XMK,XMZ) Q
- S XMPAKMAN=$$PAKMAN^XMXSEC1(XMZ,XMZREC)
- D CHECK^XMJMP2(XMDUZ,XMZ,XMZREC,.XMNOGO) Q:XMNOGO&'$D(ZTQUEUED)
- I $E(IOST,1,2)="C-"!'XMFIRST W @IOF
- S XMFIRST=0
- D:XMPRTHDR IDHDR(XMDUZ)
- I XMNOGO D NOGOMSG^XMJMP2(XMDUZ,XMZ,XMZREC,.XMNOGO) Q
- D RESPONSE(XMDUZ,XMZ,.XMRESPS,.XMPTR,.XMRESP)
- I $D(^XMB(3.7,XMDUZ,"N0",XMK,XMZ)),XMRESP S:XMRESP'=XMRESPS XMRESP=XMRESP+1
- E S XMRESP=0
- D PRINTIT^XMJMP1(XMDUZ,XMK,XMKN,XMZ,XMZREC,XMRESPS,XMPTR,XMRESP_"-",XMRECIPS,0,XMPRTHDR,1,.XMABORT)
- S XMCNT=XMCNT+1
- ;Q:XMABORT
- ;I $E(IOST,1,2)="C-" D PAGE^XMXUTIL(.XMABORT)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMJMP 8795 printed Feb 18, 2025@23:38:22 Page 2
- XMJMP ;ISC-SF/GMB-Print,Backup messages ;12/04/2002 10:53
- +1 ;;8.0;MailMan;**9**;Jun 28, 2002
- +2 ; PRINT Replaces ENTPRT^XMA0,^XMA02,ENTPRT^XMAP,QE2^XMA5
- +3 ; BACKUP Replaces E^XMA1,ENT8^XMAH,ENTR^XMAP,ENTBCK^XMAP
- +4 ; (ISC-WASH/CAP/THM)
- PRINT(XMDUZ,XMK,XMZ,XMPRTHDR,XMBROWSE) ; Print
- +1 ; XMPRTHDR 1=Print header
- +2 ; 0=don't (headerless print)
- +3 ; XMRECIPS 0=Don't print recipients
- +4 ; 1=Print summary recipients
- +5 ; 2=Print detail recipients
- +6 ; XMBROWSE 0=Print normally
- +7 ; 1=Direct the print to the VA FileMan Browser
- +8 NEW XMWHICH,XMRESPS,XMABORT,XMRECIPS,XMSAVE,ZTSK
- +9 SET XMABORT=0
- +10 IF $GET(XMBROWSE)
- SET XMRECIPS=0
- +11 IF '$TEST
- DO QRECIP(.XMRECIPS,.XMABORT)
- if XMABORT
- QUIT
- +12 SET XMRESPS=$$RESP^XMXUTIL2(XMZ)
- +13 IF XMRESPS
- Begin DoDot:1
- +14 SET XMWHICH="0-"_XMRESPS
- +15 ; Print
- DO WHICH(XMZ,XMRESPS,$$EZBLD^DIALOG(34500),.XMWHICH,.XMABORT)
- +16 ; If responses includes from x through the end, then set it so that
- +17 ; if the user queues for later printing, any new add'l responses
- +18 ; will be printed, too.
- +19 IF XMWHICH["-"
- IF $PIECE(XMWHICH,"-",$LENGTH(XMWHICH,"-"))=XMRESPS
- SET XMWHICH=$PIECE(XMWHICH,"-",1,$LENGTH(XMWHICH,"-")-1)_"-"
- End DoDot:1
- if XMABORT
- QUIT
- +20 IF '$TEST
- SET XMWHICH="0-"
- +21 ; default is to print with headers
- if $GET(XMPRTHDR)=""
- SET XMPRTHDR=1
- +22 FOR I="DUZ","XMDUZ","XMV(","XMK","XMZ","XMWHICH","XMRECIPS","XMPRTHDR"
- SET XMSAVE(I)=""
- +23 IF $DATA(XMSECURE)
- FOR I="XMPAKMAN","XMSECURE","XMSECURE("
- SET XMSAVE(I)=""
- +24 ; (Instead of "VA FileMan Browser")
- IF $GET(XMBROWSE)
- NEW IOP,DDBDMSG
- SET IOP="BROWSER"
- SET DDBDMSG=$$EZBLD^DIALOG(34537,XMZ)_" "_$$ZSUBJ^XMXUTIL2(XMZ)
- +25 ; MailMan: Print
- DO EN^XUTMDEVQ("PRTMSGX^XMJMP",$$EZBLD^DIALOG(34501),.XMSAVE,,1)
- +26 ; Request queued. Task number: |1|
- IF $DATA(ZTSK)
- WRITE !,$$EZBLD^DIALOG(34501.1,ZTSK)
- +27 QUIT
- PRTMSG(XMDUZ,XMK,XMZ,XMWHICH,XMRECIPS,XMPRTHDR) ;
- PRTMSGX ;
- PRINTMSG ;
- +1 NEW XMKN,XMRESPS,XMZREC,XMPTR
- +2 SET XMZREC=$GET(^XMB(3.9,XMZ,0))
- if XMZREC=""
- QUIT
- +3 DO BSKT^XMJMP1(XMDUZ,XMZ,.XMK,.XMKN)
- +4 DO RESPONSE(XMDUZ,XMZ,.XMRESPS,.XMPTR)
- +5 if $EXTRACT($GET(IOST),1,2)="C-"
- WRITE @IOF
- +6 if XMPRTHDR
- DO IDHDR(XMDUZ)
- +7 DO PRINTIT^XMJMP1(XMDUZ,XMK,XMKN,XMZ,XMZREC,XMRESPS,XMPTR,XMWHICH,XMRECIPS,0,XMPRTHDR)
- +8 ; This close device is needed to preserve the temp global used by p-message.
- IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- DO ^%ZISC
- +9 QUIT
- IDHDR(XMDUZ) ; Header: "MailMan msg for..."
- +1 NEW XMREC,XMPARM
- +2 SET XMREC=$GET(^VA(200,XMDUZ,0))
- +3 ; MailMan message for
- WRITE $CHAR(13),$$EZBLD^DIALOG(34502,XMV("NAME"))
- +4 ; VA TITLE
- IF $PIECE(XMREC,U,9)'=""
- IF $DATA(^DIC(3.1,+$PIECE(XMREC,U,9),0))
- WRITE " ",$PIECE(^(0),U,1)
- +5 SET XMPARM(1)=^XMB("NETNAME")
- SET XMPARM(2)=$$MMDT^XMXUTIL1($$NOW^XLFDT)
- +6 ; Printed at site date
- WRITE !,$$EZBLD^DIALOG(34503,.XMPARM),!
- +7 QUIT
- QRECIP(XMRECIPS,XMABORT) ;
- +1 NEW DIR,DIRUT,Y,XMSUMRY
- +2 SET DIR(0)="Y"
- +3 ; Print recipient list
- SET DIR("A")=$$EZBLD^DIALOG(34504)
- +4 ; No
- SET DIR("B")=$$EZBLD^DIALOG(39053)
- +5 DO BLD^DIALOG(34505,"","","DIR(""?"")")
- +6 DO ^DIR
- IF $DATA(DIRUT)
- SET XMABORT=1
- QUIT
- +7 IF Y=0
- SET XMRECIPS=0
- QUIT
- +8 SET XMSUMRY=$$EZBLD^DIALOG(34507)
- +9 SET DIR(0)="SM^"_$$EZBLD^DIALOG(34506)_";"_XMSUMRY
- +10 ; Print Detail or Summary recipient chain
- SET DIR("A")=$$EZBLD^DIALOG(34508)
- +11 ; Summary
- SET DIR("B")=$PIECE(XMSUMRY,":",2,99)
- +12 DO ^DIR
- IF $DATA(DIRUT)
- SET XMABORT=1
- QUIT
- +13 SET XMRECIPS=$SELECT(Y=$PIECE(XMSUMRY,":",1):1,1:2)
- +14 QUIT
- DISPMSG(XMDUZ,XMK,XMKN,XMZ,XMSECBAD,XMNOBACK) ; Display message
- +1 NEW XMRESPS,XMRESP,XMPTR,XMZREC,XMBACKUP
- +2 SET XMZREC=^XMB(3.9,XMZ,0)
- +3 SET XMPAKMAN=$$PAKMAN^XMXSEC1(XMZ,XMZREC)
- +4 DO RESPONSE(XMDUZ,XMZ,.XMRESPS,.XMPTR,.XMRESP)
- +5 IF XMRESP'=""
- IF XMRESPS
- SET XMRESP=XMRESP+1
- IF XMRESP>XMRESPS
- IF '$GET(XMNOBACK)
- SET XMBACKUP=1
- +6 IF XMDUZ=.5
- IF XMK>999
- SET XMRESP=XMRESPS+1
- if $DATA(XMBACKUP)
- KILL XMBACKUP
- +7 IF '$TEST
- IF $DATA(^XMB(3.9,XMZ,"K"))
- IF '$DATA(XMSECURE)
- IF '$$KEYOK^XMJMCODE(XMZ,$PIECE(XMZREC,U,10))
- SET XMSECBAD=1
- QUIT
- +8 WRITE @IOF
- +9 DO PRINTIT^XMJMP1(XMDUZ,XMK,XMKN,XMZ,XMZREC,XMRESPS,XMPTR,+XMRESP_"-",0,1,1)
- +10 ; You are at the end of this message. Enter 'B' to Backup and review it.
- IF $GET(XMBACKUP)
- WRITE !!,$$EZBLD^DIALOG(34509)
- +11 QUIT
- RESPONSE(XMDUZ,XMZ,XMRESPS,XMPTR,XMRESP) ;
- +1 ; XMRESP="" if the user hasn't read the message at all
- +2 ; 0 if the user has read the original message only
- +3 ; n if the user has read thru response n
- +4 SET XMRESPS=+$PIECE($GET(^XMB(3.9,XMZ,3,0)),U,4)
- +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
- CHKRESP(XMDUZ,XMZO,XMRESPSO,XMRESP) ;
- +1 NEW XMRESPS
- +2 SET XMRESPS=+$PIECE($GET(^XMB(3.9,XMZO,3,0)),U,4)
- +3 ; No new responses
- if XMRESPS=+XMRESP
- QUIT
- +4 IF XMRESPSO>XMRESP
- Begin DoDot:1
- +5 IF XMRESPSO-1>XMRESP
- Begin DoDot:2
- +6 ; >> You haven't read responses |1|-|2|. You may backup to see them. <<
- +7 NEW XMPARM
- +8 SET XMPARM(1)=XMRESP+1
- SET XMPARM(2)=XMRESPSO
- +9 WRITE !,$$EZBLD^DIALOG(34510,.XMPARM)
- End DoDot:2
- +10 ; >> You haven't read response |1|. You may backup to see it. <<
- IF '$TEST
- WRITE !,$$EZBLD^DIALOG(34511,XMRESP+1)
- +11 SET XMRESP=XMRESPSO
- End DoDot:1
- if XMRESPSO=XMRESPS
- QUIT
- +12 NEW XMZ
- +13 FOR
- SET XMRESP=$ORDER(^XMB(3.9,XMZO,3,XMRESP))
- if 'XMRESP
- QUIT
- SET XMZ=$PIECE($GET(^(XMRESP,0)),U,1)
- IF XMZ
- IF $PIECE($GET(^XMB(3.9,XMZ,0)),U,2)'=XMDUZ
- QUIT
- +14 if 'XMRESP
- QUIT
- +15 ; >> Response |1| has arrived - you may backup to see it. <<
- WRITE !,$$EZBLD^DIALOG(34512,XMRESP)
- +16 QUIT
- BACKUP(XMDUZ,XMK,XMKN,XMZ) ; Backup
- +1 NEW XMWHICH,XMRESPS,XMABORT,XMZREC,XMPTR
- +2 SET XMZREC=^XMB(3.9,XMZ,0)
- +3 IF $DATA(^XMB(3.9,XMZ,"K"))
- IF '$DATA(XMSECURE)
- if '$$KEYOK^XMJMCODE(XMZ,$PIECE(XMZREC,U,10))
- QUIT
- +4 SET XMABORT=0
- +5 DO RESPONSE(XMDUZ,XMZ,.XMRESPS,.XMPTR,.XMWHICH)
- +6 IF XMRESPS
- DO HOWMUCH^XMJMP1(XMZ,XMRESPS,.XMWHICH,.XMABORT)
- if XMABORT
- QUIT
- +7 WRITE @IOF
- +8 DO PRINTIT^XMJMP1(XMDUZ,XMK,XMKN,XMZ,XMZREC,XMRESPS,XMPTR,XMWHICH,0,1,1)
- +9 QUIT
- WHICH(XMZ,XMRESPS,XMVERB,XMWHICH,XMABORT) ;
- +1 NEW DIR,DIRUT,Y,XMTEXT
- +2 ; There is 1 response. / There are X responses. Response 0 is the original message. (?? shows index)
- +3 DO BLD^DIALOG($SELECT(XMRESPS=1:34514,1:34515),XMRESPS,"","XMTEXT")
- +4 MERGE DIR("A")=XMTEXT
- +5 ; Select the responses to |1|:
- SET DIR("A")=$$EZBLD^DIALOG(34516,XMVERB)
- +6 if $DATA(XMWHICH)
- SET DIR("B")=XMWHICH
- +7 SET DIR("PRE")="I X?.E1N1""-"" S X=X_XMRESPS W XMRESPS"
- +8 SET DIR(0)="LACO^0:"_XMRESPS
- +9 SET DIR("??")="^D HELPRESP^XMJMP1(XMZ,XMRESPS)"
- +10 DO ^DIR
- IF $DATA(DTOUT)!$DATA(DUOUT)
- SET XMABORT=1
- QUIT
- +11 if X'=""
- SET XMWHICH=$EXTRACT(Y,1,$LENGTH(Y)-1)
- +12 QUIT
- PONE(XMDUZ,XMK,XMZ,XMPRTHDR,XMABORT) ;
- PONEX ; Print one message. Check it to see if
- +1 ; the user is allowed to see it. (confidential, scrambled)
- +2 ; If not, print an error message.
- +3 NEW XMZREC
- +4 IF $GET(XMK)=""
- SET XMK=$$BSKT^XMXUTIL2(XMDUZ,XMZ)
- +5 IF '$DATA(^XMB(3.9,XMZ,0))
- IF XMK
- DO ZAPIT^XMJBM(XMDUZ,XMK,XMZ)
- SET XMABORT=1
- QUIT
- +6 SET XMZREC=^XMB(3.9,XMZ,0)
- +7 ; "access"
- IF XMDUZ'=DUZ
- IF '$$SURRACC^XMXSEC(XMDUZ,"",XMZ,XMZREC)
- Begin DoDot:1
- +8 DO SHOW^XMJERR
- +9 SET XMABORT=1
- End DoDot:1
- QUIT
- +10 ; Important 'new' - part of scramble and packman handling
- NEW XMSECURE,XMPAKMAN
- +11 SET XMPAKMAN=$$PAKMAN^XMXSEC1(XMZ,XMZREC)
- +12 IF $DATA(^XMB(3.9,XMZ,"K"))
- IF '$$KEYOK^XMJMCODE(XMZ,$PIECE(XMZREC,U,10))
- SET XMABORT=1
- QUIT
- +13 NEW XMRECIPS,XMRESPS,XMWHICH
- +14 DO QRECIP(.XMRECIPS,.XMABORT)
- if XMABORT
- QUIT
- +15 DO RESPONSE(XMDUZ,XMZ,.XMRESPS,"",.XMWHICH)
- +16 IF XMRESPS
- Begin DoDot:1
- +17 NEW XMRESP
- +18 SET XMRESP=XMWHICH
- +19 IF $DATA(^XMB(3.7,XMDUZ,"N0",XMK,XMZ))
- IF XMRESP
- if XMRESP'=XMRESPS
- SET XMRESP=XMRESP+1
- +20 IF '$TEST
- SET XMRESP=0
- +21 IF XMRESP=XMRESPS
- SET XMWHICH=XMRESP
- +22 IF '$TEST
- SET XMWHICH=XMRESP_"-"_XMRESPS
- +23 ; Print
- DO WHICH(XMZ,XMRESPS,$$EZBLD^DIALOG(34500),.XMWHICH,.XMABORT)
- End DoDot:1
- if XMABORT
- QUIT
- +24 IF '$TEST
- SET XMWHICH=0
- +25 FOR I="DUZ","XMDUZ","XMV(","XMK","XMZ","XMWHICH","XMRECIPS","XMPRTHDR"
- SET XMSAVE(I)=""
- +26 IF $DATA(XMSECURE)
- FOR I="XMPAKMAN","XMSECURE","XMSECURE("
- SET XMSAVE(I)=""
- +27 ; MailMan: Print
- DO EN^XUTMDEVQ("PRTMSGX^XMJMP",$$EZBLD^DIALOG(34501),.XMSAVE)
- +28 IF $GET(POP)
- SET XMABORT=1
- +29 QUIT
- +30 ;PLIST(XMDUZ,XMZLIST,XMRECIPS,XMPRTHDR,XMMSG)
- PLISTX ;
- +1 ; Print a list of messages.
- +2 ; Check each message as we come to it to see if
- +3 ; the user is allowed to see it. (confidential, scrambled)
- +4 ; If not, print an error message.
- +5 NEW I,J,XMK,XMKN,XMZ,XMFIRST,XMCNT,XMABORT
- +6 SET XMFIRST=1
- SET (XMCNT,XMABORT,I)=0
- +7 FOR
- SET I=$ORDER(XMZLIST(I))
- if 'I
- QUIT
- Begin DoDot:1
- +8 FOR J=1:1:$LENGTH(XMZLIST(I),",")
- Begin DoDot:2
- +9 SET XMZ=$PIECE(XMZLIST(I),",",J)
- +10 if '$DATA(^XMB(3.9,XMZ,0))
- QUIT
- +11 DO BSKT^XMJMP1(XMDUZ,XMZ,.XMK,.XMKN)
- +12 DO PRTMULT(XMDUZ,XMK,XMKN,XMZ,XMRECIPS,XMPRTHDR,.XMFIRST,.XMCNT,.XMABORT)
- End DoDot:2
- if XMABORT
- QUIT
- End DoDot:1
- if XMABORT
- QUIT
- +13 if $DATA(ZTQUEUED)
- QUIT
- +14 SET XMMSG=$$EZBLD^DIALOG($SELECT(XMCNT=1:34318.1,1:34318),XMCNT)
- +15 QUIT
- PRTMULT(XMDUZ,XMK,XMKN,XMZ,XMRECIPS,XMPRTHDR,XMFIRST,XMCNT,XMABORT) ; Multiple message print
- +1 NEW XMNOGO,XMZREC,XMRESPS,XMRESP,XMPTR,XMSECURE,XMPAKMAN
- +2 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +3 SET XMNOGO=0
- +4 SET XMZREC=$GET(^XMB(3.9,XMZ,0))
- +5 IF XMZREC=""
- DO ZAPIT^XMXMSGS2(XMDUZ,XMK,XMZ)
- QUIT
- +6 SET XMPAKMAN=$$PAKMAN^XMXSEC1(XMZ,XMZREC)
- +7 DO CHECK^XMJMP2(XMDUZ,XMZ,XMZREC,.XMNOGO)
- if XMNOGO&'$DATA(ZTQUEUED)
- QUIT
- +8 IF $EXTRACT(IOST,1,2)="C-"!'XMFIRST
- WRITE @IOF
- +9 SET XMFIRST=0
- +10 if XMPRTHDR
- DO IDHDR(XMDUZ)
- +11 IF XMNOGO
- DO NOGOMSG^XMJMP2(XMDUZ,XMZ,XMZREC,.XMNOGO)
- QUIT
- +12 DO RESPONSE(XMDUZ,XMZ,.XMRESPS,.XMPTR,.XMRESP)
- +13 IF $DATA(^XMB(3.7,XMDUZ,"N0",XMK,XMZ))
- IF XMRESP
- if XMRESP'=XMRESPS
- SET XMRESP=XMRESP+1
- +14 IF '$TEST
- SET XMRESP=0
- +15 DO PRINTIT^XMJMP1(XMDUZ,XMK,XMKN,XMZ,XMZREC,XMRESPS,XMPTR,XMRESP_"-",XMRECIPS,0,XMPRTHDR,1,.XMABORT)
- +16 SET XMCNT=XMCNT+1
- +17 ;Q:XMABORT
- +18 ;I $E(IOST,1,2)="C-" D PAGE^XMXUTIL(.XMABORT)
- +19 QUIT