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

BLRHLTBL.m

Go to the documentation of this file. 
  1. BLRHLTBL ; cmi/anch/maw - BHL Import HL7 Tables ; 22-Oct-2013 09:22 ; MKK
  1.  ;;5.2;IHS LABORATORY;**1033**;NOV 01, 1997
  1.  ;
  1. BHLTBLL(DIR,FILE) ; EP
  1.  ;;3.01;BHL IHS HL7 UTILTIES;;JUL 11,2013
  1.  ;
  1.  ;
  1.  ;EP - This is the main routine driver
  1.  S C=","
  1.  D LOAD(DIR,FILE)
  1.  Q:$G(BHLFLG)
  1.  Q
  1.  ;D EOJ
  1.  Q
  1.  ;
  1. LOAD(DIR,FL) ;-- load from the file and bhl hl7 tables File
  1.  N VALUE,DESC,TB
  1.  S BLRY=$$OPEN^%ZISH(DIR,FL,"R")
  1.  I BLRY D  Q
  1.  . S BLRFLG=1
  1.  . W !,"Trouble Opening File, please fix and try again" Q
  1.  F BLRI=1:1 U IO R BLRX:DTIME D  Q:BLRX=""
  1.  . Q:BLRX=""
  1.  . S VALUE=$P(BLRX,C)
  1.  . S DESC=$E($P(BLRX,C,2),1,150)
  1.  . S DESC=$TR(DESC,"""","")
  1.  . S TB=$E($P(BLRX,C,3),4,7)
  1.  . S BLRTI=$$ADD(TB,VALUE,DESC)
  1.  . Q:'BLRTI
  1.  . Q
  1.  . ;S BLRLT=$$MTCH(BLRTI)
  1.  D ^%ZISC
  1.  Q
  1.  ;
  1. ADD(TAB,VAL,DSC)          ;-- add the test code to the file
  1.  I $O(^BHLTBL("AVAL",TAB,VAL,0)) Q ""
  1.  N FDA,FIENS,FERR
  1.  S FDA(90076.9,"+1,",.01)=TAB
  1.  S FDA(90076.9,"+1,",.02)=VAL
  1.  S FDA(90076.9,"+1,",.03)=DSC
  1.  D UPDATE^DIE("","FDA","FIENS","FERR(1)")
  1.  Q ""
  1.  ;
  1. LOADO(DIR,FL) ;-- load from the file and bhl other tables File
  1.  N VALUE,DESC,TB
  1.  S BLRY=$$OPEN^%ZISH(DIR,FL,"R")
  1.  I BLRY D  Q
  1.  . S BLRFLG=1
  1.  . W !,"Trouble Opening File, please fix and try again" Q
  1.  F BLRI=1:1 U IO R BLRX:DTIME D  Q:BLRX=""
  1.  . Q:BLRX=""
  1.  . S VALUE=$P(BLRX,C)
  1.  . S DESC=$E($P(BLRX,C,2),1,150)
  1.  . S DESC=$TR(DESC,"""","")
  1.  . S TB=$P(BLRX,C,3)
  1.  . S BLRTI=$$ADDO(TB,VALUE,DESC)
  1.  . Q:'BLRTI
  1.  . Q
  1.  . ;S BLRLT=$$MTCH(BLRTI)
  1.  D ^%ZISC
  1.  Q
  1.  ;
  1. ADDO(TAB,VAL,DSC)          ;-- add the test code to the file
  1.  I $O(^BHLOTBL("AVAL",TAB,VAL,0)) Q ""
  1.  N FDA,FIENS,FERR
  1.  S FDA(90076.8,"+1,",.01)=TAB
  1.  S FDA(90076.8,"+1,",.02)=VAL
  1.  S FDA(90076.8,"+1,",.03)=DSC
  1.  D UPDATE^DIE("","FDA","FIENS","FERR(1)")
  1.  Q ""
  1.  ;
  1. DISP ; EP -- display the values in an HL7 table
  1.  N HTAB,TABL,TDA,TIEN,DATA
  1.  S TABL=$$ASKTAB()
  1.  I TABL="O" D DISPO Q
  1.  S HTAB=$$ASKHTAB()
  1.  I $G(HTAB)="" W !!,?4,"HL7 table not on system" D PRESSKEY^BLRGMENU(9)  Q
  1.  ;
  1.  D DSPHLTBL(HTAB)
  1.  ; W @IOF
  1.  ; W "HL7 Table "_HTAB
  1.  ; W !,"Value",?17,"Description"
  1.  ; S TDA=0 F  S TDA=$O(^BHLTBL("AVAL",HTAB,TDA)) Q:TDA=""  D
  1.  ; . S TIEN=0 F  S TIEN=$O(^BHLTBL("AVAL",HTAB,TDA,TIEN)) Q:'TIEN  D
  1.  ; .. S DATA=$G(^BHLTBL(TIEN,0))
  1.  ; .. W !,$P(DATA,U,2),?17,$P(DATA,U,3)
  1.  ; D PRESSKEY^BLRGMENU(9)
  1.  Q
  1.  ;
  1. DISPO ;-- display the values in an HL7 table
  1.  N OTAB,TABL,TDA,TIEN,DATA
  1.  S OTAB=$$ASKOTAB()
  1.  I $G(OTAB)="" W !!,?4,"Other table not on system" D PRESSKEY^BLRGMENU(9)  Q
  1.  ;
  1.  D DSPOTTBL(OTAB)
  1.  ; W @IOF
  1.  ; W "Other Table "_OTAB
  1.  ; W !,"Value",?17,"Description"
  1.  ; S TDA=0 F  S TDA=$O(^BHLOTBL("AVAL",OTAB,TDA)) Q:TDA=""  D
  1.  ; . S TIEN=0 F  S TIEN=$O(^BHLOTBL("AVAL",OTAB,TDA,TIEN)) Q:'TIEN  D
  1.  ; .. S DATA=$G(^BHLOTBL(TIEN,0))
  1.  ; .. W !,$P(DATA,U,2),?27,$P(DATA,U,3)
  1.  ; D PRESSKEY^BLRGMENU(9)
  1.  Q
  1.  ;
  1. DSPHLTBL(TABLE) ; EP - Display HL7 Table
  1.  NEW DESC,HEADER,LINES,MAXLINES,PG,QFLG
  1.  ;
  1.  S HEADER(1)="HL7"
  1.  S HEADER(2)="Table "_TABLE
  1.  S HEADER(3)=" "
  1.  S $E(HEADER(4),5)="Value"
  1.  S $E(HEADER(4),20)="Description"
  1.  ;
  1.  S MAXLINES=(IOSL-3),LINES=MAXLINES+10,PG=0,QFLG="NO"
  1.  ;
  1.  S TDA=0 F  S TDA=$O(^BHLTBL("AVAL",TABLE,TDA)) Q:TDA=""!(QFLG="Q")  D
  1.  . S TIEN=0 F  S TIEN=$O(^BHLTBL("AVAL",TABLE,TDA,TIEN)) Q:'TIEN!(QFLG="Q")  D
  1.  .. S DATA=$G(^BHLTBL(TIEN,0))
  1.  .. I LINES>MAXLINES D HEADERPG^BLRGMENU(.PG,.QFLG,"NO")  Q:QFLG="Q"
  1.  .. S DESC=$P(DATA,U,3)
  1.  .. W ?4,$P(DATA,U,2)
  1.  .. W:$L(DESC)<61 ?19,DESC
  1.  .. D:$L(DESC)>60 LINEWRAP^BLRGMENU(19,DESC,60)
  1.  .. W !
  1.  .. S LINES=LINES+1
  1.  ;
  1.  D:QFLG'="Q" PRESSKEY^BLRGMENU(9)
  1.  Q
  1.  ;
  1. DSPOTTBL(TABLE) ; EP - Display OTHER Table
  1.  NEW DESC,HEADER,LINES,MAXLINES,PG,QFLG
  1.  ;
  1.  S HEADER(1)="Other"
  1.  S HEADER(2)="Table "_TABLE
  1.  S HEADER(3)=" "
  1.  S $E(HEADER(4),5)="Value"
  1.  S $E(HEADER(4),30)="Description"
  1.  ;
  1.  S MAXLINES=(IOSL-3),LINES=MAXLINES+10,PG=0,QFLG="NO"
  1.  ;
  1.  S TDA=0 F  S TDA=$O(^BHLOTBL("AVAL",TABLE,TDA)) Q:TDA=""!(QFLG="Q")  D
  1.  . S TIEN=0 F  S TIEN=$O(^BHLOTBL("AVAL",TABLE,TDA,TIEN)) Q:'TIEN!(QFLG="Q")  D
  1.  .. S DATA=$G(^BHLOTBL(TIEN,0))
  1.  .. I LINES>MAXLINES D HEADERPG^BLRGMENU(.PG,.QFLG,"NO")  Q:QFLG="Q"
  1.  .. S DESC=$P(DATA,U,3)
  1.  .. W ?4,$P(DATA,U,2)
  1.  .. W:$L(DESC)<51 ?29,DESC
  1.  .. D:$L(DESC)>50 LINEWRAP^BLRGMENU(29,DESC,50)
  1.  .. W !
  1.  .. S LINES=LINES+1
  1.  ;
  1.  D:QFLG'="Q" PRESSKEY^BLRGMENU(9)
  1.  Q
  1.  ;
  1. ASKTAB() ;-- get the table number
  1.  N TAB
  1.  S DIR("A")="HL7 or Other Table",DIR(0)="S^H:HL7;O:Other"
  1.  D ^DIR
  1.  I $D(DIRUT) Q ""
  1.  S TAB=Y
  1.  Q TAB
  1.  ;
  1. ASKHTAB() ;-- get the table number
  1.  N TAB
  1.  S DIR("A")="Which HL7 table",DIR(0)="F^1:6"
  1.  D ^DIR
  1.  I $D(DIRUT) Q ""
  1.  S TAB=Y
  1.  I '$O(^BHLTBL("B",TAB,0)) Q ""
  1.  Q TAB
  1.  ;
  1. ASKOTAB() ;-- get the table number
  1.  N TAB
  1.  S DIR("A")="Which table",DIR(0)="F^1:15"
  1.  D ^DIR
  1.  I $D(DIRUT) Q ""
  1.  S TAB=Y
  1.  I '$O(^BHLOTBL("B",TAB,0)) Q ""
  1.  Q TAB
  1.  ;