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

DGUTL4.m

Go to the documentation of this file.
  1. DGUTL4 ;BPFO/JRP - RACE & ETHNIC UTILITIES;9/5/2002
  1. ;;5.3;Registration;**415**;Aug 13, 1993
  1. ;
  1. PTR2TEXT(VALUE,TYPE) ;Convert pointer to text (.01 field)
  1. ;Input: VALUE - Pointer to RACE file (#10), ETHNICITY file (#10.2),
  1. ; or RACE AND ETHNICITY COLLECTION METHOD file (#10.3)
  1. ; TYPE - Flag indicating which file VALUE is for
  1. ; 1 = Race (default)
  1. ; 2 = Ethnicity
  1. ; 3 = Collection Method
  1. ;Output: Text (.01 field)
  1. ;Notes : NULL ("") returned on bad input or if there is no code
  1. ;
  1. ;Check input
  1. S VALUE=+$G(VALUE)
  1. I 'VALUE Q ""
  1. S TYPE=$G(TYPE)
  1. S:(TYPE'?1N) TYPE=1
  1. S:((TYPE<1)!(TYPE>3)) TYPE=1
  1. ;Declare variables
  1. N FILE,NODE
  1. ;Grab zero node
  1. S FILE=$S(TYPE=3:$NA(^DIC(10.3)),TYPE=2:$NA(^DIC(10.2)),1:$NA(^DIC(10)))
  1. S NODE=$G(@FILE@(VALUE,0))
  1. ;Return text
  1. Q $P(NODE,"^",1)
  1. ;
  1. INACTIVE(VALUE,TYPE) ;Entry marked as inactive ?
  1. ;Input: VALUE - Pointer to RACE file (#10) or ETHNICITY file (#10.2)
  1. ; TYPE - Flag indicating which file VALUE is for
  1. ; 1 = Race (default)
  1. ; 2 = Ethnicity
  1. ;Output: 0 - Entry not inactive
  1. ; 1^Date - Entry inactive (Date in FileMan format)
  1. ;Notes : 0 (zero) returned on bad input
  1. ; : Collection methods can not currently be inactivated
  1. ;
  1. ;Check input
  1. S VALUE=+$G(VALUE)
  1. I 'VALUE Q ""
  1. S TYPE=$G(TYPE)
  1. S:(TYPE'?1N) TYPE=1
  1. S:((TYPE<1)!(TYPE>2)) TYPE=1
  1. ;Declare variables
  1. N FILE,NODE,DATE
  1. ;Grab inactivation node
  1. S FILE=$S(TYPE=2:$NA(^DIC(10.2)),1:$NA(^DIC(10)))
  1. S NODE=$G(@FILE@(VALUE,.02))
  1. ;Grab inactivation date
  1. S DATE=$P(NODE,"^",2)
  1. ;Not inactive
  1. I (('NODE)&('DATE)) Q 0
  1. ;Inactive - include inactivation date
  1. Q "1^"_DATE
  1. ;
  1. PTR2CODE(VALUE,TYPE,CODE) ;Convert pointer to specified code
  1. ;Input: VALUE - Pointer to RACE file (#10), ETHNICITY file (#10.2),
  1. ; or RACE AND ETHNICITY COLLECTION METHOD file (#10.3)
  1. ; TYPE - Flag indicating which file VALUE is for
  1. ; 1 = Race (default)
  1. ; 2 = Ethnicity
  1. ; 3 = Collection Method
  1. ; CODE - Flag indicating which code to return
  1. ; 1 = Abbreviation (default)
  1. ; 2 = HL7
  1. ; 3 = CDC (not applicable for Collection Method)
  1. ; 4 = PTF
  1. ;Output: Requested code
  1. ;Notes : NULL ("") returned on bad input or if there is no code
  1. ;
  1. ;Check input
  1. S VALUE=+$G(VALUE)
  1. I 'VALUE Q ""
  1. S TYPE=$G(TYPE)
  1. S:(TYPE'?1N) TYPE=1
  1. S:((TYPE<1)!(TYPE>3)) TYPE=1
  1. S CODE=$G(CODE)
  1. S:(CODE'?1N) CODE=1
  1. S:((CODE<1)!(CODE>4)) CODE=1
  1. ;No CDC code for Collection Method
  1. I ((TYPE=3)&(CODE=3)) Q ""
  1. ;Declare variables
  1. N FILE,NODEREF,NODE,PIECE
  1. ;Grab node storing code
  1. S FILE=$S(TYPE=3:$NA(^DIC(10.3)),TYPE=2:$NA(^DIC(10.2)),1:$NA(^DIC(10)))
  1. S NODEREF=0
  1. S NODE=$G(@FILE@(VALUE,NODEREF))
  1. ;Determine which piece requested code is in
  1. S PIECE=CODE+1
  1. ;Return requested code
  1. Q $P(NODE,"^",PIECE)
  1. ;
  1. CODE2PTR(VALUE,TYPE,CODE) ;Convert specified code to pointer
  1. ;Input: VALUE - Code to convert
  1. ; TYPE - Flag indicating which file VALUE is from
  1. ; 1 = Race (file #10) (default)
  1. ; 2 = Ethnicity (file #10.2)
  1. ; 3 = Collection Method (file #10.3)
  1. ; CODE - Flag indicating which code VALUE is for
  1. ; 1 = Abbreviation (default)
  1. ; 2 = HL7
  1. ; 3 = CDC (not applicable for Collection Method)
  1. ; 4 = PTF
  1. ;Output: Pointer to file
  1. ;Notes : 0 (zero) returned on bad input or if an entry can't be found
  1. ;
  1. ;Check input
  1. S VALUE=$G(VALUE)
  1. I VALUE="" Q 0
  1. S TYPE=$G(TYPE)
  1. S:(TYPE'?1N) TYPE=1
  1. S:((TYPE<1)!(TYPE>3)) TYPE=1
  1. S CODE=$G(CODE)
  1. S:(CODE'?1N) CODE=1
  1. S:((CODE<1)!(CODE>4)) CODE=1
  1. ;No CDC code for Collection Method
  1. I ((TYPE=3)&(CODE=3)) Q 0
  1. ;Declare variables
  1. N PTR,FILE,NODEREF,PIECE,FOUND
  1. S FILE=$S(TYPE=3:$NA(^DIC(10.3)),TYPE=2:$NA(^DIC(10.2)),1:$NA(^DIC(10)))
  1. ;Abbreviation and HL7 have x-refs
  1. I ((CODE=1)!(CODE=2)) D Q PTR
  1. .;Get pointer using x-ref
  1. .S NODEREF=$S(CODE=2:"AHL7",1:"C")
  1. .S PTR=+$O(@FILE@(NODEREF,VALUE,0))
  1. ;CDC and PTF don't have x-refs - loop through file looking for match
  1. ;Node & piece code is stored on
  1. S NODEREF=0
  1. S PIECE=CODE+1
  1. S FOUND=0
  1. S PTR=0
  1. F S PTR=+$O(@FILE@(PTR)) Q:'PTR D Q:FOUND
  1. .S NODE=$G(@FILE@(PTR,NODEREF))
  1. .I $P(NODE,"^",PIECE)=VALUE S FOUND=1
  1. Q PTR