BLRF60SR ; IHS/MSC/MKK - File 60 line item SeaRch; 18-Apr-2016 12:02 ; MKK
;;5.2;IHS LABORATORY;**1039**;NOV 01, 1997;Build 38
;
EEP ; Ersatz EP
D EEP^BLRGMENU
Q
;
EP ; EP
PEP ; EP
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
;
Q:$$GETINIT()="Q"
;
F S F60IEN=$O(^LAB(60,F60IEN)) Q:F60IEN<1!(QFLG="Q") D SEARCH(SRCHSTR,F60IEN,.F60CNT,.CNT)
;
W !!,?4,F60CNT," File 60 entries analyzed."
W !!,?9,$S(CNT:CNT,1:"No")," File 60 entr",$S(CNT=1:"y",1:"ies")," matched."
;
D ^%ZISC
;
D PRESSKEY^BLRGMENU
Q
;
GETINIT() ; EP - Initialization
D SETBLRVS
;
S HEADER(1)="File 60 Line Item Search"
;
D HEADERDT^BLRGMENU
D ^XBFMK
S DIR(0)="FO"
S DIR("A")="Search String"
D ^DIR
I +$G(DIRUT)!(+$L(Y)<1) Q $$BADSTUFQ^BLRUTIL7("No/Invalid Search string.")
;
S SRCHSTR=$$UP^XLFSTR($G(X))
I $L(SRCHSTR)<51 S HEADER(2)="Search String:"_SRCHSTR,NEXTLINE=3
E S HEADER(2)="Search String",HEADER(3)=$$CJ^XLFSTR(SCRCHSTR),NEXTLINE=4
;
D HEADERDT^BLRGMENU
D ^%ZIS
U IO
;
S HEADER(NEXTLINE)=" ",NEXTLINE=NEXTLINE+1
S $E(HEADER(NEXTLINE),15)="Panel"
S $E(HEADER(NEXTLINE),21)="Type"
S $E(HEADER(NEXTLINE),31)="Description"
S $E(HEADER(NEXTLINE),70)="LOINC"
S MAXLINES=IOSL-4,LINES=MAXLINES+10
S (CNT,F60CNT,PG)=0
S QFLG="NO"
S F60IEN=.9999999
Q "OK"
;
;
SEARCH(SRCHSTR,F60IEN,F60CNT,CNT) ; EP - Search for the string
S F60CNT=F60CNT+1
S GLOVAR="^LAB(60,"_F60IEN_")"
S FRSTPART=$P(GLOVAR,")")
S STR1=$Q(@GLOVAR@(""))
S FOUNDIT=0
I $$UP^XLFSTR(STR1)[SRCHSTR D FOUNDIT(F60IEN,.FOUNDIT,.CNT) Q
I $$UP^XLFSTR(@(STR1))[SRCHSTR D FOUNDIT(F60IEN,.FOUNDIT,.CNT) Q
;
S FOUNDIT=0
F S STR1=$Q(@STR1) Q:STR1=""!(STR1'[FRSTPART)!(QFLG="Q")!(FOUNDIT) D
. I $$UP^XLFSTR(STR1)[SRCHSTR D FOUNDIT(F60IEN,.FOUNDIT,.CNT)
. I $$UP^XLFSTR(@(STR1))[SRCHSTR D FOUNDIT(F60IEN,.FOUNDIT,.CNT) Q
;
Q:FOUNDIT
;
; If a Cosmic test, search Atomic tests' names as well
Q:$$ISPANEL^BLRPOC(F60IEN)<1
;
NEW F602IEN,F602DESC,F60PANEL
S F60PANEL=0
F S F60PANEL=$O(^LAB(60,F60IEN,2,F60PANEL)) Q:F60PANEL<1!(FOUNDIT) D
. S F60IEN2=$$GET1^DIQ(60.02,F60PANEL_","_F60IEN,.01,"I")
. S F602DESC=$$GET1^DIQ(60.02,F60PANEL_","_F60IEN,.01)
. I $$UP^XLFSTR(F602DESC)[SRCHSTR D FOUNDIT(F60IEN,.FOUNDIT,.CNT)
Q
;
FOUNDIT(F60IEN,FOUNDIT,CNT) ; EP - Write out the entry
I LINES>MAXLINES D HEADERPG^BLRGMENU(.PG,.QFLG,"NO") Q:QFLG="Q"
;
W ?4,F60IEN
W ?14,$S($$ISPANEL^BLRPOC(F60IEN):"YES",1:"")
W ?20,$$TRIM^XLFSTR($P($$GET1^DIQ(60,F60IEN,3),"("),"LR"," ")
W ?29,$E($$GET1^DIQ(60,F60IEN,.01),1,38)
W ?69,$$GET1^DIQ(60.01,+$O(^LAB(60,F60IEN,1,0))_","_F60IEN,95.3)
W !
S LINES=LINES+1
S FOUNDIT=FOUNDIT+1
S CNT=CNT+1
Q
;
SETBLRVS(TWO) ; EP - Set the BLRVERN variable(s)
S BLRVERN=$TR($P($T(+1),";")," ")
S:$G(TWO)'="" BLRVERN2=TWO
Q
BLRF60SR ; IHS/MSC/MKK - File 60 line item SeaRch; 18-Apr-2016 12:02 ; MKK
+1 ;;5.2;IHS LABORATORY;**1039**;NOV 01, 1997;Build 38
+2 ;
EEP ; Ersatz EP
+1 DO EEP^BLRGMENU
+2 QUIT
+3 ;
EP ; EP
PEP ; EP
+1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
+2 ;
+3 IF $$GETINIT()="Q"
QUIT
+4 ;
+5 FOR
SET F60IEN=$ORDER(^LAB(60,F60IEN))
IF F60IEN<1!(QFLG="Q")
QUIT
DO SEARCH(SRCHSTR,F60IEN,.F60CNT,.CNT)
+6 ;
+7 WRITE !!,?4,F60CNT," File 60 entries analyzed."
+8 WRITE !!,?9,$SELECT(CNT:CNT,1:"No")," File 60 entr",$SELECT(CNT=1:"y",1:"ies")," matched."
+9 ;
+10 DO ^%ZISC
+11 ;
+12 DO PRESSKEY^BLRGMENU
+13 QUIT
+14 ;
GETINIT() ; EP - Initialization
+1 DO SETBLRVS
+2 ;
+3 SET HEADER(1)="File 60 Line Item Search"
+4 ;
+5 DO HEADERDT^BLRGMENU
+6 DO ^XBFMK
+7 SET DIR(0)="FO"
+8 SET DIR("A")="Search String"
+9 DO ^DIR
+10 IF +$GET(DIRUT)!(+$LENGTH(Y)<1)
QUIT $$BADSTUFQ^BLRUTIL7("No/Invalid Search string.")
+11 ;
+12 SET SRCHSTR=$$UP^XLFSTR($GET(X))
+13 IF $LENGTH(SRCHSTR)<51
SET HEADER(2)="Search String:"_SRCHSTR
SET NEXTLINE=3
+14 IF '$TEST
SET HEADER(2)="Search String"
SET HEADER(3)=$$CJ^XLFSTR(SCRCHSTR)
SET NEXTLINE=4
+15 ;
+16 DO HEADERDT^BLRGMENU
+17 DO ^%ZIS
+18 USE IO
+19 ;
+20 SET HEADER(NEXTLINE)=" "
SET NEXTLINE=NEXTLINE+1
+21 SET $EXTRACT(HEADER(NEXTLINE),15)="Panel"
+22 SET $EXTRACT(HEADER(NEXTLINE),21)="Type"
+23 SET $EXTRACT(HEADER(NEXTLINE),31)="Description"
+24 SET $EXTRACT(HEADER(NEXTLINE),70)="LOINC"
+25 SET MAXLINES=IOSL-4
SET LINES=MAXLINES+10
+26 SET (CNT,F60CNT,PG)=0
+27 SET QFLG="NO"
+28 SET F60IEN=.9999999
+29 QUIT "OK"
+30 ;
+31 ;
SEARCH(SRCHSTR,F60IEN,F60CNT,CNT) ; EP - Search for the string
+1 SET F60CNT=F60CNT+1
+2 SET GLOVAR="^LAB(60,"_F60IEN_")"
+3 SET FRSTPART=$PIECE(GLOVAR,")")
+4 SET STR1=$QUERY(@GLOVAR@(""))
+5 SET FOUNDIT=0
+6 IF $$UP^XLFSTR(STR1)[SRCHSTR
DO FOUNDIT(F60IEN,.FOUNDIT,.CNT)
QUIT
+7 IF $$UP^XLFSTR(@(STR1))[SRCHSTR
DO FOUNDIT(F60IEN,.FOUNDIT,.CNT)
QUIT
+8 ;
+9 SET FOUNDIT=0
+10 FOR
SET STR1=$QUERY(@STR1)
IF STR1=""!(STR1'[FRSTPART)!(QFLG="Q")!(FOUNDIT)
QUIT
Begin DoDot:1
+11 IF $$UP^XLFSTR(STR1)[SRCHSTR
DO FOUNDIT(F60IEN,.FOUNDIT,.CNT)
+12 IF $$UP^XLFSTR(@(STR1))[SRCHSTR
DO FOUNDIT(F60IEN,.FOUNDIT,.CNT)
QUIT
End DoDot:1
+13 ;
+14 IF FOUNDIT
QUIT
+15 ;
+16 ; If a Cosmic test, search Atomic tests' names as well
+17 IF $$ISPANEL^BLRPOC(F60IEN)<1
QUIT
+18 ;
+19 NEW F602IEN,F602DESC,F60PANEL
+20 SET F60PANEL=0
+21 FOR
SET F60PANEL=$ORDER(^LAB(60,F60IEN,2,F60PANEL))
IF F60PANEL<1!(FOUNDIT)
QUIT
Begin DoDot:1
+22 SET F60IEN2=$$GET1^DIQ(60.02,F60PANEL_","_F60IEN,.01,"I")
+23 SET F602DESC=$$GET1^DIQ(60.02,F60PANEL_","_F60IEN,.01)
+24 IF $$UP^XLFSTR(F602DESC)[SRCHSTR
DO FOUNDIT(F60IEN,.FOUNDIT,.CNT)
End DoDot:1
+25 QUIT
+26 ;
FOUNDIT(F60IEN,FOUNDIT,CNT) ; EP - Write out the entry
+1 IF LINES>MAXLINES
DO HEADERPG^BLRGMENU(.PG,.QFLG,"NO")
IF QFLG="Q"
QUIT
+2 ;
+3 WRITE ?4,F60IEN
+4 WRITE ?14,$SELECT($$ISPANEL^BLRPOC(F60IEN):"YES",1:"")
+5 WRITE ?20,$$TRIM^XLFSTR($PIECE($$GET1^DIQ(60,F60IEN,3),"("),"LR"," ")
+6 WRITE ?29,$EXTRACT($$GET1^DIQ(60,F60IEN,.01),1,38)
+7 WRITE ?69,$$GET1^DIQ(60.01,+$ORDER(^LAB(60,F60IEN,1,0))_","_F60IEN,95.3)
+8 WRITE !
+9 SET LINES=LINES+1
+10 SET FOUNDIT=FOUNDIT+1
+11 SET CNT=CNT+1
+12 QUIT
+13 ;
SETBLRVS(TWO) ; EP - Set the BLRVERN variable(s)
+1 SET BLRVERN=$TRANSLATE($PIECE($TEXT(+1),";")," ")
+2 IF $GET(TWO)'=""
SET BLRVERN2=TWO
+3 QUIT
