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

BLRF44DR.m

Go to the documentation of this file. 
  1. BLRF44DR ; IHS/MSC/MKK - Hospital Locations (# 44) File Duplicate Abbreviation(s) Report ;   [ February 29, 2012 8:00 AM ]
  1.  ;;5.2;IHS LABORATORY;**1031**;NOV 01, 1997
  1.  ;
  1. EEP ; EP - Ersatz Entry Point
  1.  D EEP^BLRGMENU
  1.  Q
  1.  ;
  1. PEP ; EP 
  1. EP ; EP 
  1.  NEW ABBREV,BLRVERN,CNT,CURUCI,IEN,IEN2
  1.  NEW HD1,HEADER,LINES,MAXLINES,PG,QFLG
  1.  ;
  1.  Q:$$INITVARS()="Q"
  1.  D REPORT
  1.  ;
  1.  Q
  1.  ;
  1. INITVARS() ; EP
  1.  S BLRVERN=$$TRIM^XLFSTR($P($T(+1),";"),"R"," ")
  1.  ;
  1.  S HEADER(1)="Hospital Location (# 44) File"
  1.  S HEADER(2)="Duplicate Abbreviation Report"
  1.  S HEADER(3)=" "
  1.  ;
  1.  D HEADERDT^BLRGMENU
  1.  D ^%ZIS
  1.  I POP D  Q "Q"
  1.  . W !,?4,"Device Not Available. Routine Ends.",!!
  1.  . D PRESSKEY^BLRGMENU(9)
  1.  U IO
  1.  ;
  1.  I IOST["C-VT" D HEADONE2^BLRLUAC2(.HD1)  W !
  1.  ;
  1.  S MAXLINES=IOSL-4
  1.  S LINES=MAXLINES+10
  1.  S HEADER(4)=$TR($$CJ^XLFSTR("@HOSPITAL@LOCATION@",51)," @","= ")
  1.  S $E(HEADER(4),55)=$TR($$CJ^XLFSTR("@INSTITUTION@",26)," @","= ")
  1.  S HEADER(5)="IEN"
  1.  S $E(HEADER(5),10)="Description"
  1.  S $E(HEADER(5),45)="Abbrev"
  1.  S $E(HEADER(5),55)="IEN"
  1.  S $E(HEADER(5),65)="Description"
  1.  ;
  1.  S (CNT,PG)=0,QFLG="NO"
  1.  ;
  1.  Q "OK"
  1.  ;
  1. REPORT ; EP
  1.  S ABBREV=""
  1.  F  S ABBREV=$O(^SC("C",ABBREV))  Q:ABBREV=""!(QFLG="Q")  D
  1.  . S IEN=0
  1.  . S IEN=+$O(^SC("C",ABBREV,IEN))
  1.  . S IEN2=+$O(^SC("C",ABBREV,IEN))
  1.  . Q:IEN2<1
  1.  . ;
  1.  . D DUPLINE    ; There are duplicates
  1.  ;
  1.  W:QFLG'="Q" !!,?4,"Number of Distinct Duplicate Abbreviations = ",CNT,!
  1.  ;
  1.  D ^%ZISC
  1.  ;
  1.  D:QFLG'="Q"&(IOST["VT") PRESSKEY^BLRGMENU(4)
  1.  ;
  1.  Q
  1.  ;
  1. DUPLINE ; EP
  1.  S:CNT<1 CNT=CNT+1
  1.  S:$L($TR(ABBREV," ")) CNT=CNT+1
  1.  S IEN=0
  1.  F  S IEN=$O(^SC("C",ABBREV,IEN))  Q:IEN<1!(QFLG="Q")  D
  1.  . I LINES>MAXLINES D HEADERPG^BLRGMENU(.PG,.QFLG,HD1)  Q:QFLG="Q"
  1.  . W IEN
  1.  . W ?9,$E($P($G(^SC(IEN,0)),"^"),1,38)
  1.  . W ?44,$S($L($TR(ABBREV," "))>0:ABBREV,1:"<BLANK>")
  1.  . W ?54,$P($G(^SC(IEN,0)),"^",4)
  1.  . W ?64,$E($P($G(^DIC(4,+$P($G(^SC(IEN,0)),"^",4),0)),"^"),1,16)
  1.  . W !
  1.  . S LINES=LINES+1
  1.  Q
  1.  ;
  1. HEADONE(HD1) ; EP -- Asks if user wants only 1 header line
  1.  D ^XBFMK
  1.  S DIR("A")="One Header Line ONLY"
  1.  S DIR("B")="NO"
  1.  S DIR(0)="YO"
  1.  D ^DIR
  1.  S HD1=$S(+$G(Y)=1:"YES",1:"NO")
  1.  Q
  1.  ;
  1. TASKREPT ; EP - Task the report
  1.  NEW BLRDUZ,IOP,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
  1.  ;
  1.  S ZTRTN="TASKIT^BLRF44DR"
  1.  S ZTDESC="BLRF44DR Tasked Compilation"
  1.  ;
  1.  M BLRDUZ=DUZ
  1.  S ZTSAVE("*")=""
  1.  S ZTDTH=$H
  1.  S ZTIO=""
  1.  S IOP="Q"
  1.  D ^%ZTLOAD
  1.  W !,?4,"Job ",ZTSK," Queued",!
  1.  D PRESSKEY^BLRGMENU(9)
  1.  Q
  1.  ;
  1. TASKIT ; EP - Tasked Report
  1.  NEW ABBREV,BLRVERN,CNT,IEN,IEN2,LINE,MMSGSTR
  1.  ;
  1.  I $D(ZTQUEUED) S ZTREQ="@"
  1.  ;
  1.  D TASKITIN
  1.  ;
  1.  S ABBREV=""
  1.  F  S ABBREV=$O(^SC("C",ABBREV))  Q:ABBREV=""  D
  1.  . S IEN=0
  1.  . S IEN=+$O(^SC("C",ABBREV,IEN))
  1.  . S IEN2=+$O(^SC("C",ABBREV,IEN))
  1.  . Q:IEN2<1
  1.  . ;
  1.  . D TASKLINE
  1.  ;
  1.  D:CNT>0 TROUBLE
  1.  ;
  1.  Q
  1.  ;
  1. TASKITIN ; EP - Tasked Initialization of variables
  1.  K MMSGSTR
  1.  ;
  1.  S MMSGSTR(1)="Duplicate Abbreviations Exist in HOSPITAL LOCATION (# 44) File."
  1.  S MMSGSTR(2)=" "
  1.  S MMSGSTR(3)="    The potential for erroneous Hospital Location statistics is high."
  1.  S MMSGSTR(4)="    Report follows:"
  1.  S MMSGSTR(5)=" "
  1.  ;
  1.  ; Header of Report
  1.  S MMSGSTR(6)=$$TRIM^XLFSTR($$CJ^XLFSTR($$LOC^XBFUNC,80),"R"," ")
  1.  S MMSGSTR(7)=$$TRIM^XLFSTR($$CJ^XLFSTR("Hospital Location (# 44) File",80),"R"," ")
  1.  S MMSGSTR(8)=$$TRIM^XLFSTR($$CJ^XLFSTR("Duplicate Abbreviation Report",80),"R"," ")
  1.  ;
  1.  S MMSGSTR(9)=" "
  1.  S MMSGSTR(10)=$TR($$CJ^XLFSTR("@HOSPITAL@LOCATION@",51)," @","= ")
  1.  S $E(MMSGSTR(10),55)=$TR($$CJ^XLFSTR("@INSTITUTION@",25)," @","= ")
  1.  S MMSGSTR(11)="IEN"
  1.  S $E(MMSGSTR(11),10)="Description"
  1.  S $E(MMSGSTR(11),45)="Abbrev"
  1.  S $E(MMSGSTR(11),55)="IEN"
  1.  S $E(MMSGSTR(11),65)="Description"
  1.  S MMSGSTR(12)=$TR($J("",IOM)," ","-")
  1.  ;
  1.  S LINE=13
  1.  ;
  1.  S CNT=0
  1.  ;
  1.  Q
  1.  ;
  1. TASKLINE ; EP
  1.  S:CNT<1 CNT=CNT+1
  1.  S:$L($TR(ABBREV," ")) CNT=CNT+1
  1.  S IEN=0
  1.  F  S IEN=$O(^SC("C",ABBREV,IEN))  Q:IEN<1  D
  1.  . S MMSGSTR(LINE)=IEN
  1.  . S $E(MMSGSTR(LINE),10)=$E($P($G(^SC(IEN,0)),"^"),1,28)
  1.  . ; S $E(MMSGSTR(LINE),40)=CNT
  1.  . S $E(MMSGSTR(LINE),45)=$S($L($TR(ABBREV," "))>0:ABBREV,1:"<BLANK>")
  1.  . S $E(MMSGSTR(LINE),55)=$P($G(^SC(IEN,0)),"^",4)
  1.  . S $E(MMSGSTR(LINE),65)=$E($P($G(^DIC(4,+$P($G(^SC(IEN,0)),"^",4),0)),"^"),1,14)
  1.  . S LINE=LINE+1
  1.  Q
  1.  ;
  1.  ;
  1. TROUBLE(WOT) ; EP - There are duplicate Abbreviations, which are trouble.  Send Alert & MailMan message.
  1.  ; D SNDALERT^BLRUTIL3(CNT_" Duplicate Abbreviations Exist in HOSPITAL LOCATION (# 44) File.")
  1.  ;
  1.  D SENDMAIL^BLRUTIL3("Duplicate Abbreviations Exist in HOSPITAL LOCATION (# 44) File",.MMSGSTR,"BLRF44DR")
  1.  Q