Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VAFHLRO3

VAFHLRO3.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ROLE(PTR200,ARRAY,NULL,DATE) ;Build HL7 Role using info from Person Class
  1. ; file (#8932.1)
  1. ;
  1. ;Input : PTR200 - Pointer to entry in New Person file (#200)
  1. ; ARRAY - Array to store info in (full global reference)
  1. ; NULL - HL7 null designation
  1. ; DATE - (optional) "as of" date to obtain person role
  1. ;Output : ARRAY(comp#) = Value
  1. ; ARRAY(comp#,sub#) = Value
  1. ; Comp 1: Role ID
  1. ; Comp 2: 3 Sub-components
  1. ; Sub 1: Profession
  1. ; Sub 2: Specialty
  1. ; Sub 3: Sub-specialty
  1. ; Comp 3: VA8932.1 (literal)
  1. ;Notes : Existance and validity of input is assumed
  1. ; : Initializtion (i.e. KILLing) of ARRAY() must be done by the
  1. ; calling program
  1. ; : ARRAY() will not be set if role can not be calculated
  1. ;
  1. ;Declare variables
  1. N CLASSINF,STRING
  1. ;Set up role date
  1. S DATE=$G(DATE)\1 S:(DATE'?7N)!(DATE>DT) DATE=DT
  1. ;Get class info from Person Class file (#8932.1)
  1. S CLASSINF=$$GET^XUA4A72(PTR200,DATE)
  1. Q:(CLASSINF<0)
  1. ;Person Class Code (comp #1)
  1. S STRING=$P(CLASSINF,"^",7)
  1. Q:(STRING="") NULL
  1. S @ARRAY@(1)=STRING
  1. ;Build component #2
  1. ;Profession (comp #2 - sub #1)
  1. S STRING=$P(CLASSINF,"^",2)
  1. S:(STRING="") STRING=NULL
  1. S @ARRAY@(2,1)=STRING
  1. ;Specialty (comp #2 - sub #2)
  1. S STRING=$P(CLASSINF,"^",3)
  1. S:(STRING="") STRING=NULL
  1. S @ARRAY@(2,2)=STRING
  1. ;Sub-specialty (comp #2 - sub #3)
  1. S STRING=$P(CLASSINF,"^",4)
  1. S:(STRING="") STRING=NULL
  1. S @ARRAY@(2,3)=STRING
  1. ;Table identifier (comp #3)
  1. S @ARRAY@(3)="VA8932.1"
  1. ;Done
  1. Q
  1. ;
  1. PERSON(PTR200,ARRAY,NULL) ;Build HL7 Role Person using info from New
  1. ; Person file (#200)
  1. ;
  1. ;Input : PTR200 - Pointer to entry in New Person file (#200)
  1. ; ARRAY - Array to store info in (full global reference)
  1. ; NULL - HL7 null designation
  1. ;Output : ARRAY(1,comp#) = Value
  1. ; ARRAY(1,comp#,sub#) = Value
  1. ; Comp 1: 2 Sub-components
  1. ; Sub 1: DUZ
  1. ; Sub 2: Facility number
  1. ; Comp 2 - 7: Name in HL7 format
  1. ; Comp 8: VA200 (literal)
  1. ; ARRAY(2,comp#) = Value
  1. ; Comp 1: Provider SSN
  1. ; Comp 9: Social Security Administration (literal)
  1. ;Notes : Existance and validity of input is assumed
  1. ; : Initializtion (i.e. KILLing) of ARRAY() must be done by the
  1. ; calling program
  1. ; : ARRAY() will not be set if role can not be calculated
  1. ;
  1. ;Declare variables
  1. N STRING,SUBSTR,TMP,DGNAME
  1. ;Build component #1
  1. ;DUZ (comp #1 - sub #1)
  1. S @ARRAY@(1,1,1)=PTR200
  1. ;Facility number (comp #1 - sub #2)
  1. S STRING=+$P($$SITE^VASITE(),"^",3)
  1. I ('STRING) K @ARRAY@(1,1,1) Q
  1. S @ARRAY@(1,1,2)=STRING
  1. ;Build components #2 - 7
  1. ;Get name from New Person file
  1. S TMP=$G(^VA(200,PTR200,0))
  1. S SUBSTR=$P(TMP,"^",1)
  1. ;Convert to HL7 format
  1. S DGNAME("FILE")=200,DGNAME("IENS")=PTR200,DGNAME("FIELD")=.01
  1. S STRING=$$HLNAME^XLFNAME(.DGNAME,"S","~")
  1. F TMP=1:1:6 D
  1. .S SUBSTR=$P(STRING,"~",TMP)
  1. .S:(SUBSTR="") SUBSTR=NULL
  1. .S @ARRAY@(1,TMP+1)=SUBSTR
  1. ;Table identifier (comp #8)
  1. S @ARRAY@(1,8)="VA200"
  1. ; repeat seq #4 (Patch DG*5.3*389)
  1. ; get SSN (comp #1)
  1. S STRING=$P($G(^VA(200,PTR200,1)),"^",9)
  1. S:(STRING'?9N) STRING=NULL
  1. S @ARRAY@(2,1)=STRING
  1. F TMP=1:1:7 S @ARRAY@(2,TMP+1)=NULL
  1. ; Assigning authority (comp #9) - Social Security Administration
  1. S @ARRAY@(2,9)="SSA"
  1. ;Done
  1. Q