- DG53618M ;ALB/GN/PHH - DG*5.3*618 CLEANUP UTILITES ;03/22/2005 10:39 AM
- ;;5.3;Registration;**618,1015**;Aug 13, 1993;Build 21
- ;
- ; 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
- DG53618M ;ALB/GN/PHH - DG*5.3*618 CLEANUP UTILITES ;03/22/2005 10:39 AM
- +1 ;;5.3;Registration;**618,1015**;Aug 13, 1993;Build 21
- +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