BLRMMRPT ;IHS/OIT/MKK - MICRO MNEMONICS REPORT;DEC 09, 2008 8:30 AM
;;5.2;IHS LABORATORY;**1025**;NOV 01, 1997
;
; Lab Description File Abbreviation Report
;
; Per IHS LAB PSG - Need a report of the mnemonics/abbreviations used
; in the MICRO reports for certification purposes.
;
EP ; EP
; Report only on 5 SCREEN entries:
; C - AP CYTO
; F - FUNGUS
; M - MICRO
; P - PARASITE
; V - VIRUS
;
; NEW all variables to make sure nothing left "hanging around"
NEW CNT,ABBREV,EXPANSION,IEN,MICROREPORT,NAME,SCREEN,SYNONYM
NEW HEADER,HD1,LINES,MAXLINES,PG,QFLG
;
S HEADER(1)="LAB DESCRIPTION FILE REPORT"
S HEADER(2)="MICRO SCREEN VARIABLES ONLY"
S HEADER(3)=" "
;
D HEADERDT^BLRGMENU
;
W !!,"LAB DESCRIPTION FILE WILL BE SORTED FIRST",!!
;
; First, Sort the Descriptions by the NAME field
S (CNT,IEN)=0
F S IEN=$O(^LAB(62.5,IEN)) Q:IEN=""!(IEN'?.N) D
. S SCREEN=$P($G(^LAB(62.5,IEN,0)),"^",4)
. I SCREEN="" Q ; If Screen field is NULL, skip
. I "CFMPV"'[SCREEN Q ; If not one of the 5, skip
. ;
. S EXPANSION=$P($G(^LAB(62.5,IEN,0)),"^",2)
. I $E(EXPANSION,1,1)'?.A Q ; If 1st Letter not Alpha, skip
. ;
. S NAME=$P($G(^LAB(62.5,IEN,0)),"^",1)
. S SYNONYM=$P($G(^LAB(62.5,IEN,0)),"^",3)
. I SYNONYM="" S SYNONYM=" " ; If NULL, set to 1 Space
. ;
. S MICROREPORT(NAME,SYNONYM,IEN)=EXPANSION
. S CNT=CNT+1
;
W !!,"Number of abbreviations Sorted = ",CNT,!!
;
I $$YESNO("Produce Report","YES")="Q" D Q
. W !!,"Fileman QUIT entered; Routine Ending.",!!
. D PRESSKEY^BLRGMENU(10)
;
; Now, the Report
;
D BLRMMRPI ; Initialize
;
F S NAME=$O(MICROREPORT(NAME)) Q:NAME=""!(QFLG="Q") D
. F S SYNONYM=$O(MICROREPORT(NAME,SYNONYM)) Q:SYNONYM=""!(QFLG="Q") D
.. F S IEN=$O(MICROREPORT(NAME,SYNONYM,IEN)) Q:IEN=""!(QFLG="Q") D
... D BLRMMRPL
;
I +$G(CNT)>0 W !!,"Number of abbreviations = ",CNT,!!
;
D ^%ZISC ; Close ALL open devices
;
D PRESSKEY^BLRGMENU(10)
;
Q
;
YESNO(QUESTION,DEFAULT) ; PEP
W !!
D ^XBFMK
S DIR("A")=QUESTION
I $G(DEFAULT)'="" S DIR("B")=DEFAULT
S DIR(0)="YO"
D ^DIR
I $D(DTOUT) Q "Q" ; Time-Out means QUIT
I $D(DUOUT) Q "Q" ; ^ means QUIT
S X=$E($$UP^XLFSTR(X),1,1)
I X="N" Q "Q" ; If NO, that means QUIT
;
Q "YES"
;
BLRMMRPI ; PEP -- Initialization of routines and output device
S (CNT,PG)=0
S (IEN,NAME,SYNONYM)=""
S (HD1,QFLG)="NO"
;
D ^%ZIS
I POP=1 D Q
. W !!,"Could not open device ",!!
. S QFLG="Q"
;
U IO
S MAXLINES=IOSL-4
S LINES=MAXLINES+10
;
S HEADER(4)="NAME"
S $E(HEADER(4),21)="SYNONYM"
S $E(HEADER(4),31)="IEN"
S $E(HEADER(4),41)="EXPANSION"
;
Q
;
BLRMMRPL ; PEP -- Output a line of data
I LINES>MAXLINES D HEADERPG^BLRGMENU(.PG,.QFLG,HD1) I QFLG="Q" Q
;
S EXPANSION=$G(MICROREPORT(NAME,SYNONYM,IEN))
;
W $E(NAME,1,18)
W ?20,$E(SYNONYM,1,8)
W ?30,IEN ; Internal Entry Number
W ?40,$E(EXPANSION,1,38)
W !
S LINES=LINES+1
S CNT=CNT+1
Q
BLRMMRPT ;IHS/OIT/MKK - MICRO MNEMONICS REPORT;DEC 09, 2008 8:30 AM
+1 ;;5.2;IHS LABORATORY;**1025**;NOV 01, 1997
+2 ;
+3 ; Lab Description File Abbreviation Report
+4 ;
+5 ; Per IHS LAB PSG - Need a report of the mnemonics/abbreviations used
+6 ; in the MICRO reports for certification purposes.
+7 ;
EP ; EP
+1 ; Report only on 5 SCREEN entries:
+2 ; C - AP CYTO
+3 ; F - FUNGUS
+4 ; M - MICRO
+5 ; P - PARASITE
+6 ; V - VIRUS
+7 ;
+8 ; NEW all variables to make sure nothing left "hanging around"
+9 NEW CNT,ABBREV,EXPANSION,IEN,MICROREPORT,NAME,SCREEN,SYNONYM
+10 NEW HEADER,HD1,LINES,MAXLINES,PG,QFLG
+11 ;
+12 SET HEADER(1)="LAB DESCRIPTION FILE REPORT"
+13 SET HEADER(2)="MICRO SCREEN VARIABLES ONLY"
+14 SET HEADER(3)=" "
+15 ;
+16 DO HEADERDT^BLRGMENU
+17 ;
+18 WRITE !!,"LAB DESCRIPTION FILE WILL BE SORTED FIRST",!!
+19 ;
+20 ; First, Sort the Descriptions by the NAME field
+21 SET (CNT,IEN)=0
+22 FOR
SET IEN=$ORDER(^LAB(62.5,IEN))
IF IEN=""!(IEN'?.N)
QUIT
Begin DoDot:1
+23 SET SCREEN=$PIECE($GET(^LAB(62.5,IEN,0)),"^",4)
+24 ; If Screen field is NULL, skip
IF SCREEN=""
QUIT
+25 ; If not one of the 5, skip
IF "CFMPV"'[SCREEN
QUIT
+26 ;
+27 SET EXPANSION=$PIECE($GET(^LAB(62.5,IEN,0)),"^",2)
+28 ; If 1st Letter not Alpha, skip
IF $EXTRACT(EXPANSION,1,1)'?.A
QUIT
+29 ;
+30 SET NAME=$PIECE($GET(^LAB(62.5,IEN,0)),"^",1)
+31 SET SYNONYM=$PIECE($GET(^LAB(62.5,IEN,0)),"^",3)
+32 ; If NULL, set to 1 Space
IF SYNONYM=""
SET SYNONYM=" "
+33 ;
+34 SET MICROREPORT(NAME,SYNONYM,IEN)=EXPANSION
+35 SET CNT=CNT+1
End DoDot:1
+36 ;
+37 WRITE !!,"Number of abbreviations Sorted = ",CNT,!!
+38 ;
+39 IF $$YESNO("Produce Report","YES")="Q"
Begin DoDot:1
+40 WRITE !!,"Fileman QUIT entered; Routine Ending.",!!
+41 DO PRESSKEY^BLRGMENU(10)
End DoDot:1
QUIT
+42 ;
+43 ; Now, the Report
+44 ;
+45 ; Initialize
DO BLRMMRPI
+46 ;
+47 FOR
SET NAME=$ORDER(MICROREPORT(NAME))
IF NAME=""!(QFLG="Q")
QUIT
Begin DoDot:1
+48 FOR
SET SYNONYM=$ORDER(MICROREPORT(NAME,SYNONYM))
IF SYNONYM=""!(QFLG="Q")
QUIT
Begin DoDot:2
+49 FOR
SET IEN=$ORDER(MICROREPORT(NAME,SYNONYM,IEN))
IF IEN=""!(QFLG="Q")
QUIT
Begin DoDot:3
+50 DO BLRMMRPL
End DoDot:3
End DoDot:2
End DoDot:1
+51 ;
+52 IF +$GET(CNT)>0
WRITE !!,"Number of abbreviations = ",CNT,!!
+53 ;
+54 ; Close ALL open devices
DO ^%ZISC
+55 ;
+56 DO PRESSKEY^BLRGMENU(10)
+57 ;
+58 QUIT
+59 ;
YESNO(QUESTION,DEFAULT) ; PEP
+1 WRITE !!
+2 DO ^XBFMK
+3 SET DIR("A")=QUESTION
+4 IF $GET(DEFAULT)'=""
SET DIR("B")=DEFAULT
+5 SET DIR(0)="YO"
+6 DO ^DIR
+7 ; Time-Out means QUIT
IF $DATA(DTOUT)
QUIT "Q"
+8 ; ^ means QUIT
IF $DATA(DUOUT)
QUIT "Q"
+9 SET X=$EXTRACT($$UP^XLFSTR(X),1,1)
+10 ; If NO, that means QUIT
IF X="N"
QUIT "Q"
+11 ;
+12 QUIT "YES"
+13 ;
BLRMMRPI ; PEP -- Initialization of routines and output device
+1 SET (CNT,PG)=0
+2 SET (IEN,NAME,SYNONYM)=""
+3 SET (HD1,QFLG)="NO"
+4 ;
+5 DO ^%ZIS
+6 IF POP=1
Begin DoDot:1
+7 WRITE !!,"Could not open device ",!!
+8 SET QFLG="Q"
End DoDot:1
QUIT
+9 ;
+10 USE IO
+11 SET MAXLINES=IOSL-4
+12 SET LINES=MAXLINES+10
+13 ;
+14 SET HEADER(4)="NAME"
+15 SET $EXTRACT(HEADER(4),21)="SYNONYM"
+16 SET $EXTRACT(HEADER(4),31)="IEN"
+17 SET $EXTRACT(HEADER(4),41)="EXPANSION"
+18 ;
+19 QUIT
+20 ;
BLRMMRPL ; PEP -- Output a line of data
+1 IF LINES>MAXLINES
DO HEADERPG^BLRGMENU(.PG,.QFLG,HD1)
IF QFLG="Q"
QUIT
+2 ;
+3 SET EXPANSION=$GET(MICROREPORT(NAME,SYNONYM,IEN))
+4 ;
+5 WRITE $EXTRACT(NAME,1,18)
+6 WRITE ?20,$EXTRACT(SYNONYM,1,8)
+7 ; Internal Entry Number
WRITE ?30,IEN
+8 WRITE ?40,$EXTRACT(EXPANSION,1,38)
+9 WRITE !
+10 SET LINES=LINES+1
+11 SET CNT=CNT+1
+12 QUIT
