DG53591M ;ALB/GN - DG*5.3*591 CLEANUP UTILITES ; 6/14/04 1:35pm
;;5.3;Registration;**591,1015**;Aug 13, 1993;Build 21
;
; Misc cleanup utilities
;
MAIL ; mail stats
N ACT,LACT,DFN,BTIME,HTEXT,TEXT,NAMSPC,LIN,MSGNO,IVMBAD,IVMPUR,IVMTOT
N LSSN,R40831,STS,STSNAM,STAT,MTIEN,STIME,TYPE,TYPNAM
S MSGNO=0
S NAMSPC=$$NAMSPC^DG53591
S IVMTOT=$P($G(^XTMP(NAMSPC,0,0)),U,2)
S IVMPUR=$P($G(^XTMP(NAMSPC,0,0)),U,3)
S BTIME=$P($G(^XTMP(NAMSPC,0,0)),U,4)
S STAT=$P($G(^XTMP(NAMSPC,0,0)),U,5)
S STIME=$P($G(^XTMP(NAMSPC,0,0)),U,6)
S IVMBAD=$P($G(^XTMP(NAMSPC,0,0)),U,7)
;
D HDNG(.HTEXT,.MSGNO,.LIN)
D SUMRY(.LIN)
D MAILIT(HTEXT)
;
D SNDDET
Q
;
HDNG(HTEXT,MSGNO,LIN) ;build heading lines for mail message
K ^TMP(NAMSPC,$J,"MSG")
S LIN=0
S HTEXT="Cleanup Bad Threshold Tests "_STAT_" on "
S HTEXT=HTEXT_$$FMTE^XLFDT(STIME)
D BLDLINE(HTEXT,.LIN)
D BLDLINE("",.LIN)
I TESTING S TEXT="** TESTING **" D BLDLINE(TEXT,.LIN)
I MSGNO S TEXT="Message number: "_MSGNO D BLDLINE(TEXT,.LIN)
D BLDLINE("",.LIN)
S MSGNO=MSGNO+1
Q
;
SUMRY(LIN) ;build summary lines for mail message
S TEXT=" Total Records Processed: "_$J($FN(IVMTOT,","),11)
D BLDLINE(TEXT,.LIN)
S TEXT=" Bad Threshold Tests Purged: "_$J($FN(IVMPUR,","),11)
D BLDLINE(TEXT,.LIN)
D BLDLINE("",.LIN)
D BLDLINE("",.LIN)
D BLDLINE("",.LIN)
;
I IVMPUR D
. D BLDLINE("Detail changes to follow in subsequent mail messages.",.LIN)
Q
;
SNDDET ;build and send detail messages limit under 2000 lines each
N DATE,GL,MAXLIN,MORE,NAME,SSN
S MAXLIN=1995,MORE=0
D HDNG(.HTEXT,.MSGNO,.LIN)
D BLDLINE("'*' = Delete, '**' = Delete Linked Test, '>' = Re-transmitted",.LIN)
;
S GL=$NA(^XTMP(NAMSPC,1)),LSSN=""
F S GL=$Q(@GL) Q:GL="" Q:$QS(GL,1)'=NAMSPC D
. S ACT=$QS(GL,3) Q:ACT="PNTLNK"
. S R40831=$G(@GL)
. S MORE=1 ;at least 1 more line to send
. S DFN=$QS(GL,2)
. S MTIEN=$QS(GL,5)
. S SSN=$P($G(^DPT(DFN,0)),"^",9),NAME=$P($G(^DPT(DFN,0)),"^")
. S DATE=$$FMTE^XLFDT($P(R40831,"^"))
. S STS=$P(R40831,"^",3),STSNAM=""
. S:STS]"" STSNAM=$P($G(^DG(408.32,STS,0)),"^")
. S TYPE=$P(R40831,"^",19),TYPNAM=""
. S:TYPE]"" TYPNAM=$G(^DG(408.33,TYPE,0))
. S TEXT=NAME_" ssn: "_SSN
. D:SSN'=LSSN BLDLINE(TEXT,.LIN)
. S TEXT=" "
. S:ACT="BAD" TEXT=" * "
. S:ACT="DELLNK" TEXT=" ** "
. S:ACT="GOOD" TEXT=" > "
. S TEXT=TEXT_DATE_$J(TYPNAM,24)_" "_$J(STSNAM,20)_" ien: "_MTIEN
. D BLDLINE(TEXT,.LIN)
. S LSSN=SSN,LACT=ACT
. ;max lines reached, print a msg
. I LIN>MAXLIN D S MORE=0
. . D MAILIT(HTEXT),HDNG(.HTEXT,.MSGNO,.LIN)
. . D BLDLINE("'*' = Delete, '**' = Delete Linked Test, '>' = Re-transmitted",.LIN)
;
;print final message if any to print
D MAILIT(HTEXT):MORE
Q
;
BLDLINE(TEXT,LIN) ;build a single line into TMP message global
S LIN=LIN+1
S ^TMP(NAMSPC,$J,"MSG",LIN)=TEXT
Q
MAILIT(HTEXT) ; send the mail message
N XMY,XMDUZ,XMSUB,XMTEXT
S XMY(DUZ)="",XMDUZ=.5
S XMSUB=HTEXT
S XMTEXT="^TMP(NAMSPC,$J,""MSG"","
D ^XMD
Q
DG53591M ;ALB/GN - DG*5.3*591 CLEANUP UTILITES ; 6/14/04 1:35pm
+1 ;;5.3;Registration;**591,1015**;Aug 13, 1993;Build 21
+2 ;
+3 ; Misc cleanup utilities
+4 ;
MAIL ; mail stats
+1 NEW ACT,LACT,DFN,BTIME,HTEXT,TEXT,NAMSPC,LIN,MSGNO,IVMBAD,IVMPUR,IVMTOT
+2 NEW LSSN,R40831,STS,STSNAM,STAT,MTIEN,STIME,TYPE,TYPNAM
+3 SET MSGNO=0
+4 SET NAMSPC=$$NAMSPC^DG53591
+5 SET IVMTOT=$PIECE($GET(^XTMP(NAMSPC,0,0)),U,2)
+6 SET IVMPUR=$PIECE($GET(^XTMP(NAMSPC,0,0)),U,3)
+7 SET BTIME=$PIECE($GET(^XTMP(NAMSPC,0,0)),U,4)
+8 SET STAT=$PIECE($GET(^XTMP(NAMSPC,0,0)),U,5)
+9 SET STIME=$PIECE($GET(^XTMP(NAMSPC,0,0)),U,6)
+10 SET IVMBAD=$PIECE($GET(^XTMP(NAMSPC,0,0)),U,7)
+11 ;
+12 DO HDNG(.HTEXT,.MSGNO,.LIN)
+13 DO SUMRY(.LIN)
+14 DO MAILIT(HTEXT)
+15 ;
+16 DO SNDDET
+17 QUIT
+18 ;
HDNG(HTEXT,MSGNO,LIN) ;build heading lines for mail message
+1 KILL ^TMP(NAMSPC,$JOB,"MSG")
+2 SET LIN=0
+3 SET HTEXT="Cleanup Bad Threshold Tests "_STAT_" on "
+4 SET HTEXT=HTEXT_$$FMTE^XLFDT(STIME)
+5 DO BLDLINE(HTEXT,.LIN)
+6 DO BLDLINE("",.LIN)
+7 IF TESTING
SET TEXT="** TESTING **"
DO BLDLINE(TEXT,.LIN)
+8 IF MSGNO
SET TEXT="Message number: "_MSGNO
DO BLDLINE(TEXT,.LIN)
+9 DO BLDLINE("",.LIN)
+10 SET MSGNO=MSGNO+1
+11 QUIT
+12 ;
SUMRY(LIN) ;build summary lines for mail message
+1 SET TEXT=" Total Records Processed: "_$JUSTIFY($FNUMBER(IVMTOT,","),11)
+2 DO BLDLINE(TEXT,.LIN)
+3 SET TEXT=" Bad Threshold Tests Purged: "_$JUSTIFY($FNUMBER(IVMPUR,","),11)
+4 DO BLDLINE(TEXT,.LIN)
+5 DO BLDLINE("",.LIN)
+6 DO BLDLINE("",.LIN)
+7 DO BLDLINE("",.LIN)
+8 ;
+9 IF IVMPUR
Begin DoDot:1
+10 DO BLDLINE("Detail changes to follow in subsequent mail messages.",.LIN)
End DoDot:1
+11 QUIT
+12 ;
SNDDET ;build and send detail messages limit under 2000 lines each
+1 NEW DATE,GL,MAXLIN,MORE,NAME,SSN
+2 SET MAXLIN=1995
SET MORE=0
+3 DO HDNG(.HTEXT,.MSGNO,.LIN)
+4 DO BLDLINE("'*' = Delete, '**' = Delete Linked Test, '>' = Re-transmitted",.LIN)
+5 ;
+6 SET GL=$NAME(^XTMP(NAMSPC,1))
SET LSSN=""
+7 FOR
SET GL=$QUERY(@GL)
IF GL=""
QUIT
IF $QSUBSCRIPT(GL,1)'=NAMSPC
QUIT
Begin DoDot:1
+8 SET ACT=$QSUBSCRIPT(GL,3)
IF ACT="PNTLNK"
QUIT
+9 SET R40831=$GET(@GL)
+10 ;at least 1 more line to send
SET MORE=1
+11 SET DFN=$QSUBSCRIPT(GL,2)
+12 SET MTIEN=$QSUBSCRIPT(GL,5)
+13 SET SSN=$PIECE($GET(^DPT(DFN,0)),"^",9)
SET NAME=$PIECE($GET(^DPT(DFN,0)),"^")
+14 SET DATE=$$FMTE^XLFDT($PIECE(R40831,"^"))
+15 SET STS=$PIECE(R40831,"^",3)
SET STSNAM=""
+16 IF STS]""
SET STSNAM=$PIECE($GET(^DG(408.32,STS,0)),"^")
+17 SET TYPE=$PIECE(R40831,"^",19)
SET TYPNAM=""
+18 IF TYPE]""
SET TYPNAM=$GET(^DG(408.33,TYPE,0))
+19 SET TEXT=NAME_" ssn: "_SSN
+20 IF SSN'=LSSN
DO BLDLINE(TEXT,.LIN)
+21 SET TEXT=" "
+22 IF ACT="BAD"
SET TEXT=" * "
+23 IF ACT="DELLNK"
SET TEXT=" ** "
+24 IF ACT="GOOD"
SET TEXT=" > "
+25 SET TEXT=TEXT_DATE_$JUSTIFY(TYPNAM,24)_" "_$JUSTIFY(STSNAM,20)_" ien: "_MTIEN
+26 DO BLDLINE(TEXT,.LIN)
+27 SET LSSN=SSN
SET LACT=ACT
+28 ;max lines reached, print a msg
+29 IF LIN>MAXLIN
Begin DoDot:2
+30 DO MAILIT(HTEXT)
DO HDNG(.HTEXT,.MSGNO,.LIN)
+31 DO BLDLINE("'*' = Delete, '**' = Delete Linked Test, '>' = Re-transmitted",.LIN)
End DoDot:2
SET MORE=0
End DoDot:1
+32 ;
+33 ;print final message if any to print
+34 IF MORE
DO MAILIT(HTEXT)
+35 QUIT
+36 ;
BLDLINE(TEXT,LIN) ;build a single line into TMP message global
+1 SET LIN=LIN+1
+2 SET ^TMP(NAMSPC,$JOB,"MSG",LIN)=TEXT
+3 QUIT
MAILIT(HTEXT) ; send the mail message
+1 NEW XMY,XMDUZ,XMSUB,XMTEXT
+2 SET XMY(DUZ)=""
SET XMDUZ=.5
+3 SET XMSUB=HTEXT
+4 SET XMTEXT="^TMP(NAMSPC,$J,""MSG"","
+5 DO ^XMD
+6 QUIT
