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

BLRMMRPT.m

Go to the documentation of this file. 
  1. BLRMMRPT ;IHS/OIT/MKK - MICRO MNEMONICS REPORT;DEC 09, 2008 8:30 AM
  1.  ;;5.2;IHS LABORATORY;**1025**;NOV 01, 1997
  1.  ;
  1.  ; Lab Description File Abbreviation Report
  1.  ;
  1.  ; Per IHS LAB PSG - Need a report of the mnemonics/abbreviations used
  1.  ; in the MICRO reports for certification purposes.
  1.  ;
  1. EP ; EP
  1.  ; Report only on 5 SCREEN entries:
  1.  ;      C - AP CYTO
  1.  ;      F - FUNGUS
  1.  ;      M - MICRO
  1.  ;      P - PARASITE
  1.  ;      V - VIRUS
  1.  ;
  1.  ; NEW all variables to make sure nothing left "hanging around"
  1.  NEW CNT,ABBREV,EXPANSION,IEN,MICROREPORT,NAME,SCREEN,SYNONYM
  1.  NEW HEADER,HD1,LINES,MAXLINES,PG,QFLG
  1.  ;
  1.  S HEADER(1)="LAB DESCRIPTION FILE REPORT"
  1.  S HEADER(2)="MICRO SCREEN VARIABLES ONLY"
  1.  S HEADER(3)=" "
  1.  ;
  1.  D HEADERDT^BLRGMENU
  1.  ;
  1.  W !!,"LAB DESCRIPTION FILE WILL BE SORTED FIRST",!!
  1.  ;
  1.  ; First, Sort the Descriptions by the NAME field
  1.  S (CNT,IEN)=0
  1.  F  S IEN=$O(^LAB(62.5,IEN))  Q:IEN=""!(IEN'?.N)  D
  1.  . S SCREEN=$P($G(^LAB(62.5,IEN,0)),"^",4)
  1.  . I SCREEN="" Q                   ; If Screen field is NULL, skip
  1.  . I "CFMPV"'[SCREEN Q             ; If not one of the 5, skip
  1.  . ;
  1.  . S EXPANSION=$P($G(^LAB(62.5,IEN,0)),"^",2)
  1.  . I $E(EXPANSION,1,1)'?.A Q       ; If 1st Letter not Alpha, skip
  1.  . ;
  1.  . S NAME=$P($G(^LAB(62.5,IEN,0)),"^",1)
  1.  . S SYNONYM=$P($G(^LAB(62.5,IEN,0)),"^",3)
  1.  . I SYNONYM="" S SYNONYM=" "      ; If NULL, set to 1 Space
  1.  . ;
  1.  . S MICROREPORT(NAME,SYNONYM,IEN)=EXPANSION
  1.  . S CNT=CNT+1
  1.  ;
  1.  W !!,"Number of abbreviations Sorted = ",CNT,!!
  1.  ;
  1.  I $$YESNO("Produce Report","YES")="Q" D  Q
  1.  . W !!,"Fileman QUIT entered; Routine Ending.",!!
  1.  . D PRESSKEY^BLRGMENU(10)
  1.  ;
  1.  ; Now, the Report
  1.  ; 
  1.  D BLRMMRPI                        ; Initialize
  1.  ;
  1.  F  S NAME=$O(MICROREPORT(NAME))  Q:NAME=""!(QFLG="Q")  D
  1.  . F  S SYNONYM=$O(MICROREPORT(NAME,SYNONYM))  Q:SYNONYM=""!(QFLG="Q")  D
  1.  .. F  S IEN=$O(MICROREPORT(NAME,SYNONYM,IEN))  Q:IEN=""!(QFLG="Q")  D
  1.  ... D BLRMMRPL
  1.  ;
  1.  I +$G(CNT)>0 W !!,"Number of abbreviations = ",CNT,!!
  1.  ;
  1.  D ^%ZISC                          ; Close ALL open devices
  1.  ;
  1.  D PRESSKEY^BLRGMENU(10)
  1.  ;
  1.  Q
  1.  ;
  1. YESNO(QUESTION,DEFAULT) ; PEP
  1.  W !!
  1.  D ^XBFMK
  1.  S DIR("A")=QUESTION
  1.  I $G(DEFAULT)'="" S DIR("B")=DEFAULT
  1.  S DIR(0)="YO"
  1.  D ^DIR
  1.  I $D(DTOUT) Q "Q"                 ; Time-Out means QUIT
  1.  I $D(DUOUT) Q "Q"                 ; ^ means QUIT
  1.  S X=$E($$UP^XLFSTR(X),1,1)
  1.  I X="N" Q "Q"                     ; If NO, that means QUIT
  1.  ;
  1.  Q "YES"
  1.  ;
  1. BLRMMRPI ; PEP -- Initialization of routines and output device
  1.  S (CNT,PG)=0
  1.  S (IEN,NAME,SYNONYM)=""
  1.  S (HD1,QFLG)="NO"
  1.  ;
  1.  D ^%ZIS
  1.  I POP=1 D  Q
  1.  . W !!,"Could not open device ",!!
  1.  . S QFLG="Q"
  1.  ;
  1.  U IO
  1.  S MAXLINES=IOSL-4
  1.  S LINES=MAXLINES+10
  1.  ;
  1.  S HEADER(4)="NAME"
  1.  S $E(HEADER(4),21)="SYNONYM"
  1.  S $E(HEADER(4),31)="IEN"
  1.  S $E(HEADER(4),41)="EXPANSION"
  1.  ;
  1.  Q
  1.  ;
  1. BLRMMRPL ; PEP -- Output a line of data
  1.  I LINES>MAXLINES D HEADERPG^BLRGMENU(.PG,.QFLG,HD1)  I QFLG="Q" Q
  1.  ;
  1.  S EXPANSION=$G(MICROREPORT(NAME,SYNONYM,IEN))
  1.  ;
  1.  W $E(NAME,1,18)
  1.  W ?20,$E(SYNONYM,1,8)
  1.  W ?30,IEN                         ; Internal Entry Number
  1.  W ?40,$E(EXPANSION,1,38)
  1.  W !
  1.  S LINES=LINES+1
  1.  S CNT=CNT+1
  1.  Q