- 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 Feb 19, 2025@00:29:15 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