Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BLRCINDX

BLRCINDX.m

Go to the documentation of this file. 
  1. BLRCINDX ; IHS/OIT/MKK - Lab Accession File "C" Index "Orphan" Pointers Kill ;  MAY 06, 2009 9:58 AM
  1.  ;;5.2;IHS LABORATORY;**1026,1028,1031**;NOV 01, 1997
  1.  ;;
  1.  ;; Some code cloned from VA's LROC routine
  1.  ;;
  1. EP ; EP -- Entry Point
  1.  NEW BLRMMENU,BLRVERN,QFLG
  1.  ;
  1.  D SETMENU
  1.  ;
  1.  ; Main Menu driver
  1.  D MENUDRFM^BLRGMENU("IHS Lab Accession File","""C"" Index Routines")
  1.  ;
  1.  W !!
  1.  Q
  1.  ;
  1. SETMENU ; EP
  1.  S BLRVERN="BLRCINDX"
  1.  D ADDTMENU^BLRGMENU("DELOPRHE^BLRCINDX","Delete ""Orphan"" Entries")
  1.  D ADDTMENU^BLRGMENU("CIREPORT^BLRCINDX","""C"" Index Report")
  1.  D ADDTMENU^BLRGMENU("REPORT^BLRCINDX","""Orphan"" Entries Report")
  1.  Q
  1.  ;
  1. DELOPRHE ; EP -- Delete Orphan Entries in Accession File's "C" Index
  1.  NEW KCNT,LRAA,LRAD,LRAN,LRCNT,LRROOT
  1.  NEW HEADER
  1.  ;
  1.  D DELOEINI
  1.  ;
  1.  F  S UID=$O(^LRO(68,"C",UID))  Q:UID=""  D
  1.  . F  S LRAA=$O(^LRO(68,"C",UID,LRAA))  Q:LRAA<1  D
  1.  .. F  S LRAD=$O(^LRO(68,"C",UID,LRAA,LRAD))  Q:LRAD<1  D
  1.  ... F  S LRAN=$O(^LRO(68,"C",UID,LRAA,LRAD,LRAN))  Q:LRAN<1  D
  1.  .... D DELOEKLN
  1.  ;
  1.  D DELOEFIN
  1.  ;
  1.  Q
  1.  ;
  1. DELOEINI ; EP -- Delete Orphan Entries INItialization
  1.  S HEADER(1)="IHS Lab Accession File"
  1.  S HEADER(2)="""C"" Index ""Orphan"" Deletion"
  1.  D HEADERDT^BLRGMENU
  1.  ;
  1.  D DISABLE^%NOJRN             ; Disable Journalling
  1.  W ?5,"Journalling stopped for this process only.",!
  1.  W ?5,"Deleting ""Orphan"" Pointers in Accession File's ""C"" Index",!!
  1.  ;
  1.  S LRROOT="^LRO(68,""C"")"
  1.  S (KCNT,LRAA,LRAD,LRAN,LRCNT)=0
  1.  S UID=""
  1.  ;
  1.  W !,?5
  1.  Q
  1.  ;
  1. DELOEKLN ; EP -- Delete Orphan Entries Kill LiNes
  1.  S LRCNT=LRCNT+1
  1.  ;
  1.  I $X>70 W !,?5
  1.  ;
  1.  ; Accession exists, so skip this entry
  1.  I $D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) D  Q
  1.  . W:LRCNT>0&((LRCNT#1000=0)) "."
  1.  ;
  1.  K ^LRO(68,"C",UID)
  1.  S KCNT=KCNT+1
  1.  W:LRCNT>0&((LRCNT#1000=0)) "*"
  1.  Q
  1.  ;
  1. DELOEFIN ; EP - Delete Orphan Entries FINal lines
  1.  D ENABLE^%NOJRN              ; Enable Journalling again
  1.  W ?5,"Journalling restarted.",!!
  1.  ;
  1.  W ?5,"Number of Pointers in ""C"" Index = ",LRCNT,!
  1.  W ?5,"Number of ""Orphan"" Pointers deleted from ""C"" Index = ",KCNT,!
  1.  ;
  1.  D PRESSKEY()
  1.  Q
  1.  ;
  1. CIREPORT ; EP - Full "C" Index Report
  1.  NEW CNT,CNTACC,CNTKILL,CNTZERO,KCNT,LRAA,LRAD,LRAN,LRCNT
  1.  NEW OLDYEAR,LRROOT,UID,YEAR,YEARCNT
  1.  NEW DASHER,HEADER
  1.  ;
  1.  D CIRCMPLD        ; Compile the Data
  1.  D CIROUTD         ; Print the Data
  1.  Q
  1.  ;
  1. CIRCMPLD ; EP -- "C" Index Report CoMPiLe Data
  1.  D CIRCMPDI
  1.  ;
  1.  F  S UID=$O(^LRO(68,"C",UID))  Q:UID=""  D
  1.  . F  S LRAA=$O(^LRO(68,"C",UID,LRAA))  Q:LRAA<1  D
  1.  .. F  S LRAD=$O(^LRO(68,"C",UID,LRAA,LRAD))  Q:LRAD<1  D
  1.  ... F  S LRAN=$O(^LRO(68,"C",UID,LRAA,LRAD,LRAN))  Q:LRAN<1  D
  1.  .... D CIRCMPLC
  1.  ;
  1.  D CIRCMPFL
  1.  ;
  1.  Q
  1.  ;
  1. CIRCMPDI ; EP -- "C" Index Report CoMPile Data Initialization
  1.  S HEADER(1)="IHS Lab Accession File"
  1.  S HEADER(2)="""C"" Index Report"
  1.  D HEADERDT^BLRGMENU
  1.  ;
  1.  W ?5,"Compilation of ""C"" Index Data Begins",!!
  1.  ;
  1.  S LRROOT="^LRO(68,""C"")"
  1.  S (KCNT,LRAA,LRAD,LRAN,LRCNT)=0
  1.  S UID=""
  1.  ;
  1.  W ?5
  1.  Q
  1.  ;
  1. CIRCMPLC ; EP -- "C" Index Report CoMPiLation Counts
  1.  S YEAR=$P($$FMTE^XLFDT(LRAD,"6D"),"/",3)
  1.  ;
  1.  S LRCNT=LRCNT+1
  1.  ;
  1.  I $X>70 W !,?5
  1.  ;
  1.  I $D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) D  Q
  1.  . S YEARCNT(YEAR,LRAA,"VALID")=1+$G(YEARCNT(YEAR,LRAA,"VALID"))
  1.  . S:$E(UID,1,2)="00" YEARCNT(YEAR,LRAA,"VALID","00")=1+$G(YEARCNT(YEAR,LRAA,"VALID","00"))
  1.  . W:LRCNT>0&((LRCNT#1000=0)) "."
  1.  ;
  1.  S KCNT=KCNT+1
  1.  S YEARCNT(YEAR,LRAA,"ORPHAN")=1+$G(YEARCNT(YEAR,LRAA,"ORPHAN"))
  1.  S:$E(UID,1,2)="00" YEARCNT(YEAR,LRAA,"ORPHAN","00")=1+$G(YEARCNT(YEAR,LRAA,"ORPHAN","00"))
  1.  W:LRCNT>0&((LRCNT#1000=0)) "*"
  1.  Q
  1.  ;
  1. CIRCMPFL ; EP -- "C" Index Report CoMPilation data Final Lines
  1.  W !,?5,"Compilation of ""C"" Index Data Ends",!!
  1.  ;
  1.  W ?5,"Number of Pointers in ""C"" Index = ",LRCNT,!
  1.  W ?5,"Number of ""Orphan"" Pointers in ""C"" Index = ",KCNT,!
  1.  ;
  1.  D PRESSKEY()
  1.  Q
  1.  ;
  1. CIROUTD ; EP -- "C" Index Report OUTput the Data
  1.  NEW BLRMMENU,BLRVERN,HEADER
  1.  ;
  1.  D SETOMENU
  1.  ;
  1.  ; Main Menu driver
  1.  D MENUDRFM^BLRGMENU("IHS Lab Accession File","""C"" Index Routines")
  1.  ;
  1.  Q
  1.  ;
  1. SETOMENU ; EP 
  1.  D ADDTMENU^BLRGMENU("CINTERPT^BLRCINDX","Interactive ""C"" Index Report")
  1.  D ADDTMENU^BLRGMENU("REPORTPR^BLRCINDX","Print ""C"" Index Report")
  1.  Q
  1.  ;
  1. CINTERPT ; EP -- Interactive Version of the report
  1.  NEW BLRCINDX,CNT,CNTACC,CNTKILL,CNTOZERO,CNTVZERO,LINES
  1.  NEW OLDYEAR,TOPBAR,TOTZERO,YEAR
  1.  ;
  1.  S (CNT,CNTACC,CNTKILL,CNTZERO,LINES,OLDYEAR,YEAR)=0
  1.  F  S YEAR=$O(YEARCNT(YEAR))  Q:YEAR=""  D
  1.  . S LRAA=""
  1.  . F  S LRAA=$O(YEARCNT(YEAR,LRAA))  Q:LRAA=""  D
  1.  .. D CINTERPB
  1.  ;
  1.  D BROWSEIT
  1.  ;
  1.  D FINALBIT
  1.  Q
  1.  ;
  1. CINTERPB ; EP -- Interactive Version of Report -- Building Arrays
  1.  S:+$G(OLDYEAR)<1 OLDYEAR=YEAR
  1.  S CNT=CNT+1
  1.  I OLDYEAR'=YEAR&(CNT>0) S LINES=LINES+1  S BLRCINDX(LINES)=" "
  1.  S:OLDYEAR'=YEAR OLDYEAR=YEAR
  1.  S CNTKZERO=+$G(YEARCNT(YEAR,LRAA,"ORPHAN","00"))
  1.  S CNTVZERO=+$G(YEARCNT(YEAR,LRAA,"VALID","00"))
  1.  S TOTZERO=CNTVZERO+CNTKZERO
  1.  S CNTZERO=CNTZERO+TOTZERO
  1.  ;
  1.  S LINES=LINES+1
  1.  S $E(BLRCINDX(LINES),5)=YEAR
  1.  S $E(BLRCINDX(LINES),10)=LRAA
  1.  S $E(BLRCINDX(LINES),15)=$P($G(^LRO(68,LRAA,0)),"^",1)
  1.  S $E(BLRCINDX(LINES),45)=$J($G(YEARCNT(YEAR,LRAA,"VALID")),8)
  1.  S:TOTZERO>0 $E(BLRCINDX(LINES),55)=$J(TOTZERO,8)
  1.  S $E(BLRCINDX(LINES),67)=$J($G(YEARCNT(YEAR,LRAA,"ORPHAN")),8)
  1.  S CNTACC=CNTACC+$G(YEARCNT(YEAR,LRAA,"VALID"))
  1.  S CNTKILL=CNTKILL+$G(YEARCNT(YEAR,LRAA,"ORPHAN"))
  1.  Q
  1.  ;
  1. BROWSEIT ; EP -- Use Browser to display report
  1.  S HEADER(3)=" "
  1.  D HEADERDT^BLRGMENU
  1.  ;
  1.  S TOPBAR="YEAR LRAA Accession Description           # Accs  # 00 UIDs  # Orphans"
  1.  S:+$G(YEARCNT(0))<1 TOPBAR="YEAR LRAA Accession Description           # Accs             # Orphans"
  1.  D BROWSE^DDBR("BLRCINDX","N",TOPBAR,,,5,24)
  1.  ;
  1.  Q
  1.  ;
  1. FINALBIT ; EP -- Final section of interactive report
  1.  S $E(HEADER(4),45)=$J("# Accs",8)
  1.  S:CNTZERO>0 $E(HEADER(4),55)="# 00 UIDs"
  1.  S $E(HEADER(4),67)=$J("# Orphans",8)
  1.  ;
  1.  D HEADERDT^BLRGMENU
  1.  W ?14,"TOTAL"
  1.  W ?44,$J($G(CNTACC),8)
  1.  W:CNTZERO>0 ?55,$J(CNTZERO,8)
  1.  W ?67,$J($G(CNTKILL),8)
  1.  W !!
  1.  D PRESSKEY()
  1.  Q
  1.  ;
  1. REPORTPR ; EP -- Output Data
  1.  NEW CNT,CNTACC,CNTKILL,CNTOZERO,CNTVZERO,LINES,OLDYEAR,YEAR
  1.  NEW DASHER,HDR1,LINES,MAXLINES,PG,QFLG
  1.  NEW TOTLZERO
  1.  ;
  1.  D REPORTPI
  1.  ;
  1.  F  S YEAR=$O(YEARCNT(YEAR))  Q:YEAR=""!(QFLG="Q")  D
  1.  . S LRAA=""
  1.  . F  S LRAA=$O(YEARCNT(YEAR,LRAA))  Q:LRAA=""!(QFLG="Q")  D
  1.  .. D REPORTPL
  1.  ;
  1.  I QFLG'="Q" D TOTATLNE
  1.  W !!
  1.  ;
  1.  D ^%ZISC                                ; Close all the devices
  1.  ;
  1.  D PRESSKEY()
  1.  Q
  1.  ;
  1. REPORTPI ; EP -- Print Report Initialization
  1.  S HEADER(1)="IHS Lab Accession File"
  1.  S HEADER(2)="""C"" Index Report"
  1.  S HEADER(3)=" "
  1.  S $E(HEADER(4),5)="YEAR"
  1.  S $E(HEADER(4),10)="LRAA"
  1.  S $E(HEADER(4),15)="Accession Description"
  1.  S $E(HEADER(4),45)=$J("# Accs",8)
  1.  S:+$G(YEARCNT(0))>0 $E(HEADER(4),55)=$J("# 00 UIDs",8)
  1.  S $E(HEADER(4),67)=$J("# Orphans",8)
  1.  ;
  1.  S PG=0
  1.  S HDR1=0
  1.  S QFLG="NO"
  1.  ;
  1.  D ^%ZIS
  1.  I POP D
  1.  . W !!,?10,"DEVICE could not be selected.  Output will be to the screen.",!!
  1.  . D ^%ZISC
  1.  ;
  1.  S MAXLINES=IOSL-3
  1.  S LINES=MAXLINES+10
  1.  ;
  1.  U IO
  1.  S (CNT,CNTACC,CNTKILL,CNTOZERO,CNTVZERO,CNTZERO,OLDYEAR,TOTLZERO,YEAR)=0
  1.  Q
  1.  ;
  1. REPORTPL ; EP - Report Liner
  1.  S:+$G(OLDYEAR)<1 OLDYEAR=YEAR
  1.  ;
  1.  I LINES>MAXLINES D HEADERPG^BLRGMENU(.PG,.QFLG,HDR1)  I QFLG="Q" Q
  1.  ;
  1.  I OLDYEAR'=YEAR S OLDYEAR=YEAR  W:CNT>0 !
  1.  S CNT=CNT+1
  1.  ;
  1.  S CNTKZERO=+$G(YEARCNT(YEAR,LRAA,"ORPHAN","00"))
  1.  S CNTVZERO=+$G(YEARCNT(YEAR,LRAA,"VALID","00"))
  1.  S TOTLZERO=CNTKZERO+CNTVZERO
  1.  ;
  1.  W ?4,YEAR
  1.  W ?9,LRAA
  1.  W ?14,$E($P($G(^LRO(68,LRAA,0)),"^",1),1,23)
  1.  W ?44,$J($G(YEARCNT(YEAR,LRAA,"VALID")),8)
  1.  W:TOTLZERO>0 ?55,$J(TOTLZERO,8)
  1.  W ?67,$J($G(YEARCNT(YEAR,LRAA,"ORPHAN")),8)
  1.  W !
  1.  S LINES=LINES+1
  1.  ;
  1.  S CNTACC=CNTACC+$G(YEARCNT(YEAR,LRAA,"VALID"))
  1.  S CNTZERO=CNTZERO+TOTLZERO
  1.  S CNTKILL=CNTKILL+$G(YEARCNT(YEAR,LRAA,"ORPHAN"))
  1.  Q
  1.  ;
  1. TOTATLNE ; EP - Totals Line for Report
  1.  S DASHER=$TR($J("",8)," ","-")
  1.  W ?44,DASHER
  1.  W:CNTZERO>0 ?55,DASHER
  1.  W ?67,DASHER
  1.  W !
  1.  W ?14,"TOTAL"
  1.  W ?44,$J($G(CNTACC),8)
  1.  W:CNTZERO>0 ?55,$J($G(CNTZERO),8)
  1.  W ?67,$J($G(CNTKILL),8)
  1.  Q
  1.  ;
  1. REPORT ; EP -- Report on orphan "C" index entries
  1.  NEW KCNT,LRAA,LRAD,LRAN,LRCNT,LRROOT,YEARCNT
  1.  NEW HEADER
  1.  ;
  1.  D REPORTIN
  1.  ;
  1.  F  S UID=$O(^LRO(68,"C",UID))  Q:UID=""  D
  1.  . F  S LRAA=$O(^LRO(68,"C",UID,LRAA))  Q:LRAA<1  D
  1.  .. F  S LRAD=$O(^LRO(68,"C",UID,LRAA,LRAD))  Q:LRAD<1  D
  1.  ... F  S LRAN=$O(^LRO(68,"C",UID,LRAA,LRAD,LRAN))  Q:LRAN<1  D
  1.  .... D REPORTCW
  1.  ;
  1.  D REPORTFL
  1.  Q
  1.  ;
  1. REPORTIN ;  -- Report on orphan "C" index INitialization
  1.  S HEADER(1)="IHS Lab Accession File"
  1.  S HEADER(2)="""C"" Index ""Orphan"" Report"
  1.  D HEADERDT^BLRGMENU
  1.  ;
  1.  W !,?5,"Counting ""Orphan"" Pointers in Accession File's ""C"" Index",!!
  1.  ;
  1.  S LRROOT="^LRO(68,""C"")"
  1.  S (KCNT,LRAA,LRAD,LRAN,LRCNT)=0
  1.  S UID=""
  1.  ;
  1.  W ?5
  1.  Q
  1.  ;
  1. REPORTCW ; EP -- Report on orphan "C" index Counts & Warm fuzzies
  1.  S YEAR=$P($$FMTE^XLFDT(LRAD,"6D"),"/",3)
  1.  ;
  1.  I $X>70 W !,?5
  1.  S LRCNT=LRCNT+1
  1.  ;
  1.  ; Accession exists, so skip this entry
  1.  I $D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) D  Q
  1.  . S YEARCNT(YEAR,LRAA,"VALID")=1+$G(YEARCNT(YEAR,LRAA,"VALID"))
  1.  . S:$E(UID,1,2)="00" YEARCNT(YEAR,LRAA,"VALID","00")=1+$G(YEARCNT(YEAR,LRAA,"VALID","00"))
  1.  . W:LRCNT>0&((LRCNT#1000=0)) "."
  1.  ;
  1.  ; "Orphan" Entry
  1.  S KCNT=KCNT+1
  1.  S YEARCNT(YEAR,LRAA,"ORPHAN")=1+$G(YEARCNT(YEAR,LRAA,"ORPHAN"))
  1.  S:$E(UID,1,2)="00" YEARCNT(YEAR,LRAA,"ORPHAN","00")=1+$G(YEARCNT(YEAR,LRAA,"ORPHAN","00"))
  1.  W:LRCNT>0&((LRCNT#1000=0)) "*"
  1.  ;
  1.  Q
  1.  ;
  1. REPORTFL ; EP -- Report on orphan "C" index Counts Final Lines
  1.  W !,?5,"Number of Pointers in ""C"" Index = ",LRCNT,!
  1.  W ?5,"Number of ""Orphan"" Pointers in ""C"" Index = ",KCNT,!
  1.  ;
  1.  D PRESSKEY(5,"REPORT ENDS.  Press RETURN Key")
  1.  Q
  1.  ;
  1. PRESSKEY(TAB,MSGSTR) ; EP
  1.  NEW TABSTR
  1.  ;
  1.  S:+$G(TAB)<1 TAB=5
  1.  S TABSTR=$J("",+$G(TAB))_$S(+$L($G(MSGSTR)):$G(MSGSTR),1:"Press RETURN Key")
  1.  ;
  1.  W !
  1.  D ^XBFMK
  1.  S DIR(0)="E"
  1.  S DIR("A")=TABSTR
  1.  D ^DIR
  1.  I $G(DUOUT) S QFLG="Q"      ; If Fileman quit, then set Quit Flag
  1.  ;
  1.  Q
  1.  ;
  1.  ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1028
  1.  ; Silent Version of the DELOPRHE option -- Created for TaskMan Entries
  1. SILENT ; EP
  1.  NEW KCNT,LRAA,LRAD,LRAN,LRCNT,LRROOT,STOREDTT
  1.  ;
  1.  D SILENTI
  1.  ;
  1.  F  S UID=$O(^LRO(68,"C",UID))  Q:UID=""  D
  1.  . F  S LRAA=$O(^LRO(68,"C",UID,LRAA))  Q:LRAA<1  D
  1.  .. F  S LRAD=$O(^LRO(68,"C",UID,LRAA,LRAD))  Q:LRAD<1  D
  1.  ... F  S LRAN=$O(^LRO(68,"C",UID,LRAA,LRAD,LRAN))  Q:LRAN<1  D
  1.  .... D SILENTD
  1.  ;
  1.  S STOREDTT=$$NOW^XLFDT
  1.  S ^BLRCINDX(STOREDTT,LRCNT,KCNT)=""
  1.  ;
  1.  D SILENTR
  1.  ;
  1.  Q
  1.  ;
  1. SILENTI ; EP - Initialization
  1.  D DISABLE^%NOJRN
  1.  S LRROOT="^LRO(68,""C"")"
  1.  S (CNT,KCNT,LRAA,LRAD,LRAN,LRCNT)=0
  1.  S UID=""
  1.  Q
  1.  ;
  1. SILENTD ; EP - Silent Delete
  1.  S LRCNT=LRCNT+1
  1.  ;
  1.  ; Accession exists, so skip this entry
  1.  Q:$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0))
  1.  ;
  1.  K ^LRO(68,"C",UID)
  1.  S KCNT=KCNT+1
  1.  Q
  1.  ;
  1. SILENTR ; EP - Report on the Silent Deletes
  1.  NEW DATETIME,CNT1,CNT2,STR,STRLINE
  1.  NEW CNT                ; IHS/MSC/MKK - LR*5.2*1031
  1.  ;
  1.  D SILENTRI
  1.  ;
  1.  D SILENTRC
  1.  ;
  1.  Q:CNT<1           ; IHS/MSC/MKK - LR*5.2*1031 -- If latest # of Orphans = 0, don't send message
  1.  ;
  1.  D SENDMAIL("Accession File ""C"" Index ""Orphans"" Report")
  1.  ;
  1.  Q
  1.  ;
  1. SILENTRI ; EP - Initialization
  1.  S STR(1)=" "
  1.  S STR(2)=$$CJ^XLFSTR($$LOC^XBFUNC,70)
  1.  S STR(3)=" "
  1.  S $E(STR(4),45)="# of ""Orphan"""
  1.  S $E(STR(5),5)="Date/Time ^BLRCINDX Run"
  1.  S $E(STR(5),35)="# UIDs"
  1.  S $E(STR(5),45)="Deletions"
  1.  S STR(6)=$TR($J("",70)," ","-")
  1.  ;
  1.  S (DATETIME)=0
  1.  S (CNT1,CNT2)=""
  1.  S STRLINE=6
  1.  S CNT=0                                    ; IHS/MSC/MKK - LR*5.2*1031
  1.  Q
  1.  ;
  1. SILENTRC ; EP - Compilation
  1.  F  S DATETIME=$O(^BLRCINDX(DATETIME))  Q:DATETIME<1  D
  1.  . F  S CNT1=$O(^BLRCINDX(DATETIME,CNT1))  Q:CNT1=""  D
  1.  .. F  S CNT2=$O(^BLRCINDX(DATETIME,CNT1,CNT2))  Q:CNT2=""  D
  1.  ... S STRLINE=STRLINE+1
  1.  ... S $E(STR(STRLINE),5)=$$UP^XLFSTR($$FMTE^XLFDT(DATETIME,"5MPZ"))
  1.  ... S $E(STR(STRLINE),35)=CNT1
  1.  ... S $E(STR(STRLINE),45)=CNT2
  1.  ... S CNT=CNT2         ; IHS/MSC/MKK - LR*5.2*1031 - Latest # of Orphans
  1.  Q
  1.  ;
  1. SENDMAIL(MAILMSG) ; EP -- Send MailMan E-mail to all users with LRSUPER key
  1.  NEW BADUSERS,DIFROM,ERRORS,HEREYAGO,LRSUPER,WHO,WHOCNT,YEARAGO
  1.  ;
  1.  ; Get "LRSUPER" Security Key IEN
  1.  D FIND^DIC(19.1,,,,"LRSUPER",,,,,"HEREYAGO")
  1.  S LRSUPER=+$G(HEREYAGO("DILIST",2,1))
  1.  Q:LRSUPER<1
  1.  ;
  1.  S YEARAGO=$P($$HTE^XLFDT(+$H-365,"5DZ"),"/",3)    ; Get year in CCYY format from 365 Days Ago
  1.  ;
  1.  K XMY
  1.  S (WHO,WHOCNT)=0
  1.  F  S WHO=$O(^VA(200,"AB",LRSUPER,WHO))  Q:WHO<1  D
  1.  . K ERRORS,X
  1.  . ; S X=+$P($$FMTE^XLFDT($$GET1^DIQ(3.7,WHO,"LATEST MAILMAN ACCESS DATE","I",,"ERRORS"),"5DZ"),"/",3)
  1.  . ; Q:X<YEARAGO  ; Only send e-mail to those who have accessed MailMan within the past year
  1.  . ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1031
  1.  . S X=$$FMDIFF^XLFDT($$DT^XLFDT,+$$GET1^DIQ(3.7,WHO,"LATEST MAILMAN ACCESS DATE","I",,"ERRORS"),1)
  1.  . Q:X>365         ; Only send e-mail to those who have accessed MailMan within the past year
  1.  . ; ----- END IHS/MSC/MKK - LR*5.2*1031
  1.  . ;
  1.  . S XMY(WHO)=""
  1.  . D:WHOCNT<1 MAILHEAD
  1.  . S STRLINE=STRLINE+1
  1.  . S $E(STR(STRLINE),5)=WHO
  1.  . S $E(STR(STRLINE),15)=$P($G(^VA(200,WHO,0)),"^")
  1.  . S WHOCNT=WHOCNT+1
  1.  ;
  1.  S:WHOCNT<1 XMY("G.LMI")=""  ; Send to members of LMI Mail Group iff no user has LRSUPER key 
  1.  ;
  1.  S XMSUB=MAILMSG
  1.  S XMTEXT="STR("
  1.  S XMDUZ="IHS Lab Maintenance"
  1.  S XMZ="NOT OKAY"
  1.  D ^XMD
  1.  ;
  1.  I $G(XMMG)'=""!(XMZ="NOT OKAY") S ^BLRCINDX(STOREDTT,LRCNT,KCNT)="MAILMAN ERROR.^"_XMZ_"^"_XMMG
  1.  ;
  1.  K X,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,Y   ; Cleanup
  1.  Q
  1.  ;
  1. MAILHEAD ; EP - E-Mail Header
  1.  D ADDONEL(.STR,.STRLINE," ")
  1.  D ADDONEL(.STR,.STRLINE,"E-Mail sent to the following:")
  1.  D ADDONEL(.STR,.STRLINE," ")
  1.  ;
  1.  S STRLINE=STRLINE+1
  1.  S $E(STR(STRLINE),5)="File 200"
  1.  ;
  1.  S STRLINE=STRLINE+1
  1.  S $E(STR(STRLINE),5)="  IEN"
  1.  S $E(STR(STRLINE),15)="Name"
  1.  ;
  1.  S STRLINE=STRLINE+1
  1.  S $E(STR(STRLINE),5)="--------"
  1.  S $E(STR(STRLINE),15)=$TR($J("",30)," ","-")
  1.  Q
  1.  ;
  1. ADDONEL(ARRAY,LINE,STR)  ; EP - Add 1 Line
  1.  S LINE=1+$G(LINE)
  1.  S ARRAY(LINE)=STR
  1.  Q
  1.  ;
  1. SILENTRB ; EP -- Report Browser
  1.  NEW DATETIME,CNT1,CNT2,STR,STRLINE
  1.  NEW HEADER,TOPBAR
  1.  ;
  1.  S (DATETIME,STRLINE)=0
  1.  S (CNT1,CNT2)=""
  1.  D SILENTRC
  1.  ;
  1.  S HEADER(1)="IHS Lab Accession File"
  1.  S HEADER(2)="""C"" Index ""Orphan"" Deletion"
  1.  S HEADER(3)=" "
  1.  ;
  1.  S $E(TOPBAR,5)="Date/Time ^BLRCINDX Run"
  1.  S $E(TOPBAR,35)="# UIDS"
  1.  S $E(TOPBAR,45)="# of ""Orphan"" Deletions"
  1.  S TOPBAR=$$LJ^XLFSTR(TOPBAR,80)
  1.  ;
  1.  D HEADERDT^BLRGMENU
  1.  D BROWSE^DDBR("STR","N",TOPBAR,,,5,24)
  1.  ;
  1.  D PRESSKEY^BLRGMENU(5)
  1.  Q
  1.  ;
  1.  ; ----- END IHS/OIT/MKK - LR*5.2*1028