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

BLRF60SR.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1. EEP ; Ersatz EP
  1.  D EEP^BLRGMENU
  1.  Q
  1.  ;
  1. EP ; EP
  1. PEP ; EP
  1.  NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
  1.  ;
  1.  Q:$$GETINIT()="Q"
  1.  ;
  1.  F  S F60IEN=$O(^LAB(60,F60IEN))  Q:F60IEN<1!(QFLG="Q")  D SEARCH(SRCHSTR,F60IEN,.F60CNT,.CNT)
  1.  ;
  1.  W !!,?4,F60CNT," File 60 entries analyzed."
  1.  W !!,?9,$S(CNT:CNT,1:"No")," File 60 entr",$S(CNT=1:"y",1:"ies")," matched."
  1.  ;
  1.  D ^%ZISC
  1.  ;
  1.  D PRESSKEY^BLRGMENU
  1.  Q
  1.  ;
  1. GETINIT() ; EP - Initialization
  1.  D SETBLRVS
  1.  ;
  1.  S HEADER(1)="File 60 Line Item Search"
  1.  ;
  1.  D HEADERDT^BLRGMENU
  1.  D ^XBFMK
  1.  S DIR(0)="FO"
  1.  S DIR("A")="Search String"
  1.  D ^DIR
  1.  I +$G(DIRUT)!(+$L(Y)<1)  Q $$BADSTUFQ^BLRUTIL7("No/Invalid Search string.")
  1.  ;
  1.  S SRCHSTR=$$UP^XLFSTR($G(X))
  1.  I $L(SRCHSTR)<51 S HEADER(2)="Search String:"_SRCHSTR,NEXTLINE=3
  1.  E  S HEADER(2)="Search String",HEADER(3)=$$CJ^XLFSTR(SCRCHSTR),NEXTLINE=4
  1.  ;
  1.  D HEADERDT^BLRGMENU
  1.  D ^%ZIS
  1.  U IO
  1.  ;
  1.  S HEADER(NEXTLINE)=" ",NEXTLINE=NEXTLINE+1
  1.  S $E(HEADER(NEXTLINE),15)="Panel"
  1.  S $E(HEADER(NEXTLINE),21)="Type"
  1.  S $E(HEADER(NEXTLINE),31)="Description"
  1.  S $E(HEADER(NEXTLINE),70)="LOINC"
  1.  S MAXLINES=IOSL-4,LINES=MAXLINES+10
  1.  S (CNT,F60CNT,PG)=0
  1.  S QFLG="NO"
  1.  S F60IEN=.9999999
  1.  Q "OK"
  1.  ;
  1.  ;
  1.  S F60CNT=F60CNT+1
  1.  S GLOVAR="^LAB(60,"_F60IEN_")"
  1.  S FRSTPART=$P(GLOVAR,")")
  1.  S STR1=$Q(@GLOVAR@(""))
  1.  S FOUNDIT=0
  1.  I $$UP^XLFSTR(STR1)[SRCHSTR D FOUNDIT(F60IEN,.FOUNDIT,.CNT)  Q
  1.  I $$UP^XLFSTR(@(STR1))[SRCHSTR D FOUNDIT(F60IEN,.FOUNDIT,.CNT)  Q
  1.  ;
  1.  S FOUNDIT=0
  1.  F  S STR1=$Q(@STR1)  Q:STR1=""!(STR1'[FRSTPART)!(QFLG="Q")!(FOUNDIT)  D
  1.  . I $$UP^XLFSTR(STR1)[SRCHSTR D FOUNDIT(F60IEN,.FOUNDIT,.CNT)
  1.  . I $$UP^XLFSTR(@(STR1))[SRCHSTR D FOUNDIT(F60IEN,.FOUNDIT,.CNT)  Q
  1.  ;
  1.  Q:FOUNDIT
  1.  ;
  1.  ; If a Cosmic test, search Atomic tests' names as well
  1.  Q:$$ISPANEL^BLRPOC(F60IEN)<1
  1.  ;
  1.  NEW F602IEN,F602DESC,F60PANEL
  1.  S F60PANEL=0
  1.  F  S F60PANEL=$O(^LAB(60,F60IEN,2,F60PANEL))  Q:F60PANEL<1!(FOUNDIT)  D
  1.  . S F60IEN2=$$GET1^DIQ(60.02,F60PANEL_","_F60IEN,.01,"I")
  1.  . S F602DESC=$$GET1^DIQ(60.02,F60PANEL_","_F60IEN,.01)
  1.  . I $$UP^XLFSTR(F602DESC)[SRCHSTR D FOUNDIT(F60IEN,.FOUNDIT,.CNT)
  1.  Q
  1.  ;
  1. FOUNDIT(F60IEN,FOUNDIT,CNT) ; EP - Write out the entry
  1.  I LINES>MAXLINES D HEADERPG^BLRGMENU(.PG,.QFLG,"NO")  Q:QFLG="Q"
  1.  ;
  1.  W ?4,F60IEN
  1.  W ?14,$S($$ISPANEL^BLRPOC(F60IEN):"YES",1:"")
  1.  W ?20,$$TRIM^XLFSTR($P($$GET1^DIQ(60,F60IEN,3),"("),"LR"," ")
  1.  W ?29,$E($$GET1^DIQ(60,F60IEN,.01),1,38)
  1.  W ?69,$$GET1^DIQ(60.01,+$O(^LAB(60,F60IEN,1,0))_","_F60IEN,95.3)
  1.  W !
  1.  S LINES=LINES+1
  1.  S FOUNDIT=FOUNDIT+1
  1.  S CNT=CNT+1
  1.  Q
  1.  ;
  1. SETBLRVS(TWO) ; EP - Set the BLRVERN variable(s)
  1.  S BLRVERN=$TR($P($T(+1),";")," ")
  1.  S:$G(TWO)'="" BLRVERN2=TWO
  1.  Q