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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGUTL4 4507 printed Apr 09, 2024@21:53:22 Page 2
DGUTL4 ;BPFO/JRP - RACE & ETHNIC UTILITIES;9/5/2002
+1 ;;5.3;Registration;**415**;Aug 13, 1993
+2 ;
PTR2TEXT(VALUE,TYPE) ;Convert pointer to text (.01 field)
+1 ;Input: VALUE - Pointer to RACE file (#10), ETHNICITY file (#10.2),
+2 ; or RACE AND ETHNICITY COLLECTION METHOD file (#10.3)
+3 ; TYPE - Flag indicating which file VALUE is for
+4 ; 1 = Race (default)
+5 ; 2 = Ethnicity
+6 ; 3 = Collection Method
+7 ;Output: Text (.01 field)
+8 ;Notes : NULL ("") returned on bad input or if there is no code
+9 ;
+10 ;Check input
+11 SET VALUE=+$GET(VALUE)
+12 IF 'VALUE
QUIT ""
+13 SET TYPE=$GET(TYPE)
+14 if (TYPE'?1N)
SET TYPE=1
+15 if ((TYPE<1)!(TYPE>3))
SET TYPE=1
+16 ;Declare variables
+17 NEW FILE,NODE
+18 ;Grab zero node
+19 SET FILE=$SELECT(TYPE=3:$NAME(^DIC(10.3)),TYPE=2:$NAME(^DIC(10.2)),1:$NAME(^DIC(10)))
+20 SET NODE=$GET(@FILE@(VALUE,0))
+21 ;Return text
+22 QUIT $PIECE(NODE,"^",1)
+23 ;
INACTIVE(VALUE,TYPE) ;Entry marked as inactive ?
+1 ;Input: VALUE - Pointer to RACE file (#10) or ETHNICITY file (#10.2)
+2 ; TYPE - Flag indicating which file VALUE is for
+3 ; 1 = Race (default)
+4 ; 2 = Ethnicity
+5 ;Output: 0 - Entry not inactive
+6 ; 1^Date - Entry inactive (Date in FileMan format)
+7 ;Notes : 0 (zero) returned on bad input
+8 ; : Collection methods can not currently be inactivated
+9 ;
+10 ;Check input
+11 SET VALUE=+$GET(VALUE)
+12 IF 'VALUE
QUIT ""
+13 SET TYPE=$GET(TYPE)
+14 if (TYPE'?1N)
SET TYPE=1
+15 if ((TYPE<1)!(TYPE>2))
SET TYPE=1
+16 ;Declare variables
+17 NEW FILE,NODE,DATE
+18 ;Grab inactivation node
+19 SET FILE=$SELECT(TYPE=2:$NAME(^DIC(10.2)),1:$NAME(^DIC(10)))
+20 SET NODE=$GET(@FILE@(VALUE,.02))
+21 ;Grab inactivation date
+22 SET DATE=$PIECE(NODE,"^",2)
+23 ;Not inactive
+24 IF (('NODE)&('DATE))
QUIT 0
+25 ;Inactive - include inactivation date
+26 QUIT "1^"_DATE
+27 ;
PTR2CODE(VALUE,TYPE,CODE) ;Convert pointer to specified code
+1 ;Input: VALUE - Pointer to RACE file (#10), ETHNICITY file (#10.2),
+2 ; or RACE AND ETHNICITY COLLECTION METHOD file (#10.3)
+3 ; TYPE - Flag indicating which file VALUE is for
+4 ; 1 = Race (default)
+5 ; 2 = Ethnicity
+6 ; 3 = Collection Method
+7 ; CODE - Flag indicating which code to return
+8 ; 1 = Abbreviation (default)
+9 ; 2 = HL7
+10 ; 3 = CDC (not applicable for Collection Method)
+11 ; 4 = PTF
+12 ;Output: Requested code
+13 ;Notes : NULL ("") returned on bad input or if there is no code
+14 ;
+15 ;Check input
+16 SET VALUE=+$GET(VALUE)
+17 IF 'VALUE
QUIT ""
+18 SET TYPE=$GET(TYPE)
+19 if (TYPE'?1N)
SET TYPE=1
+20 if ((TYPE<1)!(TYPE>3))
SET TYPE=1
+21 SET CODE=$GET(CODE)
+22 if (CODE'?1N)
SET CODE=1
+23 if ((CODE<1)!(CODE>4))
SET CODE=1
+24 ;No CDC code for Collection Method
+25 IF ((TYPE=3)&(CODE=3))
QUIT ""
+26 ;Declare variables
+27 NEW FILE,NODEREF,NODE,PIECE
+28 ;Grab node storing code
+29 SET FILE=$SELECT(TYPE=3:$NAME(^DIC(10.3)),TYPE=2:$NAME(^DIC(10.2)),1:$NAME(^DIC(10)))
+30 SET NODEREF=0
+31 SET NODE=$GET(@FILE@(VALUE,NODEREF))
+32 ;Determine which piece requested code is in
+33 SET PIECE=CODE+1
+34 ;Return requested code
+35 QUIT $PIECE(NODE,"^",PIECE)
+36 ;
CODE2PTR(VALUE,TYPE,CODE) ;Convert specified code to pointer
+1 ;Input: VALUE - Code to convert
+2 ; TYPE - Flag indicating which file VALUE is from
+3 ; 1 = Race (file #10) (default)
+4 ; 2 = Ethnicity (file #10.2)
+5 ; 3 = Collection Method (file #10.3)
+6 ; CODE - Flag indicating which code VALUE is for
+7 ; 1 = Abbreviation (default)
+8 ; 2 = HL7
+9 ; 3 = CDC (not applicable for Collection Method)
+10 ; 4 = PTF
+11 ;Output: Pointer to file
+12 ;Notes : 0 (zero) returned on bad input or if an entry can't be found
+13 ;
+14 ;Check input
+15 SET VALUE=$GET(VALUE)
+16 IF VALUE=""
QUIT 0
+17 SET TYPE=$GET(TYPE)
+18 if (TYPE'?1N)
SET TYPE=1
+19 if ((TYPE<1)!(TYPE>3))
SET TYPE=1
+20 SET CODE=$GET(CODE)
+21 if (CODE'?1N)
SET CODE=1
+22 if ((CODE<1)!(CODE>4))
SET CODE=1
+23 ;No CDC code for Collection Method
+24 IF ((TYPE=3)&(CODE=3))
QUIT 0
+25 ;Declare variables
+26 NEW PTR,FILE,NODEREF,PIECE,FOUND
+27 SET FILE=$SELECT(TYPE=3:$NAME(^DIC(10.3)),TYPE=2:$NAME(^DIC(10.2)),1:$NAME(^DIC(10)))
+28 ;Abbreviation and HL7 have x-refs
+29 IF ((CODE=1)!(CODE=2))
Begin DoDot:1
+30 ;Get pointer using x-ref
+31 SET NODEREF=$SELECT(CODE=2:"AHL7",1:"C")
+32 SET PTR=+$ORDER(@FILE@(NODEREF,VALUE,0))
End DoDot:1
QUIT PTR
+33 ;CDC and PTF don't have x-refs - loop through file looking for match
+34 ;Node & piece code is stored on
+35 SET NODEREF=0
+36 SET PIECE=CODE+1
+37 SET FOUND=0
+38 SET PTR=0
+39 FOR
SET PTR=+$ORDER(@FILE@(PTR))
if 'PTR
QUIT
Begin DoDot:1
+40 SET NODE=$GET(@FILE@(PTR,NODEREF))
+41 IF $PIECE(NODE,"^",PIECE)=VALUE
SET FOUND=1
End DoDot:1
if FOUND
QUIT
+42 QUIT PTR
