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

BLRF612A.m

Go to the documentation of this file. 
  1. BLRF612A ; IHS/OIT/MKK - IHS Lab: File 61.2 Add from DTS Server ; 22-Oct-2013 09:22 ; MKK
  1.  ;;5.2;LAB SERVICE;**1033**;NOV 1, 1997
  1.  ;
  1.  ; Add entries to ETIOLOGY FIELD (#61.2) dictionary using lookup into DTS Server and then guiding
  1.  ; user to enter data for specific fields so as to use an UPDATE^DIE call to update the dictionary.
  1.  ;
  1. PEP ; EP
  1. EP ; EP
  1. EEP ; Ersatz EP
  1.  D EEP^BLRGMENU
  1.  Q
  1.  ;
  1. ADDIT ; EP - Add an Entry
  1.  NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
  1.  ;
  1.  D ^XBCLS
  1.  S (BAIL,FOUNDSUM)=0
  1.  F  Q:FOUNDSUM!(BAIL)  D
  1.  . W !!
  1.  . D ^XBFMK
  1.  . S DIR(0)="F"
  1.  . S DIR("A")="Enter SNOMED Description (Free Text)"
  1.  . D ^DIR
  1.  . I +$G(DIRUT) D  Q
  1.  .. W !,?4,"Quit or No/Invalid Input.  Routine Ends."
  1.  .. D PRESSKEY^BLRGMENU(9)
  1.  .. S BAIL=1
  1.  . ;
  1.  . S OUT="VARS",IN=$G(X)_"^F^^^^100"
  1.  . S FOUNDSUM=$$SEARCH^BSTSAPI(OUT,IN)
  1.  . I FOUNDSUM<1 W !!,?9,"No entries found in the IHS STANDARD TERMINOLOGY database.  Try Again."
  1.  ;
  1.  Q:BAIL
  1.  ;
  1.  S WHICHONE=0
  1.  D EN^BLRSM
  1.  I WHICHONE<1 D  Q
  1.  . W !,?4,"No Entry Selected.  Routine Ends."
  1.  . D PRESSKEY^BLRGMENU(9)
  1.  ;
  1.  D REST61P2
  1.  Q
  1.  ;
  1. REST61P2 ; EP - Enter rest of data needed to update 61.2
  1.  S STR=$G(SNOMED(WHICHONE))
  1.  S SNOMED=$P(STR,"^")
  1.  S SNOMEDSC=$P(STR,"^",2)
  1.  ;
  1.  Q:$$ALREADY(SNOMED,SNOMEDESC)
  1.  ;
  1.  D CGTRIBEF
  1.  D GRAMSTAN
  1.  D IDENTIFR
  1.  D ABBREV
  1.  D SUSEDITT
  1.  D HDEPTRPT
  1.  ;
  1.  K ERRS,FDA
  1.  S FDA(61.2,"+1,",.01)=SNOMEDSC
  1.  S FDA(61.2,"+1,",2)=SNOMED
  1.  S:$L(GRAMSTAN) FDA(61.2,"+1,",3)=GRAMSTAN
  1.  S:$L(IDENTIFR) FDA(61.2,"+1,",4)=IDENTIFR
  1.  S:$L(ABBREV) FDA(61.2,"+1,",6)=ABBREV
  1.  S:$L(SUSEDITT) FDA(61.2,"+1,",8)=SUSEDITT
  1.  S:$L(HDEPTRPT) FDA(61.2,"+1,",10)=HDEPTRPT
  1.  S:$L(CGTRIBEF) FDA(61.2,"+1,",1.6)=CGTRIBEF
  1.  ;
  1.  D UPDATE^DIE("ES","FDA","ERRS")
  1.  ;
  1.  I $D(ERRS) D ERRORS  Q
  1.  ;
  1.  D DISPLAY(+$$FIND1^DIC(61.2,,,SNOMEDSC))
  1.  ;
  1.  Q
  1.  ;
  1. ALREADY(SNOMED,SNOMEDESC) ; EP - Is the selected entry already in 61.2?
  1.  NEW ALREADY
  1.  ;
  1.  S ALREADY=$$FIND1^DIC(61.2,,,SNOMEDSC,,,"ERRS")
  1.  I ALREADY D
  1.  . W !,?4,"SNOMED ",SNOMED," already exists in ETIOLOGY FIELD (#61.2) File.  Routine Ends."
  1.  . D PRESSKEY^BLRGMENU(9)
  1.  Q ALREADY
  1.  ;
  1. CGTRIBEF ; EP - CLASS/GROUP-TRIBE/FAMILY
  1.  D ^XBCLS
  1.  S CGTRIBEF=""
  1.  D ^XBFMK
  1.  S DIR(0)="FO^1:30"
  1.  S DIR("A")="CLASS/GROUP-TRIBE/FAMILY"
  1.  S DIR("?")="The class/group or tribe/family the etiologic agent belongs to."
  1.  D ^DIR
  1.  I +$G(DIRUT) D NOSELECT("CLASS/GROUP-TRIBE/FAMILY")  Q
  1.  ;
  1.  S CGTRIBEF=$G(X)
  1.  Q
  1.  ;
  1. GRAMSTAN ; EP - GRAM STAIN
  1.  D ^XBCLS
  1.  S GRAMSTAN=""
  1.  ;
  1.  D ^XBFMK
  1.  S DIR(0)="S^1:;2:;3:;4:;"
  1.  S DIR("L",1)="Select GRAM STAIN:"
  1.  S DIR("L",2)=""
  1.  S DIR("L",3)="     1) GRAM POSITIVE"
  1.  S DIR("L",4)="     2) GRAM NEGATIVE"
  1.  S DIR("L",5)="     3) INDETERMINATE"
  1.  S DIR("L",6)="     4) EXIT/NO SELECTION"
  1.  S DIR("L")=""
  1.  S DIR("A")="Selection"
  1.  D ^DIR
  1.  ;
  1.  I +$G(DIRUT)!(+$G(Y)<1) D NOSELECT("GRAM STAIN")  Q
  1.  ;
  1.  S GRAMSTAN=$S(Y=1:"P",Y=2:"N",Y=3:"I",1:"")
  1.  Q
  1.  ;
  1. IDENTIFR ; EP - IDENTIFIER
  1.  D ^XBCLS
  1.  S IDENTIFR=""
  1.  ;
  1.  D ^XBFMK
  1.  S DIR(0)="S^1:;2:;3:;4:;5:;6:;7:;8:;"
  1.  S DIR("L",1)="Select category into which the etiologic agent falls:"
  1.  S DIR("L",2)=""
  1.  S DIR("L",3)="     1) BACTERIUM"
  1.  S DIR("L",4)="     2) FUNGUS"
  1.  S DIR("L",5)="     3) PARASITE"
  1.  S DIR("L",6)="     4) MYCOBACTERIUM"
  1.  S DIR("L",7)="     5) VIRUS"
  1.  S DIR("L",8)="     6) CHEMICAL"
  1.  S DIR("L",9)="     7) DRUG"
  1.  S DIR("L",10)="     8) EXIT/NO SELECTION"
  1.  S DIR("L")=""
  1.  S DIR("A")="Selection"
  1.  S DIR("?")="This field identifies the category into which this etiologic agent falls."
  1.  D ^DIR
  1.  ;
  1.  I +$G(DIRUT)!(+$G(Y)<1) D NOSELECT("IDENTIFIER")  Q
  1.  ;
  1.  S IDENTIFR=$S(Y=1:"B",Y=2:"F",Y=3:"P",Y=4:"M",Y=5:"V",Y=6:"C",Y=7:"D",1:"")
  1.  Q
  1.  ;
  1. ABBREV ; EP - ABBREVIATION
  1.  D ^XBCLS
  1.  S ABBREV=""
  1.  D ^XBFMK
  1.  S DIR(0)="FO^1:5"
  1.  S DIR("A")="ABBREVIATION"
  1.  D ^DIR
  1.  I +$G(DIRUT) D NOSELECT("CLASS/GROUP-TRIBE/FAMILY")  Q
  1.  ;
  1.  S ABBREV=$G(X)
  1.  Q
  1.  ;
  1. SUSEDITT ; EP - SUSCEPTIBILITY EDIT TEMPLATE
  1.  NEW ARRAY,CNT,DIRZERO,IEN,INDEX,TMPLNAME
  1.  ;
  1.  D ^XBCLS
  1.  S SUSEDITT=""
  1.  ;
  1.  S IEN=0
  1.  F  S IEN=$O(^DIE(IEN))  Q:IEN<1  D
  1.  . I $P($G(^DIE(IEN,0)),"^",4)=63  S ARRAY($P($G(^(0)),"^"))=IEN
  1.  ;
  1.  S DIRZERO="S^"
  1.  S CNT=0,TMPLNAME=""
  1.  F  S TMPLNAME=$O(ARRAY(TMPLNAME))  Q:TMPLNAME=""  D
  1.  . S CNT=CNT+1
  1.  . S DIRZERO=DIRZERO_CNT_":;"
  1.  . S DIRZERO(CNT)=$$LJ^XLFSTR($J(CNT,2)_") "_$E(TMPLNAME,1,18),26)
  1.  . S INDEX(CNT)=TMPLNAME
  1.  ;
  1.  ; Add EXIT/NO SELECTION
  1.  S CNT=CNT+1
  1.  S DIRZERO=DIRZERO_CNT_":;"
  1.  S DIRZERO(CNT)=$$LJ^XLFSTR($J(CNT,2)_") EXIT/NO SELECTION",26)
  1.  S INDEX(CNT)=""
  1.  ;
  1.  S CNT=CNT+1
  1.  S DIRZERO=DIRZERO_(CNT)_":AL"
  1.  ;
  1.  D ^XBFMK
  1.  S DIR(0)=DIRZERO
  1.  S DIR("L",1)="Select SUSCEPTIBILITY EDIT TEMPLATE:"
  1.  S DIR("L",2)=""
  1.  S BELOW=3
  1.  S CNT=0
  1.  F  S CNT=$O(DIRZERO(CNT))  Q:CNT<1  D
  1.  . S:(CNT#3)=1 DIR("L",BELOW)=$J("",2)
  1.  . S DIR("L",BELOW)=$G(DIR("L",BELOW))_DIRZERO(CNT)
  1.  . S:(CNT#3)=0 BELOW=BELOW+1
  1.  ;
  1.  S DIR("L")=""
  1.  S DIR("A")="Selection"
  1.  S DIR("?")="Contains the edit template name the etiologic agent is associated with."
  1.  S DIR("??")="Determines the set of antibiotics that will be shown for editing when this organism is chosen."
  1.  D ^DIR
  1.  ;
  1.  I +$G(DIRUT) D NOSELECT("SUSCEPTIBILITY EDIT TEMPLATE")  Q
  1.  ;
  1.  S SUSEDITT=$G(INDEX(Y))
  1.  Q
  1.  ;
  1. HDEPTRPT ; EP - HEALTH DEPT REPORT
  1.  D ^XBCLS
  1.  S HDEPTRPT=""
  1.  D ^XBFMK
  1.  S DIR(0)="YO"
  1.  S DIR("A")="HEALTH DEPARTMENT REPORT"
  1.  D ^DIR
  1.  I +$G(DIRUT) D NOSELECT("HEALTH DEPARTMENT REPORT")  Q
  1.  ;
  1.  S HDEPTRPT=$E(X)
  1.  Q
  1.  ;
  1. DISPLAY(IEN) ; EP - Display the entry in 61.2
  1.  S DA=IEN
  1.  S DIC="^LAB(61.2,"
  1.  D EN^DIQ
  1.  D PRESSKEY^BLRGMENU(9)
  1.  Q
  1.  ;
  1. NOSELECT(WOT) ; EP - Selection not done
  1.  W !,?4,WOT," not selected."
  1.  W !,?9,"None will be added to ETIOLOGY FIELD (#61.2) dictionary."
  1.  D PRESSKEY^BLRGMENU(4)
  1.  Q
  1.  ;
  1. ERRORS ; EP - ERRS Array has data.  Display it.
  1.  W !!,"ERRORS:",!
  1.  S J="ERRS"
  1.  S X=$G(@J)
  1.  W ?4,J,"=",X,!
  1.  F  S J=$Q(@J) Q:J=""  W ?9,J,"=",@J,!
  1.  ;
  1.  D PRESSKEY^BLRGMENU(4)
  1.  Q
  1.  ;
  1. TESTIT ; EP 
  1.  NEW ERRS,FDA
  1.  N SNOMEDSC,SNOMED,GRAMSTAN,IDENTIFR,ABBREV,SUSEDITT,HDEPTRPT,CGTRIBEF
  1.  ;
  1.  S SNOMEDSC="Rubella antibody screening"
  1.  S SNOMED=375964015
  1.  S GRAMSTAN="P"
  1.  S IDENTIFR="B"
  1.  S ABBREV="RAS"
  1.  S SUSEDITT="GNS"
  1.  S HDEPTRPT="Y"
  1.  S CGTRIBEF="ENTEB"
  1.  ;
  1.  S FDA(61.2,"+1,",.01)=SNOMEDSC
  1.  S FDA(61.2,"+1,",2)=SNOMED
  1.  S FDA(61.2,"+1,",3)=GRAMSTAN
  1.  S FDA(61.2,"+1,",4)=IDENTIFR
  1.  S FDA(61.2,"+1,",6)=ABBREV
  1.  S FDA(61.2,"+1,",8)=SUSEDITT
  1.  S FDA(61.2,"+1,",10)=HDEPTRPT
  1.  S FDA(61.2,"+1,",1.6)=CGTRIBEF
  1.  ;
  1.  D UPDATE^DIE("ES","FDA",,"ERRS")
  1.  I $D(ERRS) D ERRORS  Q
  1.  ;
  1.  D DISPLAY(+$$FIND1^DIC(61.2,,,SNOMEDSC))
  1.  Q