source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DG53618M.m@ 700

Last change on this file since 700 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.8 KB
RevLine 
[613]1DG53618M ;ALB/GN/PHH - DG*5.3*618 CLEANUP UTILITES ;03/22/2005 10:39 AM
2 ;;5.3;Registration;**618**;Aug 13, 1993
3 ;
4 ; Misc cleanup utilities
5 ;
6MAIL(TESTING) ; mail stats
7 N ACT,LACT,DFN,BTIME,HTEXT,TEXT,NAMSPC,LIN,MSGNO,DGDEL21,DGDEL12,DGTOT
8 N LSSN,R40831,STS,STSNAM,STAT,MTIEN,STIME
9 N TYPE,TYPNAM,DGDEL22,DGBADPAT,DGBADPER
10 N DGBAD03,X
11 S MSGNO=1
12 S NAMSPC=$$NAMSPC^DG53618,X=$G(^XTMP(NAMSPC,0,0))
13 S DGTOT=$P(X,U,2)
14 S DGDEL12=$P(X,U,3)
15 S BTIME=$P(X,U,4)
16 S STAT=$P(X,U,5)
17 S STIME=$P(X,U,6)
18 S DGDEL21=$P(X,U,7)
19 S DGDEL22=$P(X,U,8)
20 S DGBADPAT=$P(X,U,9)
21 S DGBADPER=$P(X,U,10)
22 S DGBAD03=$P(X,U,11)
23 ;
24 D HDNG(.HTEXT,.MSGNO,.LIN,"S",STAT,STIME,DGDEL12,TESTING)
25 D SUMRY(.LIN)
26 D MAILIT(HTEXT)
27 ;
28 D SNDDET
29 Q 1
30 ;
31 ;build heading lines for mail message
32HDNG(HTEXT,MSGNO,LIN,DOS,STAT,STIME,DGDEL12,TESTING) ;
33 K ^TMP(NAMSPC,$J,"MSG")
34 S LIN=0
35 S HTEXT="Cleanup Dangling 408.12 records process "_STAT_" on "
36 S HTEXT=HTEXT_$$FMTE^XLFDT(STIME)
37 D BLDLINE(HTEXT,.LIN)
38 S TEXT=$S(DOS="S":"Summary",1:"Detail")_" Information"
39 S TEXT=$J("",60-$L(TEXT)\2)_TEXT
40 D BLDLINE(TEXT,.LIN)
41 S TEXT="CLEANUP OF FILE #408.12 RECORDS "_STAT_" WITH "_DGDEL12_" RECORDS DELETED!!"
42 S TEXT=$J("",60-$L(TEXT)\2)_TEXT
43 D BLDLINE(TEXT,.LIN)
44 D BLDLINE("",.LIN)
45 I TESTING D
46 . S TEXT="** TESTING - NO CHANGES TO DATABASE WILL BE MADE**"
47 . D BLDLINE(TEXT,.LIN)
48 . Q
49 I MSGNO S TEXT="Message number: "_MSGNO D BLDLINE(TEXT,.LIN)
50 D BLDLINE("",.LIN)
51 S MSGNO=MSGNO+1
52 Q
53 ;
54SUMRY(LIN) ;build summary lines for mail message
55 S TEXT="Total 408.12 Records Processed: " D BLDLINE2(TEXT,.LIN,DGTOT)
56 S TEXT=" Purged file #408.12 records: "
57 D BLDLINE2(TEXT,.LIN,DGDEL12)
58 S TEXT=" Bad or missing file #2 pointer (field #.01 or #.03): "
59 D BLDLINE2(TEXT,.LIN,DGBADPAT)
60 S TEXT=" Bad or missing file #408.13 pointer (field #.03): "
61 D BLDLINE2(TEXT,.LIN,DGBADPER)
62 S TEXT=" Null or bad variable pointer (field #.03): "
63 D BLDLINE2(TEXT,.LIN,DGBAD03)
64 S TEXT=" Purged file #408.21 records: "
65 D BLDLINE2(TEXT,.LIN,DGDEL21)
66 S TEXT=" Purged file #408.22 records: "
67 D BLDLINE2(TEXT,.LIN,DGDEL22)
68 D BLDLINE("",.LIN)
69 D BLDLINE("",.LIN)
70 D BLDLINE("",.LIN)
71 ;
72 I DGDEL12 D
73 . D BLDLINE("Detail changes to follow in subsequent mail messages.",.LIN)
74 Q
75 ;
76BLDLINE2(TEXT,LIN,VAL) ;
77 N X
78 S X=TEXT_$J("",60-$L(TEXT))_$J($FN(VAL,","),11)
79 D BLDLINE(X,.LIN)
80 Q
81SNDDET ;build and send detail messages limit under 2000 lines each
82 N DATE,ERR,MAXLIN,MORE,R12,R21,R22
83 S MAXLIN=1995,MORE=0
84 D HDNG(.HTEXT,.MSGNO,.LIN,"D",STAT,STIME,DGDEL12,TESTING)
85 ;
86 S R12=""
87 F S R12=$O(^XTMP(NAMSPC,"BADPR",R12)) Q:R12="" D ERR
88 ;
89 ;print final message if any to print
90 D MAILIT(HTEXT):MORE
91 Q
92 ;
93ERR S ERR="",MORE=1
94 F S ERR=$O(^XTMP(NAMSPC,"BADPR",R12,"ERR",ERR)) Q:ERR="" D
95 . S TEXT=^XTMP(NAMSPC,"BADPR",R12,"ERR",ERR)
96 . I ERR=1 S TEXT="File 408.12, record "_R12_" had a bad pointer to "_TEXT
97 . I ERR=2 S TEXT=" "_TEXT
98 . D BLDLINE(TEXT,.LIN)
99 . ;max lines reached, print a msg
100 . I LIN>MAXLIN D S MORE=0
101 . . D MAILIT(HTEXT)
102 . . D HDNG(.HTEXT,.MSGNO,.LIN,"D",STAT,STIME,DGDEL12,TESTING)
103 . . Q
104 . Q
105 S R21=""
106 F S R21=$O(^XTMP(NAMSPC,"BADPR",R12,"REL",R21)) Q:R21="" D R22
107 Q
108R22 S TEXT=" "_^XTMP(NAMSPC,"BADPR",R12,"REL",R21)
109 D BLDLINE(TEXT,.LIN)
110 I LIN>MAXLIN D S MORE=0
111 . D MAILIT(HTEXT)
112 . D HDNG(.HTEXT,.MSGNO,.LIN,"D",STAT,STIME,DGDEL12,TESTING)
113 . Q
114 S R22=""
115 F S R22=$O(^XTMP(NAMSPC,"BADPR",R12,"REL",R21,R22)) Q:R22="" D
116 . S TEXT=" "_^XTMP(NAMSPC,"BADPR",R12,"REL",R21,R22)
117 . D BLDLINE(TEXT,.LIN)
118 . I LIN>MAXLIN D S MORE=0
119 . . D MAILIT(HTEXT)
120 . . D HDNG(.HTEXT,.MSGNO,.LIN,"D",STAT,STIME,DGDEL12,TESTING)
121 . . Q
122 . Q
123 Q
124BLDLINE(TEXT,LIN) ;build a single line into TMP message global
125 S LIN=LIN+1
126 S ^TMP(NAMSPC,$J,"MSG",LIN)=TEXT
127 Q
128MAILIT(HTEXT) ; send the mail message
129 N XMY,XMDUZ,XMSUB,XMTEXT
130 S XMY(DUZ)="",XMDUZ=.5
131 S XMSUB=HTEXT
132 S XMTEXT="^TMP(NAMSPC,$J,""MSG"","
133 D ^XMD K ^TMP(NAMSPC,$J,"MSG")
134 Q
Note: See TracBrowser for help on using the repository browser.