- XMJBN ;ISC-SF/GMB-Access new mail in mailbox ;05/18/2004 08:37
- ;;8.0;MailMan;**25**;Jun 28, 2002
- ; Replaces ^XMA (ISC-WASH/THM/CAP)
- ; Entry points used by MailMan options (not covered by DBIA):
- ; NEW XMNEW - Read new messages
- NEW ;
- ; XMNEW Number of new messages
- ; XMKMULT 1=New msgs in multiple baskets; 0=new msgs in one basket
- N XMABORT,XMK,XMKN,XMNEW,XMKMULT,XMNEWS
- S XMABORT=0
- D INIT^XMJBN1(XMDUZ,.XMK,.XMKN,.XMNEW,.XMKMULT,.XMABORT) Q:XMABORT
- S XMNEWS=1 ; Makes 'new'd msgs drop off list 'til next time
- I XMNEW=1 D Q
- . N XMZ
- . S XMZ=$O(^XMB(3.7,XMDUZ,"N0",XMK,""))
- . I XMDUZ'=DUZ,'$$SURRACC^XMXSEC(XMDUZ,"",XMZ,$G(XMB(3.9,XMZ,0))) D Q
- . . D ZSHOW^XMJERR
- . . D WAIT^XMXUTIL
- . I '$D(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)) D ADDITN^XMUT4A(XMDUZ,"N0",XMK,XMZ)
- . D READNEW(XMDUZ,XMK,XMKN,XMZ)
- . D:$D(^XTMP("XM","MAKENEW",XMDUZ)) NEWAGAIN^XMJBN1(XMDUZ)
- F D Q:'$D(^XMB(3.7,XMDUZ,"N0"))!XMABORT
- . N XMDIR,XMOPT,XMOX,XMY
- . S XMDIR("A")=$$EZBLD^DIALOG(34085) ; Select New mail option
- . D SET^XMXSEC1("R",34086,.XMOPT,.XMOX) ; Read new mail by basket
- . D SET^XMXSEC1("LB",34087,.XMOPT,.XMOX) ; List Baskets with new mail
- . D SET^XMXSEC1("LN",34088,.XMOPT,.XMOX) ; List all new messages
- . D SET^XMXSEC1("LP",34089,.XMOPT,.XMOX) ; List all priority messages
- . I '$D(^XMB(3.7,XMDUZ,"N")) S XMOPT("LP","?")=$$EZBLD^DIALOG(34018) ; You have no new priority messages.
- . D SET^XMXSEC1("P",34090,.XMOPT,.XMOX) ; Print all new messages
- . D SET^XMXSEC1("S",34091,.XMOPT,.XMOX) ; Scan all new messages
- . D SET^XMXSEC1("Q",34092,.XMOPT,.XMOX) ; Quit
- . S XMDIR("B")=XMOX("O",XMV("NEW OPT"))_":"_XMOPT(XMV("NEW OPT"))
- . S XMDIR("??")="XM-U-R-READ NEW"
- . D XMDIR^XMJDIR(.XMDIR,.XMOPT,.XMOX,.XMY,.XMABORT) Q:XMABORT
- . K XMOPT,XMOX,XMDIR
- . D @XMY
- D:$D(^XTMP("XM","MAKENEW",XMDUZ)) NEWAGAIN^XMJBN1(XMDUZ)
- Q
- LB ; List Baskets with new mail (Replaces NEW^XMA0A)
- N DIC,D,DZ
- S DIC="^XMB(3.7,"_XMDUZ_",2,"
- S DIC(0)="AEQ",D="B",DZ="??"
- S DIC("S")="I $P(^(0),U,2)"
- S DIC("W")="W ?31,$$EZBLD^DIALOG($S($P(^(0),U,2)'=1:34027.2,1:34027.4),$P(^(0),U,2))" ; (|1| New)
- D DQ^DICQ
- Q
- LN ; List all new messages (Replaces LIST^XMA0A)
- D LISTALL^XMJMLN(XMDUZ,"N0")
- Q
- LP ; List all priority messages (Replaces PRIO^XMA0A)
- D LISTALL^XMJMLN(XMDUZ,"N")
- Q
- P ; Print all new messages
- ; Replaces PRINT^XMA0A
- N XMSAVE,I
- F I="XMV(","DUZ","XMDUZ","XMKMULT" S XMSAVE(I)=""
- D EN^XUTMDEVQ("PRTNEW^XMJBN",$$EZBLD^DIALOG(34501),.XMSAVE) ; MailMan: Print
- Q
- PRTNEW ; Print all new messages
- N XMSCAN,XMNEWPRT,XMFIRST
- S (XMSCAN,XMNEWPRT,XMFIRST)=1
- D R
- I $D(ZTQUEUED),$D(^XTMP("XM","MAKENEW",XMDUZ)) D NEWAGAIN^XMJBN1(XMDUZ)
- Q
- Q ; Quit
- S XMABORT=1
- Q
- S ; Scan all new messages
- N XMSCAN
- S XMSCAN=1
- D R
- Q
- R ; Read new mail by basket, priority first.
- N XMTYPE,XMK,XMKN,XMZ,XMIA,XMKPRI
- S XMABORT=0 ; (required when printing new messages)
- S XMIA='$D(ZTQUEUED)
- S XMKPRI=0,(XMKN,XMKPRI("XMKN"))="" K ^TMP("XM",$J,"APX")
- F D Q:'$D(^XMB(3.7,XMDUZ,"N0"))!XMABORT
- . S XMTYPE=$S($D(^XMB(3.7,XMDUZ,"N")):"N",$D(^XMB(3.7,XMDUZ,"N0")):"N0",1:"")
- . I XMTYPE="" S XMABORT=1 W:'$D(ZTQUEUED) !,$$EZBLD^DIALOG(34017) Q ; You have no new messages.
- . I 'XMKMULT D
- . . S XMK=$O(^XMB(3.7,XMDUZ,XMTYPE,0))
- . . S XMKN=$P(^XMB(3.7,XMDUZ,2,XMK,0),U)
- . E D Q:XMABORT
- . . D NXTBSKT^XMJBN1(XMDUZ,XMTYPE,.XMKN,.XMK,.XMKPRI) I 'XMK S XMABORT=1 Q
- . . Q:$G(XMSCAN)
- . . D ASKBSKT(XMDUZ,1,.XMK,.XMKN,.XMABORT) Q:XMABORT
- . . I XMTYPE="N",'$D(^XMB(3.7,XMDUZ,XMTYPE,XMK)) S XMTYPE="N0"
- . S XMZ=""
- . F S XMZ=$O(^XMB(3.7,XMDUZ,XMTYPE,XMK,XMZ),XMV("NEW ORDER")) Q:XMZ="" D Q:XMABORT
- . . I '$D(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)) D ADDITN^XMUT4A(XMDUZ,XMTYPE,XMK,XMZ)
- . . I $G(XMNEWPRT) D Q
- . . . D PRTMULT^XMJMP(XMDUZ,XMK,XMKN,XMZ,0,1,.XMFIRST,"",.XMABORT)
- . . . I XMDUZ'=DUZ,$$SURRCONF^XMXSEC(XMDUZ,XMZ) D Q
- . . . . D NONEW^XMXUTIL(XMDUZ,XMK,XMZ,1)
- . . . . S ^XTMP("XM","MAKENEW",XMDUZ,XMZ)=""
- . . I XMDUZ'=DUZ,'$$SURRACC^XMXSEC(XMDUZ,"",XMZ,$G(XMB(3.9,XMZ,0))) D Q
- . . . D ZSHOW^XMJERR
- . . . D WAIT^XMXUTIL
- . . . D NONEW^XMXUTIL(XMDUZ,XMK,XMZ,1)
- . . . S ^XTMP("XM","MAKENEW",XMDUZ,XMZ)=""
- . . D READNEW(XMDUZ,XMK,XMKN,XMZ,.XMABORT)
- . Q:XMABORT
- . S:$D(^XMB(3.7,XMDUZ,"N0")) XMKMULT=1
- . Q:$G(XMSCAN)!'XMKMULT
- . W !!,$$EZBLD^DIALOG($S(XMTYPE="N0":34098,1:34099),XMKN) ; Done with new/priority mail in your '|1|' Basket.
- . W:$D(^XMB(3.7,XMDUZ,"N0")) !!
- K ^TMP("XM",$J,"APX")
- Q
- READNEW(XMDUZ,XMK,XMKN,XMZ,XMABORT) ;
- N XMSECURE,XMPAKMAN,XMSECBAD ; Important 'new' - part of scramble and packman handling
- I '$D(^XMB(3.9,XMZ,0)) D ZAPIT^XMXMSGS2(XMDUZ,XMK,XMZ) Q
- D DISPMSG^XMJMP(XMDUZ,XMK,XMKN,XMZ,.XMSECBAD) Q:$G(XMSECBAD)
- D READMSG^XMJMOI($G(XMNEWS),XMDUZ,XMK,XMKN,XMZ,.XMABORT)
- Q
- ASKBSKT(XMDUZ,XMNEWMSG,XMK,XMKN,XMABORT) ;
- ; XMNEWMSG 1=Read new mail; 0=Read any mail
- N XMDIC,XMPROMPT
- S XMDIC("W")="N XMPARM S XMPARM(2)=$P(^(0),U,2),XMPARM(1)=+$P($G(^(1,0)),U,4) W ?31,$$EZBLD^DIALOG($S(XMPARM(1)'=1:$S('XMPARM(2):34026,XMPARM(2)>1:34027,1:34027.3),XMPARM(2):34027.1,1:34026.1),.XMPARM)" ; (|1| messages, |2| new)
- I XMNEWMSG D
- . S XMPROMPT=34029 ; Read NEW mail in MAIL BASKET:
- . S XMDIC("S")="I $P(^(0),U,2)"
- . S XMDIC("B")=$P(^XMB(3.7,XMDUZ,2,XMK,0),U)
- E S XMPROMPT=34028 ; Read mail in MAIL BASKET:
- D SELBSKT^XMJBU(XMDUZ,XMPROMPT,"",.XMDIC,.XMK,.XMKN)
- I XMK=U S XMABORT=1
- Q
- NPBSKT(XMDUZ) ; Return the first priority read basket that has new messages.
- ; If none has new messages, return the first priority basket.
- N XMDEFALT
- S XMDEFALT=$$BNMSGCT^XMXUTIL(XMDUZ,1)_U_1_U_$$EZBLD^DIALOG(37005) ; IN
- I '$D(^XMB(3.7,XMDUZ,2,"AP")) Q XMDEFALT
- N XMK,XMKN
- S XMKN=""
- D NXTBSKT^XMJBN1(XMDUZ,"N0",.XMKN,.XMK)
- I $D(^TMP("XM",$J,"APX")) K ^TMP("XM",$J,"APX") Q $$BNMSGCT^XMXUTIL(XMDUZ,XMK)_U_XMK_U_XMKN
- N XMI
- S (XMI,XMK)=0
- S XMI=+$O(^XMB(3.7,XMDUZ,2,"AP",XMI))
- I 'XMI Q XMDEFALT
- F S XMK=$O(^XMB(3.7,XMDUZ,2,"AP",XMI,XMK)) Q:'XMK D
- . S XMK($$BSKTNAME^XMXUTIL(XMDUZ,XMK))=XMK
- S XMKN=$O(XMK(""))
- I XMKN="" Q XMDEFALT
- S XMK=XMK(XMKN)
- Q "0^"_XMK_U_XMKN
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMJBN 6124 printed Feb 18, 2025@23:37:57 Page 2
- XMJBN ;ISC-SF/GMB-Access new mail in mailbox ;05/18/2004 08:37
- +1 ;;8.0;MailMan;**25**;Jun 28, 2002
- +2 ; Replaces ^XMA (ISC-WASH/THM/CAP)
- +3 ; Entry points used by MailMan options (not covered by DBIA):
- +4 ; NEW XMNEW - Read new messages
- NEW ;
- +1 ; XMNEW Number of new messages
- +2 ; XMKMULT 1=New msgs in multiple baskets; 0=new msgs in one basket
- +3 NEW XMABORT,XMK,XMKN,XMNEW,XMKMULT,XMNEWS
- +4 SET XMABORT=0
- +5 DO INIT^XMJBN1(XMDUZ,.XMK,.XMKN,.XMNEW,.XMKMULT,.XMABORT)
- if XMABORT
- QUIT
- +6 ; Makes 'new'd msgs drop off list 'til next time
- SET XMNEWS=1
- +7 IF XMNEW=1
- Begin DoDot:1
- +8 NEW XMZ
- +9 SET XMZ=$ORDER(^XMB(3.7,XMDUZ,"N0",XMK,""))
- +10 IF XMDUZ'=DUZ
- IF '$$SURRACC^XMXSEC(XMDUZ,"",XMZ,$GET(XMB(3.9,XMZ,0)))
- Begin DoDot:2
- +11 DO ZSHOW^XMJERR
- +12 DO WAIT^XMXUTIL
- End DoDot:2
- QUIT
- +13 IF '$DATA(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0))
- DO ADDITN^XMUT4A(XMDUZ,"N0",XMK,XMZ)
- +14 DO READNEW(XMDUZ,XMK,XMKN,XMZ)
- +15 if $DATA(^XTMP("XM","MAKENEW",XMDUZ))
- DO NEWAGAIN^XMJBN1(XMDUZ)
- End DoDot:1
- QUIT
- +16 FOR
- Begin DoDot:1
- +17 NEW XMDIR,XMOPT,XMOX,XMY
- +18 ; Select New mail option
- SET XMDIR("A")=$$EZBLD^DIALOG(34085)
- +19 ; Read new mail by basket
- DO SET^XMXSEC1("R",34086,.XMOPT,.XMOX)
- +20 ; List Baskets with new mail
- DO SET^XMXSEC1("LB",34087,.XMOPT,.XMOX)
- +21 ; List all new messages
- DO SET^XMXSEC1("LN",34088,.XMOPT,.XMOX)
- +22 ; List all priority messages
- DO SET^XMXSEC1("LP",34089,.XMOPT,.XMOX)
- +23 ; You have no new priority messages.
- IF '$DATA(^XMB(3.7,XMDUZ,"N"))
- SET XMOPT("LP","?")=$$EZBLD^DIALOG(34018)
- +24 ; Print all new messages
- DO SET^XMXSEC1("P",34090,.XMOPT,.XMOX)
- +25 ; Scan all new messages
- DO SET^XMXSEC1("S",34091,.XMOPT,.XMOX)
- +26 ; Quit
- DO SET^XMXSEC1("Q",34092,.XMOPT,.XMOX)
- +27 SET XMDIR("B")=XMOX("O",XMV("NEW OPT"))_":"_XMOPT(XMV("NEW OPT"))
- +28 SET XMDIR("??")="XM-U-R-READ NEW"
- +29 DO XMDIR^XMJDIR(.XMDIR,.XMOPT,.XMOX,.XMY,.XMABORT)
- if XMABORT
- QUIT
- +30 KILL XMOPT,XMOX,XMDIR
- +31 DO @XMY
- End DoDot:1
- if '$DATA(^XMB(3.7,XMDUZ,"N0"))!XMABORT
- QUIT
- +32 if $DATA(^XTMP("XM","MAKENEW",XMDUZ))
- DO NEWAGAIN^XMJBN1(XMDUZ)
- +33 QUIT
- LB ; List Baskets with new mail (Replaces NEW^XMA0A)
- +1 NEW DIC,D,DZ
- +2 SET DIC="^XMB(3.7,"_XMDUZ_",2,"
- +3 SET DIC(0)="AEQ"
- SET D="B"
- SET DZ="??"
- +4 SET DIC("S")="I $P(^(0),U,2)"
- +5 ; (|1| New)
- SET DIC("W")="W ?31,$$EZBLD^DIALOG($S($P(^(0),U,2)'=1:34027.2,1:34027.4),$P(^(0),U,2))"
- +6 DO DQ^DICQ
- +7 QUIT
- LN ; List all new messages (Replaces LIST^XMA0A)
- +1 DO LISTALL^XMJMLN(XMDUZ,"N0")
- +2 QUIT
- LP ; List all priority messages (Replaces PRIO^XMA0A)
- +1 DO LISTALL^XMJMLN(XMDUZ,"N")
- +2 QUIT
- P ; Print all new messages
- +1 ; Replaces PRINT^XMA0A
- +2 NEW XMSAVE,I
- +3 FOR I="XMV(","DUZ","XMDUZ","XMKMULT"
- SET XMSAVE(I)=""
- +4 ; MailMan: Print
- DO EN^XUTMDEVQ("PRTNEW^XMJBN",$$EZBLD^DIALOG(34501),.XMSAVE)
- +5 QUIT
- PRTNEW ; Print all new messages
- +1 NEW XMSCAN,XMNEWPRT,XMFIRST
- +2 SET (XMSCAN,XMNEWPRT,XMFIRST)=1
- +3 DO R
- +4 IF $DATA(ZTQUEUED)
- IF $DATA(^XTMP("XM","MAKENEW",XMDUZ))
- DO NEWAGAIN^XMJBN1(XMDUZ)
- +5 QUIT
- Q ; Quit
- +1 SET XMABORT=1
- +2 QUIT
- S ; Scan all new messages
- +1 NEW XMSCAN
- +2 SET XMSCAN=1
- +3 DO R
- +4 QUIT
- R ; Read new mail by basket, priority first.
- +1 NEW XMTYPE,XMK,XMKN,XMZ,XMIA,XMKPRI
- +2 ; (required when printing new messages)
- SET XMABORT=0
- +3 SET XMIA='$DATA(ZTQUEUED)
- +4 SET XMKPRI=0
- SET (XMKN,XMKPRI("XMKN"))=""
- KILL ^TMP("XM",$JOB,"APX")
- +5 FOR
- Begin DoDot:1
- +6 SET XMTYPE=$SELECT($DATA(^XMB(3.7,XMDUZ,"N")):"N",$DATA(^XMB(3.7,XMDUZ,"N0")):"N0",1:"")
- +7 ; You have no new messages.
- IF XMTYPE=""
- SET XMABORT=1
- if '$DATA(ZTQUEUED)
- WRITE !,$$EZBLD^DIALOG(34017)
- QUIT
- +8 IF 'XMKMULT
- Begin DoDot:2
- +9 SET XMK=$ORDER(^XMB(3.7,XMDUZ,XMTYPE,0))
- +10 SET XMKN=$PIECE(^XMB(3.7,XMDUZ,2,XMK,0),U)
- End DoDot:2
- +11 IF '$TEST
- Begin DoDot:2
- +12 DO NXTBSKT^XMJBN1(XMDUZ,XMTYPE,.XMKN,.XMK,.XMKPRI)
- IF 'XMK
- SET XMABORT=1
- QUIT
- +13 if $GET(XMSCAN)
- QUIT
- +14 DO ASKBSKT(XMDUZ,1,.XMK,.XMKN,.XMABORT)
- if XMABORT
- QUIT
- +15 IF XMTYPE="N"
- IF '$DATA(^XMB(3.7,XMDUZ,XMTYPE,XMK))
- SET XMTYPE="N0"
- End DoDot:2
- if XMABORT
- QUIT
- +16 SET XMZ=""
- +17 FOR
- SET XMZ=$ORDER(^XMB(3.7,XMDUZ,XMTYPE,XMK,XMZ),XMV("NEW ORDER"))
- if XMZ=""
- QUIT
- Begin DoDot:2
- +18 IF '$DATA(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0))
- DO ADDITN^XMUT4A(XMDUZ,XMTYPE,XMK,XMZ)
- +19 IF $GET(XMNEWPRT)
- Begin DoDot:3
- +20 DO PRTMULT^XMJMP(XMDUZ,XMK,XMKN,XMZ,0,1,.XMFIRST,"",.XMABORT)
- +21 IF XMDUZ'=DUZ
- IF $$SURRCONF^XMXSEC(XMDUZ,XMZ)
- Begin DoDot:4
- +22 DO NONEW^XMXUTIL(XMDUZ,XMK,XMZ,1)
- +23 SET ^XTMP("XM","MAKENEW",XMDUZ,XMZ)=""
- End DoDot:4
- QUIT
- End DoDot:3
- QUIT
- +24 IF XMDUZ'=DUZ
- IF '$$SURRACC^XMXSEC(XMDUZ,"",XMZ,$GET(XMB(3.9,XMZ,0)))
- Begin DoDot:3
- +25 DO ZSHOW^XMJERR
- +26 DO WAIT^XMXUTIL
- +27 DO NONEW^XMXUTIL(XMDUZ,XMK,XMZ,1)
- +28 SET ^XTMP("XM","MAKENEW",XMDUZ,XMZ)=""
- End DoDot:3
- QUIT
- +29 DO READNEW(XMDUZ,XMK,XMKN,XMZ,.XMABORT)
- End DoDot:2
- if XMABORT
- QUIT
- +30 if XMABORT
- QUIT
- +31 if $DATA(^XMB(3.7,XMDUZ,"N0"))
- SET XMKMULT=1
- +32 if $GET(XMSCAN)!'XMKMULT
- QUIT
- +33 ; Done with new/priority mail in your '|1|' Basket.
- WRITE !!,$$EZBLD^DIALOG($SELECT(XMTYPE="N0":34098,1:34099),XMKN)
- +34 if $DATA(^XMB(3.7,XMDUZ,"N0"))
- WRITE !!
- End DoDot:1
- if '$DATA(^XMB(3.7,XMDUZ,"N0"))!XMABORT
- QUIT
- +35 KILL ^TMP("XM",$JOB,"APX")
- +36 QUIT
- READNEW(XMDUZ,XMK,XMKN,XMZ,XMABORT) ;
- +1 ; Important 'new' - part of scramble and packman handling
- NEW XMSECURE,XMPAKMAN,XMSECBAD
- +2 IF '$DATA(^XMB(3.9,XMZ,0))
- DO ZAPIT^XMXMSGS2(XMDUZ,XMK,XMZ)
- QUIT
- +3 DO DISPMSG^XMJMP(XMDUZ,XMK,XMKN,XMZ,.XMSECBAD)
- if $GET(XMSECBAD)
- QUIT
- +4 DO READMSG^XMJMOI($GET(XMNEWS),XMDUZ,XMK,XMKN,XMZ,.XMABORT)
- +5 QUIT
- ASKBSKT(XMDUZ,XMNEWMSG,XMK,XMKN,XMABORT) ;
- +1 ; XMNEWMSG 1=Read new mail; 0=Read any mail
- +2 NEW XMDIC,XMPROMPT
- +3 ; (|1| messages, |2| new)
- SET XMDIC("W")="N XMPARM S XMPARM(2)=$P(^(0),U,2),XMPARM(1)=+$P($G(^(1,0)),U,4) W ?31,$$EZBLD^DIALOG($S(XMPARM(1)'=1:$S('XMPARM(2):34026,XMPARM(2)>1:34027,1:34027.3),XMPARM(2):34027.1,1:34026.1),.XMPARM)"
- +4 IF XMNEWMSG
- Begin DoDot:1
- +5 ; Read NEW mail in MAIL BASKET:
- SET XMPROMPT=34029
- +6 SET XMDIC("S")="I $P(^(0),U,2)"
- +7 SET XMDIC("B")=$PIECE(^XMB(3.7,XMDUZ,2,XMK,0),U)
- End DoDot:1
- +8 ; Read mail in MAIL BASKET:
- IF '$TEST
- SET XMPROMPT=34028
- +9 DO SELBSKT^XMJBU(XMDUZ,XMPROMPT,"",.XMDIC,.XMK,.XMKN)
- +10 IF XMK=U
- SET XMABORT=1
- +11 QUIT
- NPBSKT(XMDUZ) ; Return the first priority read basket that has new messages.
- +1 ; If none has new messages, return the first priority basket.
- +2 NEW XMDEFALT
- +3 ; IN
- SET XMDEFALT=$$BNMSGCT^XMXUTIL(XMDUZ,1)_U_1_U_$$EZBLD^DIALOG(37005)
- +4 IF '$DATA(^XMB(3.7,XMDUZ,2,"AP"))
- QUIT XMDEFALT
- +5 NEW XMK,XMKN
- +6 SET XMKN=""
- +7 DO NXTBSKT^XMJBN1(XMDUZ,"N0",.XMKN,.XMK)
- +8 IF $DATA(^TMP("XM",$JOB,"APX"))
- KILL ^TMP("XM",$JOB,"APX")
- QUIT $$BNMSGCT^XMXUTIL(XMDUZ,XMK)_U_XMK_U_XMKN
- +9 NEW XMI
- +10 SET (XMI,XMK)=0
- +11 SET XMI=+$ORDER(^XMB(3.7,XMDUZ,2,"AP",XMI))
- +12 IF 'XMI
- QUIT XMDEFALT
- +13 FOR
- SET XMK=$ORDER(^XMB(3.7,XMDUZ,2,"AP",XMI,XMK))
- if 'XMK
- QUIT
- Begin DoDot:1
- +14 SET XMK($$BSKTNAME^XMXUTIL(XMDUZ,XMK))=XMK
- End DoDot:1
- +15 SET XMKN=$ORDER(XMK(""))
- +16 IF XMKN=""
- QUIT XMDEFALT
- +17 SET XMK=XMK(XMKN)
- +18 QUIT "0^"_XMK_U_XMKN