SCMCTMM ;ALB/REW - Patient Team Changes MailMessages ; 26 Mar 1996
;;5.3;Scheduling;**41,45,87,100,130,177**;AUG 13, 1993
;1
MAIL ;Do Patient Team Changes MailMan Message
; - called by SCMC PT TEAM CHANGES MAIL MESSAGE protocol
G:$G(SCNOMAIL) END ;- flag can be set to stop message generation
N XMDUZ,XMY,XMSUB,XMTEXT,VA,VAERR,XMZ,Y,SCX,ZTQUEUED
N SCTMAR,SCSTAT,DFN,SCNODE,SCY,SCSPACE,SCPAD,SCPHONE,SCB,SCE,SCB2,SCE2,SCTMDT,SCTMXM,SCPTNM,SCLNCNT
S ZTQUEUED=1
S $P(SCSPACE," ",80)=""
; SCTMAR - ARRAY OF TEAMS (before & after)
S:SCTMB4 SCTMAR(SCTMB4)=""
S:SCTMAF SCTMAR(SCTMAF)=""
IF 'SCTMAF D
.S SCSTAT="DELETED",SCB=$P(SCTMB4,U,2),SCE=$S($P(SCPTTMB4,U,9):$P(SCPTTMB4,U,9),1:DT)
IF 'SCTMB4 D
.S SCSTAT="NEW",SCB=$P(SCTMAF,U,2),SCE=$S($P(SCPTTMAF,U,9):$P(SCPTTMAF,U,9),1:DT)
IF SCTMB4&SCTMAF D
.S SCSTAT="CHANGED"
.S SCB=$P(SCTMB4,U,2),SCE=$S($P(SCPTTMB4,U,9):$P(SCPTTMB4,U,9),1:DT)
.S SCB2=$P(SCTMAF,U,2),SCE2=$S($P(SCPTTMAF,U,9):$P(SCPTTMAF,U,9),1:DT)
.S SCTMDT("BEGIN")=$S(SCB<SCB2:SCB,1:SCB2)
.S SCTMDT("END")=$S(SCE>SCE2:SCE,1:SCE2)
.S SCTMDT("INCL")=0
IF SCSTAT="NEW"!(SCSTAT="DELETED") D
.S SCTMDT("BEGIN")=SCB
.S SCTMDT("END")=SCE
.S SCTMDT("INCL")=0
S DFN=$S(SCSTAT="DELETED":+SCPTTMB4,1:+SCPTTMAF)
;set xmy array for practitioners in positions receiving tmchg notices
G:'$$PCMMXMY^SCAPMC25(3,DFN,"SCTMAR","SCTMDT",0) END
D:'$G(DGQUIET) EN^DDIOL("Sending "_SCSTAT_" Patient-Team Assignment Message")
D PID^VADPT6
S SCPTNM=$P(^DPT(DFN,0),U,1)
S XMSUB=SCSTAT_" PATIENT-TEAM ASSIGNMENT for Patient ("_$E(SCPTNM,1)_$G(VA("BID"))_")",XMTEXT="^TMP($J,""SCTMXM"",",SCLNCNT=0
IF SCSTAT="NEW" D
.D SETLN("Current Patient Team Data:")
.D SETLN("==========================")
.F SCX=1:1:14 D
..D SETLN($$TEXT(404.42,SCPTTMAF,SCX,SCSPACE,1))
IF SCSTAT="DELETED" D
.D SETLN("Previous Patient Team Data:")
.D SETLN("===========================")
.F SCX=1:1:14 S SCFLD=SCX*.01 D
..D SETLN($$TEXT(404.42,SCPTTMB4,SCX,SCSPACE,1))
IF SCSTAT="CHANGED" D
.D SETLN("Fields: "_$E(SCSPACE,1,15)_"Previous Data: Current Patient Data:")
.D SETLN("=======================================================================")
.F SCX=1:1:14 S SCFLD=SCX*.01 D
..N SCLAB2,SCY,SCZ
..S SCY=$$TEXT(404.42,SCPTTMB4,SCX,SCSPACE,1)
..S:'$L(SCY) SCLAB2=2
..S SCZ=$$TEXT(404.42,SCPTTMAF,SCX,SCSPACE,+$G(SCLAB2))
..D:$L(SCY)!($L(SCZ)) SETLN(SCY_$E(SCSPACE,1,(50-$L(SCY)))_SCZ)
S SCLNCNT=$$PCMAIL^SCMCMM(DFN,"^TMP($J,""SCTMXM"")",DT)
S XMDUZ=$G(DUZ,.5)
S XMY(XMDUZ)=""
D ^XMD
END K ^TMP($J,"SCTMXM")
Q
;
SETLN(TEXT) ;
Q:$G(TEXT)=""
; increments SCLNCNT, adds text to sctmxm(sclncnt)
S SCLNCNT=SCLNCNT+1
S ^TMP($J,"SCTMXM",SCLNCNT)=TEXT
Q
;
TEXT(SCFILE,SCNODE,SCPC,SCSPACE,SCLAB) ;returns fldname & external value
;returns fldname & external value
; Note- Only works for non wp fields of standard numbering conventions
; SCFLILE =FILENUM
; SCNODE = 0 NODE
; SCPC = piece of node
; SCSPACE = 80 SPACES
; SCLAB = 1 if print field name
N SCX,SCINT,SCFLD
S SCX=""
S SCINT=$P(SCNODE,U,SCPC)
G:SCINT="" QTTXT
S SCFLD=SCPC*.01
;;;
IF $G(SCLAB) D
.S SCX=$$DDNAME(SCFILE,SCFLD)_":"
.S:$G(SCLAB)=1 SCX=SCX_$E(SCSPACE,1,(23-$L(SCX)))
.S:$G(SCLAB)=2 SCX=SCX_$E(SCSPACE,1,(50-$L(SCX)))
S:SCINT]"" SCX=SCX_$$EXTERNAL^DILFD(SCFILE,SCFLD,"",SCINT)
;adding SSN to the end of name for alpha 177
I $P(SCX,":",1)="PATIENT" S SCX=SCX_" ("_$G(VA("PID"))_")"
QTTXT Q SCX
;
DDNAME(FILE,FIELD) ;return the fieldname
N SCX
D FIELD^DID(FILE,FIELD,"","LABEL","SCX")
Q $G(SCX("LABEL"))
;
MAILLST(SCTM,SCFIELDA,SCDATE,SCNEWTM,SCOLDTM,SCBADTM) ;
; Input:
; SCTM - Pointer to Team File (#404.51)
; SCFIELDA - Field array with internal values
; SCDATE - Effective Date
; SCNEWTM - DFN array of newly assigned to team
; SCOLDTM - DFN array of previously assigned to team
; SCBADTM - DFN array of patients unassignable to team
;
G:$G(SCNOMAIL) QTMULT ;- flag can be set to stop message generation
G:'$D(SCNEWTM) QTMULT
G:'$O(@SCNEWTM@(0)) QTMULT ;if no new assignments
N XMDUZ,XMY,XMSUB,XMTEXT,VA,VAERR,XMZ,Y,ZTQUEUED
N SCTMNM,DFN,SCOK,SCPTNM,SCFLD,SCNODE,SCNDX,SCSPACE,SCE,SCB,SCTMDT,SCDELTEM
S ZTQUEUED=1
S SCDELTEM=1 ;ok to delete tmp global
IF $D(SCFIELDA) D
.IF $D(SCFIELDA(.02)) S SCB=SCFIELDA(.02)
.IF $D(SCFIELDA(.09)) S SCE=SCFIELDA(.09)
S SCB=$G(SCB,DT)
S SCE=$G(SCE,DT)
S $P(SCSPACE," ",80)=""
S SCTMDT("BEGIN")=$S(SCB<SCDATE:SCB,1:SCDATE)
S SCTMDT("END")=$S(SCE>SCDATE:SCE,1:SCDATE)
S SCTMDT("INCL")=0
S SCTMNM=$P($G(^SCTM(404.51,+SCTM,0)),U,1)
S XMSUB="Multiple PATIENT-TEAM ASSIGNMENT for "_SCTMNM,XMTEXT="^TMP($J,""SCTMXM"",",SCLNCNT=0
D:'$G(DGQUIET) EN^DDIOL("Sending Multiple Patient-Team Assignment Message")
S SCOK=1
S SCTMNM=$P($G(^SCTM(404.51,+SCTM,0)),U,1)
D SETLN("Team: "_SCTMNM)
S Y=SCDATE X ^DD("DD")
D SETLN("Effective Date: "_Y)
D SETLN(" ")
IF $D(SCFIELDA) D
.F SCNDX=1:1:14 S SCFLD=SCNDX*.01 IF $D(SCFIELDA(SCFLD)) D
..S $P(SCNODE,U,SCNDX)=SCFIELDA(SCFLD)
..D SETLN($$TEXT(404.42,SCNODE,SCNDX,SCSPACE,1))
D SETLN(" ")
D SETLN("There has been a new team assignment for the following patients:")
S DFN=0
F S DFN=$O(@SCNEWTM@(DFN)) Q:'DFN D
.S:$$PCMMXMY^SCAPMC25(3,DFN,,"SCTMDT",0) SCOK=0
.D PID^VADPT6
.S SCPTNM=$P(^DPT(DFN,0),U,1)
.S ^TMP("SCTM MAIL LST",$J,SCTM,1,DFN)=(" "_SCPTNM_" ("_$G(VA("PID"))_")")
.S ^TMP("SCTM MAIL LST",$J,SCTM,1,"B",SCPTNM,DFN)=""
S SCPTNM=""
F S SCPTNM=$O(^TMP("SCTM MAIL LST",$J,SCTM,1,"B",SCPTNM)) Q:SCPTNM']"" D
.S DFN=0
.F S DFN=$O(^TMP("SCTM MAIL LST",$J,SCTM,1,"B",SCPTNM,DFN)) Q:'DFN D
..S SCDETAIL=$G(^TMP("SCTM MAIL LST",$J,SCTM,1,DFN)) Q:SCDETAIL']"" D SETLN(SCDETAIL)
BAD IF $S('$D(SCBADTM):0,1:$O(@SCBADTM@(0))) D
.D SETLN(" ")
.D SETLN("There has been NO new team assignment for the following patients:")
.S DFN=0
.F S DFN=$O(@SCBADTM@(DFN)) Q:'DFN D
..S:$$PCMMXMY^SCAPMC25(3,DFN,,"SCTMDT",0) SCOK=0
..S SCPTNM=$P(^DPT(DFN,0),U,1)
..D PID^VADPT6
..S ^TMP("SCTM MAIL LST",$J,SCTM,2,DFN)=(" "_SCPTNM_" ("_$G(VA("PID"))_")")
..S ^TMP("SCTM MAIL LST",$J,SCTM,2,"B",SCPTNM,DFN)=""
.S SCPTNM=""
.F S SCPTNM=$O(^TMP("SCTM MAIL LST",$J,SCTM,2,"B",SCPTNM)) Q:SCPTNM']"" D
..S DFN=0
..F S DFN=$O(^TMP("SCTM MAIL LST",$J,SCTM,2,"B",SCPTNM,DFN)) Q:'DFN D
...S SCDETAIL=$G(^TMP("SCTM MAIL LST",$J,SCTM,2,DFN)) Q:SCDETAIL']"" D SETLN(SCDETAIL)
S XMDUZ=$G(DUZ,.5)
D ^XMD
QTMULT K:$G(SCDELTEM) ^TMP("SCTM MAIL LST",$J,SCTM)
K ^TMP($J,"SCTMXM")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMCTMM 6660 printed Nov 22, 2024@17:51:19 Page 2
SCMCTMM ;ALB/REW - Patient Team Changes MailMessages ; 26 Mar 1996
+1 ;;5.3;Scheduling;**41,45,87,100,130,177**;AUG 13, 1993
+2 ;1
MAIL ;Do Patient Team Changes MailMan Message
+1 ; - called by SCMC PT TEAM CHANGES MAIL MESSAGE protocol
+2 ;- flag can be set to stop message generation
if $GET(SCNOMAIL)
GOTO END
+3 NEW XMDUZ,XMY,XMSUB,XMTEXT,VA,VAERR,XMZ,Y,SCX,ZTQUEUED
+4 NEW SCTMAR,SCSTAT,DFN,SCNODE,SCY,SCSPACE,SCPAD,SCPHONE,SCB,SCE,SCB2,SCE2,SCTMDT,SCTMXM,SCPTNM,SCLNCNT
+5 SET ZTQUEUED=1
+6 SET $PIECE(SCSPACE," ",80)=""
+7 ; SCTMAR - ARRAY OF TEAMS (before & after)
+8 if SCTMB4
SET SCTMAR(SCTMB4)=""
+9 if SCTMAF
SET SCTMAR(SCTMAF)=""
+10 IF 'SCTMAF
Begin DoDot:1
+11 SET SCSTAT="DELETED"
SET SCB=$PIECE(SCTMB4,U,2)
SET SCE=$SELECT($PIECE(SCPTTMB4,U,9):$PIECE(SCPTTMB4,U,9),1:DT)
End DoDot:1
+12 IF 'SCTMB4
Begin DoDot:1
+13 SET SCSTAT="NEW"
SET SCB=$PIECE(SCTMAF,U,2)
SET SCE=$SELECT($PIECE(SCPTTMAF,U,9):$PIECE(SCPTTMAF,U,9),1:DT)
End DoDot:1
+14 IF SCTMB4&SCTMAF
Begin DoDot:1
+15 SET SCSTAT="CHANGED"
+16 SET SCB=$PIECE(SCTMB4,U,2)
SET SCE=$SELECT($PIECE(SCPTTMB4,U,9):$PIECE(SCPTTMB4,U,9),1:DT)
+17 SET SCB2=$PIECE(SCTMAF,U,2)
SET SCE2=$SELECT($PIECE(SCPTTMAF,U,9):$PIECE(SCPTTMAF,U,9),1:DT)
+18 SET SCTMDT("BEGIN")=$SELECT(SCB<SCB2:SCB,1:SCB2)
+19 SET SCTMDT("END")=$SELECT(SCE>SCE2:SCE,1:SCE2)
+20 SET SCTMDT("INCL")=0
End DoDot:1
+21 IF SCSTAT="NEW"!(SCSTAT="DELETED")
Begin DoDot:1
+22 SET SCTMDT("BEGIN")=SCB
+23 SET SCTMDT("END")=SCE
+24 SET SCTMDT("INCL")=0
End DoDot:1
+25 SET DFN=$SELECT(SCSTAT="DELETED":+SCPTTMB4,1:+SCPTTMAF)
+26 ;set xmy array for practitioners in positions receiving tmchg notices
+27 if '$$PCMMXMY^SCAPMC25(3,DFN,"SCTMAR","SCTMDT",0)
GOTO END
+28 if '$GET(DGQUIET)
DO EN^DDIOL("Sending "_SCSTAT_" Patient-Team Assignment Message")
+29 DO PID^VADPT6
+30 SET SCPTNM=$PIECE(^DPT(DFN,0),U,1)
+31 SET XMSUB=SCSTAT_" PATIENT-TEAM ASSIGNMENT for Patient ("_$EXTRACT(SCPTNM,1)_$GET(VA("BID"))_")"
SET XMTEXT="^TMP($J,""SCTMXM"","
SET SCLNCNT=0
+32 IF SCSTAT="NEW"
Begin DoDot:1
+33 DO SETLN("Current Patient Team Data:")
+34 DO SETLN("==========================")
+35 FOR SCX=1:1:14
Begin DoDot:2
+36 DO SETLN($$TEXT(404.42,SCPTTMAF,SCX,SCSPACE,1))
End DoDot:2
End DoDot:1
+37 IF SCSTAT="DELETED"
Begin DoDot:1
+38 DO SETLN("Previous Patient Team Data:")
+39 DO SETLN("===========================")
+40 FOR SCX=1:1:14
SET SCFLD=SCX*.01
Begin DoDot:2
+41 DO SETLN($$TEXT(404.42,SCPTTMB4,SCX,SCSPACE,1))
End DoDot:2
End DoDot:1
+42 IF SCSTAT="CHANGED"
Begin DoDot:1
+43 DO SETLN("Fields: "_$EXTRACT(SCSPACE,1,15)_"Previous Data: Current Patient Data:")
+44 DO SETLN("=======================================================================")
+45 FOR SCX=1:1:14
SET SCFLD=SCX*.01
Begin DoDot:2
+46 NEW SCLAB2,SCY,SCZ
+47 SET SCY=$$TEXT(404.42,SCPTTMB4,SCX,SCSPACE,1)
+48 if '$LENGTH(SCY)
SET SCLAB2=2
+49 SET SCZ=$$TEXT(404.42,SCPTTMAF,SCX,SCSPACE,+$GET(SCLAB2))
+50 if $LENGTH(SCY)!($LENGTH(SCZ))
DO SETLN(SCY_$EXTRACT(SCSPACE,1,(50-$LENGTH(SCY)))_SCZ)
End DoDot:2
End DoDot:1
+51 SET SCLNCNT=$$PCMAIL^SCMCMM(DFN,"^TMP($J,""SCTMXM"")",DT)
+52 SET XMDUZ=$GET(DUZ,.5)
+53 SET XMY(XMDUZ)=""
+54 DO ^XMD
END KILL ^TMP($JOB,"SCTMXM")
+1 QUIT
+2 ;
SETLN(TEXT) ;
+1 if $GET(TEXT)=""
QUIT
+2 ; increments SCLNCNT, adds text to sctmxm(sclncnt)
+3 SET SCLNCNT=SCLNCNT+1
+4 SET ^TMP($JOB,"SCTMXM",SCLNCNT)=TEXT
+5 QUIT
+6 ;
TEXT(SCFILE,SCNODE,SCPC,SCSPACE,SCLAB) ;returns fldname & external value
+1 ;returns fldname & external value
+2 ; Note- Only works for non wp fields of standard numbering conventions
+3 ; SCFLILE =FILENUM
+4 ; SCNODE = 0 NODE
+5 ; SCPC = piece of node
+6 ; SCSPACE = 80 SPACES
+7 ; SCLAB = 1 if print field name
+8 NEW SCX,SCINT,SCFLD
+9 SET SCX=""
+10 SET SCINT=$PIECE(SCNODE,U,SCPC)
+11 if SCINT=""
GOTO QTTXT
+12 SET SCFLD=SCPC*.01
+13 ;;;
+14 IF $GET(SCLAB)
Begin DoDot:1
+15 SET SCX=$$DDNAME(SCFILE,SCFLD)_":"
+16 if $GET(SCLAB)=1
SET SCX=SCX_$EXTRACT(SCSPACE,1,(23-$LENGTH(SCX)))
+17 if $GET(SCLAB)=2
SET SCX=SCX_$EXTRACT(SCSPACE,1,(50-$LENGTH(SCX)))
End DoDot:1
+18 if SCINT]""
SET SCX=SCX_$$EXTERNAL^DILFD(SCFILE,SCFLD,"",SCINT)
+19 ;adding SSN to the end of name for alpha 177
+20 IF $PIECE(SCX,":",1)="PATIENT"
SET SCX=SCX_" ("_$GET(VA("PID"))_")"
QTTXT QUIT SCX
+1 ;
DDNAME(FILE,FIELD) ;return the fieldname
+1 NEW SCX
+2 DO FIELD^DID(FILE,FIELD,"","LABEL","SCX")
+3 QUIT $GET(SCX("LABEL"))
+4 ;
MAILLST(SCTM,SCFIELDA,SCDATE,SCNEWTM,SCOLDTM,SCBADTM) ;
+1 ; Input:
+2 ; SCTM - Pointer to Team File (#404.51)
+3 ; SCFIELDA - Field array with internal values
+4 ; SCDATE - Effective Date
+5 ; SCNEWTM - DFN array of newly assigned to team
+6 ; SCOLDTM - DFN array of previously assigned to team
+7 ; SCBADTM - DFN array of patients unassignable to team
+8 ;
+9 ;- flag can be set to stop message generation
if $GET(SCNOMAIL)
GOTO QTMULT
+10 if '$DATA(SCNEWTM)
GOTO QTMULT
+11 ;if no new assignments
if '$ORDER(@SCNEWTM@(0))
GOTO QTMULT
+12 NEW XMDUZ,XMY,XMSUB,XMTEXT,VA,VAERR,XMZ,Y,ZTQUEUED
+13 NEW SCTMNM,DFN,SCOK,SCPTNM,SCFLD,SCNODE,SCNDX,SCSPACE,SCE,SCB,SCTMDT,SCDELTEM
+14 SET ZTQUEUED=1
+15 ;ok to delete tmp global
SET SCDELTEM=1
+16 IF $DATA(SCFIELDA)
Begin DoDot:1
+17 IF $DATA(SCFIELDA(.02))
SET SCB=SCFIELDA(.02)
+18 IF $DATA(SCFIELDA(.09))
SET SCE=SCFIELDA(.09)
End DoDot:1
+19 SET SCB=$GET(SCB,DT)
+20 SET SCE=$GET(SCE,DT)
+21 SET $PIECE(SCSPACE," ",80)=""
+22 SET SCTMDT("BEGIN")=$SELECT(SCB<SCDATE:SCB,1:SCDATE)
+23 SET SCTMDT("END")=$SELECT(SCE>SCDATE:SCE,1:SCDATE)
+24 SET SCTMDT("INCL")=0
+25 SET SCTMNM=$PIECE($GET(^SCTM(404.51,+SCTM,0)),U,1)
+26 SET XMSUB="Multiple PATIENT-TEAM ASSIGNMENT for "_SCTMNM
SET XMTEXT="^TMP($J,""SCTMXM"","
SET SCLNCNT=0
+27 if '$GET(DGQUIET)
DO EN^DDIOL("Sending Multiple Patient-Team Assignment Message")
+28 SET SCOK=1
+29 SET SCTMNM=$PIECE($GET(^SCTM(404.51,+SCTM,0)),U,1)
+30 DO SETLN("Team: "_SCTMNM)
+31 SET Y=SCDATE
XECUTE ^DD("DD")
+32 DO SETLN("Effective Date: "_Y)
+33 DO SETLN(" ")
+34 IF $DATA(SCFIELDA)
Begin DoDot:1
+35 FOR SCNDX=1:1:14
SET SCFLD=SCNDX*.01
IF $DATA(SCFIELDA(SCFLD))
Begin DoDot:2
+36 SET $PIECE(SCNODE,U,SCNDX)=SCFIELDA(SCFLD)
+37 DO SETLN($$TEXT(404.42,SCNODE,SCNDX,SCSPACE,1))
End DoDot:2
End DoDot:1
+38 DO SETLN(" ")
+39 DO SETLN("There has been a new team assignment for the following patients:")
+40 SET DFN=0
+41 FOR
SET DFN=$ORDER(@SCNEWTM@(DFN))
if 'DFN
QUIT
Begin DoDot:1
+42 if $$PCMMXMY^SCAPMC25(3,DFN,,"SCTMDT",0)
SET SCOK=0
+43 DO PID^VADPT6
+44 SET SCPTNM=$PIECE(^DPT(DFN,0),U,1)
+45 SET ^TMP("SCTM MAIL LST",$JOB,SCTM,1,DFN)=(" "_SCPTNM_" ("_$GET(VA("PID"))_")")
+46 SET ^TMP("SCTM MAIL LST",$JOB,SCTM,1,"B",SCPTNM,DFN)=""
End DoDot:1
+47 SET SCPTNM=""
+48 FOR
SET SCPTNM=$ORDER(^TMP("SCTM MAIL LST",$JOB,SCTM,1,"B",SCPTNM))
if SCPTNM']""
QUIT
Begin DoDot:1
+49 SET DFN=0
+50 FOR
SET DFN=$ORDER(^TMP("SCTM MAIL LST",$JOB,SCTM,1,"B",SCPTNM,DFN))
if 'DFN
QUIT
Begin DoDot:2
+51 SET SCDETAIL=$GET(^TMP("SCTM MAIL LST",$JOB,SCTM,1,DFN))
if SCDETAIL']""
QUIT
DO SETLN(SCDETAIL)
End DoDot:2
End DoDot:1
BAD IF $SELECT('$DATA(SCBADTM):0,1:$ORDER(@SCBADTM@(0)))
Begin DoDot:1
+1 DO SETLN(" ")
+2 DO SETLN("There has been NO new team assignment for the following patients:")
+3 SET DFN=0
+4 FOR
SET DFN=$ORDER(@SCBADTM@(DFN))
if 'DFN
QUIT
Begin DoDot:2
+5 if $$PCMMXMY^SCAPMC25(3,DFN,,"SCTMDT",0)
SET SCOK=0
+6 SET SCPTNM=$PIECE(^DPT(DFN,0),U,1)
+7 DO PID^VADPT6
+8 SET ^TMP("SCTM MAIL LST",$JOB,SCTM,2,DFN)=(" "_SCPTNM_" ("_$GET(VA("PID"))_")")
+9 SET ^TMP("SCTM MAIL LST",$JOB,SCTM,2,"B",SCPTNM,DFN)=""
End DoDot:2
+10 SET SCPTNM=""
+11 FOR
SET SCPTNM=$ORDER(^TMP("SCTM MAIL LST",$JOB,SCTM,2,"B",SCPTNM))
if SCPTNM']""
QUIT
Begin DoDot:2
+12 SET DFN=0
+13 FOR
SET DFN=$ORDER(^TMP("SCTM MAIL LST",$JOB,SCTM,2,"B",SCPTNM,DFN))
if 'DFN
QUIT
Begin DoDot:3
+14 SET SCDETAIL=$GET(^TMP("SCTM MAIL LST",$JOB,SCTM,2,DFN))
if SCDETAIL']""
QUIT
DO SETLN(SCDETAIL)
End DoDot:3
End DoDot:2
End DoDot:1
+15 SET XMDUZ=$GET(DUZ,.5)
+16 DO ^XMD
QTMULT if $GET(SCDELTEM)
KILL ^TMP("SCTM MAIL LST",$JOB,SCTM)
+1 KILL ^TMP($JOB,"SCTMXM")
+2 QUIT
