- 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 Feb 19, 2025@00:25:11 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