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