VAFHLRO3 ;BP/JRP - OUTPATIENT HL7 ROLE SEGMENT UTILITIES;12/16/1997 ; 6/14/01 12:54pm
;;5.3;Registration;**160,215,389**;Aug 13, 1993
;
ROLE(PTR200,ARRAY,NULL,DATE) ;Build HL7 Role using info from Person Class
; file (#8932.1)
;
;Input : PTR200 - Pointer to entry in New Person file (#200)
; ARRAY - Array to store info in (full global reference)
; NULL - HL7 null designation
; DATE - (optional) "as of" date to obtain person role
;Output : ARRAY(comp#) = Value
; ARRAY(comp#,sub#) = Value
; Comp 1: Role ID
; Comp 2: 3 Sub-components
; Sub 1: Profession
; Sub 2: Specialty
; Sub 3: Sub-specialty
; Comp 3: VA8932.1 (literal)
;Notes : Existance and validity of input is assumed
; : Initializtion (i.e. KILLing) of ARRAY() must be done by the
; calling program
; : ARRAY() will not be set if role can not be calculated
;
;Declare variables
N CLASSINF,STRING
;Set up role date
S DATE=$G(DATE)\1 S:(DATE'?7N)!(DATE>DT) DATE=DT
;Get class info from Person Class file (#8932.1)
S CLASSINF=$$GET^XUA4A72(PTR200,DATE)
Q:(CLASSINF<0)
;Person Class Code (comp #1)
S STRING=$P(CLASSINF,"^",7)
Q:(STRING="") NULL
S @ARRAY@(1)=STRING
;Build component #2
;Profession (comp #2 - sub #1)
S STRING=$P(CLASSINF,"^",2)
S:(STRING="") STRING=NULL
S @ARRAY@(2,1)=STRING
;Specialty (comp #2 - sub #2)
S STRING=$P(CLASSINF,"^",3)
S:(STRING="") STRING=NULL
S @ARRAY@(2,2)=STRING
;Sub-specialty (comp #2 - sub #3)
S STRING=$P(CLASSINF,"^",4)
S:(STRING="") STRING=NULL
S @ARRAY@(2,3)=STRING
;Table identifier (comp #3)
S @ARRAY@(3)="VA8932.1"
;Done
Q
;
PERSON(PTR200,ARRAY,NULL) ;Build HL7 Role Person using info from New
; Person file (#200)
;
;Input : PTR200 - Pointer to entry in New Person file (#200)
; ARRAY - Array to store info in (full global reference)
; NULL - HL7 null designation
;Output : ARRAY(1,comp#) = Value
; ARRAY(1,comp#,sub#) = Value
; Comp 1: 2 Sub-components
; Sub 1: DUZ
; Sub 2: Facility number
; Comp 2 - 7: Name in HL7 format
; Comp 8: VA200 (literal)
; ARRAY(2,comp#) = Value
; Comp 1: Provider SSN
; Comp 9: Social Security Administration (literal)
;Notes : Existance and validity of input is assumed
; : Initializtion (i.e. KILLing) of ARRAY() must be done by the
; calling program
; : ARRAY() will not be set if role can not be calculated
;
;Declare variables
N STRING,SUBSTR,TMP,DGNAME
;Build component #1
;DUZ (comp #1 - sub #1)
S @ARRAY@(1,1,1)=PTR200
;Facility number (comp #1 - sub #2)
S STRING=+$P($$SITE^VASITE(),"^",3)
I ('STRING) K @ARRAY@(1,1,1) Q
S @ARRAY@(1,1,2)=STRING
;Build components #2 - 7
;Get name from New Person file
S TMP=$G(^VA(200,PTR200,0))
S SUBSTR=$P(TMP,"^",1)
;Convert to HL7 format
S DGNAME("FILE")=200,DGNAME("IENS")=PTR200,DGNAME("FIELD")=.01
S STRING=$$HLNAME^XLFNAME(.DGNAME,"S","~")
F TMP=1:1:6 D
.S SUBSTR=$P(STRING,"~",TMP)
.S:(SUBSTR="") SUBSTR=NULL
.S @ARRAY@(1,TMP+1)=SUBSTR
;Table identifier (comp #8)
S @ARRAY@(1,8)="VA200"
; repeat seq #4 (Patch DG*5.3*389)
; get SSN (comp #1)
S STRING=$P($G(^VA(200,PTR200,1)),"^",9)
S:(STRING'?9N) STRING=NULL
S @ARRAY@(2,1)=STRING
F TMP=1:1:7 S @ARRAY@(2,TMP+1)=NULL
; Assigning authority (comp #9) - Social Security Administration
S @ARRAY@(2,9)="SSA"
;Done
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFHLRO3 3609 printed Sep 23, 2025@20:39:07 Page 2
VAFHLRO3 ;BP/JRP - OUTPATIENT HL7 ROLE SEGMENT UTILITIES;12/16/1997 ; 6/14/01 12:54pm
+1 ;;5.3;Registration;**160,215,389**;Aug 13, 1993
+2 ;
ROLE(PTR200,ARRAY,NULL,DATE) ;Build HL7 Role using info from Person Class
+1 ; file (#8932.1)
+2 ;
+3 ;Input : PTR200 - Pointer to entry in New Person file (#200)
+4 ; ARRAY - Array to store info in (full global reference)
+5 ; NULL - HL7 null designation
+6 ; DATE - (optional) "as of" date to obtain person role
+7 ;Output : ARRAY(comp#) = Value
+8 ; ARRAY(comp#,sub#) = Value
+9 ; Comp 1: Role ID
+10 ; Comp 2: 3 Sub-components
+11 ; Sub 1: Profession
+12 ; Sub 2: Specialty
+13 ; Sub 3: Sub-specialty
+14 ; Comp 3: VA8932.1 (literal)
+15 ;Notes : Existance and validity of input is assumed
+16 ; : Initializtion (i.e. KILLing) of ARRAY() must be done by the
+17 ; calling program
+18 ; : ARRAY() will not be set if role can not be calculated
+19 ;
+20 ;Declare variables
+21 NEW CLASSINF,STRING
+22 ;Set up role date
+23 SET DATE=$GET(DATE)\1
if (DATE'?7N)!(DATE>DT)
SET DATE=DT
+24 ;Get class info from Person Class file (#8932.1)
+25 SET CLASSINF=$$GET^XUA4A72(PTR200,DATE)
+26 if (CLASSINF<0)
QUIT
+27 ;Person Class Code (comp #1)
+28 SET STRING=$PIECE(CLASSINF,"^",7)
+29 if (STRING="")
QUIT NULL
+30 SET @ARRAY@(1)=STRING
+31 ;Build component #2
+32 ;Profession (comp #2 - sub #1)
+33 SET STRING=$PIECE(CLASSINF,"^",2)
+34 if (STRING="")
SET STRING=NULL
+35 SET @ARRAY@(2,1)=STRING
+36 ;Specialty (comp #2 - sub #2)
+37 SET STRING=$PIECE(CLASSINF,"^",3)
+38 if (STRING="")
SET STRING=NULL
+39 SET @ARRAY@(2,2)=STRING
+40 ;Sub-specialty (comp #2 - sub #3)
+41 SET STRING=$PIECE(CLASSINF,"^",4)
+42 if (STRING="")
SET STRING=NULL
+43 SET @ARRAY@(2,3)=STRING
+44 ;Table identifier (comp #3)
+45 SET @ARRAY@(3)="VA8932.1"
+46 ;Done
+47 QUIT
+48 ;
PERSON(PTR200,ARRAY,NULL) ;Build HL7 Role Person using info from New
+1 ; Person file (#200)
+2 ;
+3 ;Input : PTR200 - Pointer to entry in New Person file (#200)
+4 ; ARRAY - Array to store info in (full global reference)
+5 ; NULL - HL7 null designation
+6 ;Output : ARRAY(1,comp#) = Value
+7 ; ARRAY(1,comp#,sub#) = Value
+8 ; Comp 1: 2 Sub-components
+9 ; Sub 1: DUZ
+10 ; Sub 2: Facility number
+11 ; Comp 2 - 7: Name in HL7 format
+12 ; Comp 8: VA200 (literal)
+13 ; ARRAY(2,comp#) = Value
+14 ; Comp 1: Provider SSN
+15 ; Comp 9: Social Security Administration (literal)
+16 ;Notes : Existance and validity of input is assumed
+17 ; : Initializtion (i.e. KILLing) of ARRAY() must be done by the
+18 ; calling program
+19 ; : ARRAY() will not be set if role can not be calculated
+20 ;
+21 ;Declare variables
+22 NEW STRING,SUBSTR,TMP,DGNAME
+23 ;Build component #1
+24 ;DUZ (comp #1 - sub #1)
+25 SET @ARRAY@(1,1,1)=PTR200
+26 ;Facility number (comp #1 - sub #2)
+27 SET STRING=+$PIECE($$SITE^VASITE(),"^",3)
+28 IF ('STRING)
KILL @ARRAY@(1,1,1)
QUIT
+29 SET @ARRAY@(1,1,2)=STRING
+30 ;Build components #2 - 7
+31 ;Get name from New Person file
+32 SET TMP=$GET(^VA(200,PTR200,0))
+33 SET SUBSTR=$PIECE(TMP,"^",1)
+34 ;Convert to HL7 format
+35 SET DGNAME("FILE")=200
SET DGNAME("IENS")=PTR200
SET DGNAME("FIELD")=.01
+36 SET STRING=$$HLNAME^XLFNAME(.DGNAME,"S","~")
+37 FOR TMP=1:1:6
Begin DoDot:1
+38 SET SUBSTR=$PIECE(STRING,"~",TMP)
+39 if (SUBSTR="")
SET SUBSTR=NULL
+40 SET @ARRAY@(1,TMP+1)=SUBSTR
End DoDot:1
+41 ;Table identifier (comp #8)
+42 SET @ARRAY@(1,8)="VA200"
+43 ; repeat seq #4 (Patch DG*5.3*389)
+44 ; get SSN (comp #1)
+45 SET STRING=$PIECE($GET(^VA(200,PTR200,1)),"^",9)
+46 if (STRING'?9N)
SET STRING=NULL
+47 SET @ARRAY@(2,1)=STRING
+48 FOR TMP=1:1:7
SET @ARRAY@(2,TMP+1)=NULL
+49 ; Assigning authority (comp #9) - Social Security Administration
+50 SET @ARRAY@(2,9)="SSA"
+51 ;Done
+52 QUIT
