DG53618M ;ALB/GN/PHH - DG*5.3*618 CLEANUP UTILITES ;03/22/2005 10:39 AM
;;5.3;Registration;**618**;Aug 13, 1993
;
; Misc cleanup utilities
;
MAIL(TESTING) ; mail stats
N ACT,LACT,DFN,BTIME,HTEXT,TEXT,NAMSPC,LIN,MSGNO,DGDEL21,DGDEL12,DGTOT
N LSSN,R40831,STS,STSNAM,STAT,MTIEN,STIME
N TYPE,TYPNAM,DGDEL22,DGBADPAT,DGBADPER
N DGBAD03,X
S MSGNO=1
S NAMSPC=$$NAMSPC^DG53618,X=$G(^XTMP(NAMSPC,0,0))
S DGTOT=$P(X,U,2)
S DGDEL12=$P(X,U,3)
S BTIME=$P(X,U,4)
S STAT=$P(X,U,5)
S STIME=$P(X,U,6)
S DGDEL21=$P(X,U,7)
S DGDEL22=$P(X,U,8)
S DGBADPAT=$P(X,U,9)
S DGBADPER=$P(X,U,10)
S DGBAD03=$P(X,U,11)
;
D HDNG(.HTEXT,.MSGNO,.LIN,"S",STAT,STIME,DGDEL12,TESTING)
D SUMRY(.LIN)
D MAILIT(HTEXT)
;
D SNDDET
Q 1
;
;build heading lines for mail message
HDNG(HTEXT,MSGNO,LIN,DOS,STAT,STIME,DGDEL12,TESTING) ;
K ^TMP(NAMSPC,$J,"MSG")
S LIN=0
S HTEXT="Cleanup Dangling 408.12 records process "_STAT_" on "
S HTEXT=HTEXT_$$FMTE^XLFDT(STIME)
D BLDLINE(HTEXT,.LIN)
S TEXT=$S(DOS="S":"Summary",1:"Detail")_" Information"
S TEXT=$J("",60-$L(TEXT)\2)_TEXT
D BLDLINE(TEXT,.LIN)
S TEXT="CLEANUP OF FILE #408.12 RECORDS "_STAT_" WITH "_DGDEL12_" RECORDS DELETED!!"
S TEXT=$J("",60-$L(TEXT)\2)_TEXT
D BLDLINE(TEXT,.LIN)
D BLDLINE("",.LIN)
I TESTING D
. S TEXT="** TESTING - NO CHANGES TO DATABASE WILL BE MADE**"
. D BLDLINE(TEXT,.LIN)
. Q
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 408.12 Records Processed: " D BLDLINE2(TEXT,.LIN,DGTOT)
S TEXT=" Purged file #408.12 records: "
D BLDLINE2(TEXT,.LIN,DGDEL12)
S TEXT=" Bad or missing file #2 pointer (field #.01 or #.03): "
D BLDLINE2(TEXT,.LIN,DGBADPAT)
S TEXT=" Bad or missing file #408.13 pointer (field #.03): "
D BLDLINE2(TEXT,.LIN,DGBADPER)
S TEXT=" Null or bad variable pointer (field #.03): "
D BLDLINE2(TEXT,.LIN,DGBAD03)
S TEXT=" Purged file #408.21 records: "
D BLDLINE2(TEXT,.LIN,DGDEL21)
S TEXT=" Purged file #408.22 records: "
D BLDLINE2(TEXT,.LIN,DGDEL22)
D BLDLINE("",.LIN)
D BLDLINE("",.LIN)
D BLDLINE("",.LIN)
;
I DGDEL12 D
. D BLDLINE("Detail changes to follow in subsequent mail messages.",.LIN)
Q
;
BLDLINE2(TEXT,LIN,VAL) ;
N X
S X=TEXT_$J("",60-$L(TEXT))_$J($FN(VAL,","),11)
D BLDLINE(X,.LIN)
Q
SNDDET ;build and send detail messages limit under 2000 lines each
N DATE,ERR,MAXLIN,MORE,R12,R21,R22
S MAXLIN=1995,MORE=0
D HDNG(.HTEXT,.MSGNO,.LIN,"D",STAT,STIME,DGDEL12,TESTING)
;
S R12=""
F S R12=$O(^XTMP(NAMSPC,"BADPR",R12)) Q:R12="" D ERR
;
;print final message if any to print
D MAILIT(HTEXT):MORE
Q
;
ERR S ERR="",MORE=1
F S ERR=$O(^XTMP(NAMSPC,"BADPR",R12,"ERR",ERR)) Q:ERR="" D
. S TEXT=^XTMP(NAMSPC,"BADPR",R12,"ERR",ERR)
. I ERR=1 S TEXT="File 408.12, record "_R12_" had a bad pointer to "_TEXT
. I ERR=2 S TEXT=" "_TEXT
. D BLDLINE(TEXT,.LIN)
. ;max lines reached, print a msg
. I LIN>MAXLIN D S MORE=0
. . D MAILIT(HTEXT)
. . D HDNG(.HTEXT,.MSGNO,.LIN,"D",STAT,STIME,DGDEL12,TESTING)
. . Q
. Q
S R21=""
F S R21=$O(^XTMP(NAMSPC,"BADPR",R12,"REL",R21)) Q:R21="" D R22
Q
R22 S TEXT=" "_^XTMP(NAMSPC,"BADPR",R12,"REL",R21)
D BLDLINE(TEXT,.LIN)
I LIN>MAXLIN D S MORE=0
. D MAILIT(HTEXT)
. D HDNG(.HTEXT,.MSGNO,.LIN,"D",STAT,STIME,DGDEL12,TESTING)
. Q
S R22=""
F S R22=$O(^XTMP(NAMSPC,"BADPR",R12,"REL",R21,R22)) Q:R22="" D
. S TEXT=" "_^XTMP(NAMSPC,"BADPR",R12,"REL",R21,R22)
. D BLDLINE(TEXT,.LIN)
. I LIN>MAXLIN D S MORE=0
. . D MAILIT(HTEXT)
. . D HDNG(.HTEXT,.MSGNO,.LIN,"D",STAT,STIME,DGDEL12,TESTING)
. . Q
. Q
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 K ^TMP(NAMSPC,$J,"MSG")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53618M 4049 printed Apr 09, 2024@21:44:21 Page 2
DG53618M ;ALB/GN/PHH - DG*5.3*618 CLEANUP UTILITES ;03/22/2005 10:39 AM
+1 ;;5.3;Registration;**618**;Aug 13, 1993
+2 ;
+3 ; Misc cleanup utilities
+4 ;
MAIL(TESTING) ; mail stats
+1 NEW ACT,LACT,DFN,BTIME,HTEXT,TEXT,NAMSPC,LIN,MSGNO,DGDEL21,DGDEL12,DGTOT
+2 NEW LSSN,R40831,STS,STSNAM,STAT,MTIEN,STIME
+3 NEW TYPE,TYPNAM,DGDEL22,DGBADPAT,DGBADPER
+4 NEW DGBAD03,X
+5 SET MSGNO=1
+6 SET NAMSPC=$$NAMSPC^DG53618
SET X=$GET(^XTMP(NAMSPC,0,0))
+7 SET DGTOT=$PIECE(X,U,2)
+8 SET DGDEL12=$PIECE(X,U,3)
+9 SET BTIME=$PIECE(X,U,4)
+10 SET STAT=$PIECE(X,U,5)
+11 SET STIME=$PIECE(X,U,6)
+12 SET DGDEL21=$PIECE(X,U,7)
+13 SET DGDEL22=$PIECE(X,U,8)
+14 SET DGBADPAT=$PIECE(X,U,9)
+15 SET DGBADPER=$PIECE(X,U,10)
+16 SET DGBAD03=$PIECE(X,U,11)
+17 ;
+18 DO HDNG(.HTEXT,.MSGNO,.LIN,"S",STAT,STIME,DGDEL12,TESTING)
+19 DO SUMRY(.LIN)
+20 DO MAILIT(HTEXT)
+21 ;
+22 DO SNDDET
+23 QUIT 1
+24 ;
+25 ;build heading lines for mail message
HDNG(HTEXT,MSGNO,LIN,DOS,STAT,STIME,DGDEL12,TESTING) ;
+1 KILL ^TMP(NAMSPC,$JOB,"MSG")
+2 SET LIN=0
+3 SET HTEXT="Cleanup Dangling 408.12 records process "_STAT_" on "
+4 SET HTEXT=HTEXT_$$FMTE^XLFDT(STIME)
+5 DO BLDLINE(HTEXT,.LIN)
+6 SET TEXT=$SELECT(DOS="S":"Summary",1:"Detail")_" Information"
+7 SET TEXT=$JUSTIFY("",60-$LENGTH(TEXT)\2)_TEXT
+8 DO BLDLINE(TEXT,.LIN)
+9 SET TEXT="CLEANUP OF FILE #408.12 RECORDS "_STAT_" WITH "_DGDEL12_" RECORDS DELETED!!"
+10 SET TEXT=$JUSTIFY("",60-$LENGTH(TEXT)\2)_TEXT
+11 DO BLDLINE(TEXT,.LIN)
+12 DO BLDLINE("",.LIN)
+13 IF TESTING
Begin DoDot:1
+14 SET TEXT="** TESTING - NO CHANGES TO DATABASE WILL BE MADE**"
+15 DO BLDLINE(TEXT,.LIN)
+16 QUIT
End DoDot:1
+17 IF MSGNO
SET TEXT="Message number: "_MSGNO
DO BLDLINE(TEXT,.LIN)
+18 DO BLDLINE("",.LIN)
+19 SET MSGNO=MSGNO+1
+20 QUIT
+21 ;
SUMRY(LIN) ;build summary lines for mail message
+1 SET TEXT="Total 408.12 Records Processed: "
DO BLDLINE2(TEXT,.LIN,DGTOT)
+2 SET TEXT=" Purged file #408.12 records: "
+3 DO BLDLINE2(TEXT,.LIN,DGDEL12)
+4 SET TEXT=" Bad or missing file #2 pointer (field #.01 or #.03): "
+5 DO BLDLINE2(TEXT,.LIN,DGBADPAT)
+6 SET TEXT=" Bad or missing file #408.13 pointer (field #.03): "
+7 DO BLDLINE2(TEXT,.LIN,DGBADPER)
+8 SET TEXT=" Null or bad variable pointer (field #.03): "
+9 DO BLDLINE2(TEXT,.LIN,DGBAD03)
+10 SET TEXT=" Purged file #408.21 records: "
+11 DO BLDLINE2(TEXT,.LIN,DGDEL21)
+12 SET TEXT=" Purged file #408.22 records: "
+13 DO BLDLINE2(TEXT,.LIN,DGDEL22)
+14 DO BLDLINE("",.LIN)
+15 DO BLDLINE("",.LIN)
+16 DO BLDLINE("",.LIN)
+17 ;
+18 IF DGDEL12
Begin DoDot:1
+19 DO BLDLINE("Detail changes to follow in subsequent mail messages.",.LIN)
End DoDot:1
+20 QUIT
+21 ;
BLDLINE2(TEXT,LIN,VAL) ;
+1 NEW X
+2 SET X=TEXT_$JUSTIFY("",60-$LENGTH(TEXT))_$JUSTIFY($FNUMBER(VAL,","),11)
+3 DO BLDLINE(X,.LIN)
+4 QUIT
SNDDET ;build and send detail messages limit under 2000 lines each
+1 NEW DATE,ERR,MAXLIN,MORE,R12,R21,R22
+2 SET MAXLIN=1995
SET MORE=0
+3 DO HDNG(.HTEXT,.MSGNO,.LIN,"D",STAT,STIME,DGDEL12,TESTING)
+4 ;
+5 SET R12=""
+6 FOR
SET R12=$ORDER(^XTMP(NAMSPC,"BADPR",R12))
if R12=""
QUIT
DO ERR
+7 ;
+8 ;print final message if any to print
+9 if MORE
DO MAILIT(HTEXT)
+10 QUIT
+11 ;
ERR SET ERR=""
SET MORE=1
+1 FOR
SET ERR=$ORDER(^XTMP(NAMSPC,"BADPR",R12,"ERR",ERR))
if ERR=""
QUIT
Begin DoDot:1
+2 SET TEXT=^XTMP(NAMSPC,"BADPR",R12,"ERR",ERR)
+3 IF ERR=1
SET TEXT="File 408.12, record "_R12_" had a bad pointer to "_TEXT
+4 IF ERR=2
SET TEXT=" "_TEXT
+5 DO BLDLINE(TEXT,.LIN)
+6 ;max lines reached, print a msg
+7 IF LIN>MAXLIN
Begin DoDot:2
+8 DO MAILIT(HTEXT)
+9 DO HDNG(.HTEXT,.MSGNO,.LIN,"D",STAT,STIME,DGDEL12,TESTING)
+10 QUIT
End DoDot:2
SET MORE=0
+11 QUIT
End DoDot:1
+12 SET R21=""
+13 FOR
SET R21=$ORDER(^XTMP(NAMSPC,"BADPR",R12,"REL",R21))
if R21=""
QUIT
DO R22
+14 QUIT
R22 SET TEXT=" "_^XTMP(NAMSPC,"BADPR",R12,"REL",R21)
+1 DO BLDLINE(TEXT,.LIN)
+2 IF LIN>MAXLIN
Begin DoDot:1
+3 DO MAILIT(HTEXT)
+4 DO HDNG(.HTEXT,.MSGNO,.LIN,"D",STAT,STIME,DGDEL12,TESTING)
+5 QUIT
End DoDot:1
SET MORE=0
+6 SET R22=""
+7 FOR
SET R22=$ORDER(^XTMP(NAMSPC,"BADPR",R12,"REL",R21,R22))
if R22=""
QUIT
Begin DoDot:1
+8 SET TEXT=" "_^XTMP(NAMSPC,"BADPR",R12,"REL",R21,R22)
+9 DO BLDLINE(TEXT,.LIN)
+10 IF LIN>MAXLIN
Begin DoDot:2
+11 DO MAILIT(HTEXT)
+12 DO HDNG(.HTEXT,.MSGNO,.LIN,"D",STAT,STIME,DGDEL12,TESTING)
+13 QUIT
End DoDot:2
SET MORE=0
+14 QUIT
End DoDot:1
+15 QUIT
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
KILL ^TMP(NAMSPC,$JOB,"MSG")
+6 QUIT
