source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VAFHLRO3.m@ 1724

Last change on this file since 1724 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.4 KB
RevLine 
[613]1VAFHLRO3 ;BP/JRP - OUTPATIENT HL7 ROLE SEGMENT UTILITIES;12/16/1997 ; 6/14/01 12:54pm
2 ;;5.3;Registration;**160,215,389**;Aug 13, 1993
3 ;
4ROLE(PTR200,ARRAY,NULL,DATE) ;Build HL7 Role using info from Person Class
5 ; file (#8932.1)
6 ;
7 ;Input : PTR200 - Pointer to entry in New Person file (#200)
8 ; ARRAY - Array to store info in (full global reference)
9 ; NULL - HL7 null designation
10 ; DATE - (optional) "as of" date to obtain person role
11 ;Output : ARRAY(comp#) = Value
12 ; ARRAY(comp#,sub#) = Value
13 ; Comp 1: Role ID
14 ; Comp 2: 3 Sub-components
15 ; Sub 1: Profession
16 ; Sub 2: Specialty
17 ; Sub 3: Sub-specialty
18 ; Comp 3: VA8932.1 (literal)
19 ;Notes : Existance and validity of input is assumed
20 ; : Initializtion (i.e. KILLing) of ARRAY() must be done by the
21 ; calling program
22 ; : ARRAY() will not be set if role can not be calculated
23 ;
24 ;Declare variables
25 N CLASSINF,STRING
26 ;Set up role date
27 S DATE=$G(DATE)\1 S:(DATE'?7N)!(DATE>DT) DATE=DT
28 ;Get class info from Person Class file (#8932.1)
29 S CLASSINF=$$GET^XUA4A72(PTR200,DATE)
30 Q:(CLASSINF<0)
31 ;Person Class Code (comp #1)
32 S STRING=$P(CLASSINF,"^",7)
33 Q:(STRING="") NULL
34 S @ARRAY@(1)=STRING
35 ;Build component #2
36 ;Profession (comp #2 - sub #1)
37 S STRING=$P(CLASSINF,"^",2)
38 S:(STRING="") STRING=NULL
39 S @ARRAY@(2,1)=STRING
40 ;Specialty (comp #2 - sub #2)
41 S STRING=$P(CLASSINF,"^",3)
42 S:(STRING="") STRING=NULL
43 S @ARRAY@(2,2)=STRING
44 ;Sub-specialty (comp #2 - sub #3)
45 S STRING=$P(CLASSINF,"^",4)
46 S:(STRING="") STRING=NULL
47 S @ARRAY@(2,3)=STRING
48 ;Table identifier (comp #3)
49 S @ARRAY@(3)="VA8932.1"
50 ;Done
51 Q
52 ;
53PERSON(PTR200,ARRAY,NULL) ;Build HL7 Role Person using info from New
54 ; Person file (#200)
55 ;
56 ;Input : PTR200 - Pointer to entry in New Person file (#200)
57 ; ARRAY - Array to store info in (full global reference)
58 ; NULL - HL7 null designation
59 ;Output : ARRAY(1,comp#) = Value
60 ; ARRAY(1,comp#,sub#) = Value
61 ; Comp 1: 2 Sub-components
62 ; Sub 1: DUZ
63 ; Sub 2: Facility number
64 ; Comp 2 - 7: Name in HL7 format
65 ; Comp 8: VA200 (literal)
66 ; ARRAY(2,comp#) = Value
67 ; Comp 1: Provider SSN
68 ; Comp 9: Social Security Administration (literal)
69 ;Notes : Existance and validity of input is assumed
70 ; : Initializtion (i.e. KILLing) of ARRAY() must be done by the
71 ; calling program
72 ; : ARRAY() will not be set if role can not be calculated
73 ;
74 ;Declare variables
75 N STRING,SUBSTR,TMP,DGNAME
76 ;Build component #1
77 ;DUZ (comp #1 - sub #1)
78 S @ARRAY@(1,1,1)=PTR200
79 ;Facility number (comp #1 - sub #2)
80 S STRING=+$P($$SITE^VASITE(),"^",3)
81 I ('STRING) K @ARRAY@(1,1,1) Q
82 S @ARRAY@(1,1,2)=STRING
83 ;Build components #2 - 7
84 ;Get name from New Person file
85 S TMP=$G(^VA(200,PTR200,0))
86 S SUBSTR=$P(TMP,"^",1)
87 ;Convert to HL7 format
88 S DGNAME("FILE")=200,DGNAME("IENS")=PTR200,DGNAME("FIELD")=.01
89 S STRING=$$HLNAME^XLFNAME(.DGNAME,"S","~")
90 F TMP=1:1:6 D
91 .S SUBSTR=$P(STRING,"~",TMP)
92 .S:(SUBSTR="") SUBSTR=NULL
93 .S @ARRAY@(1,TMP+1)=SUBSTR
94 ;Table identifier (comp #8)
95 S @ARRAY@(1,8)="VA200"
96 ; repeat seq #4 (Patch DG*5.3*389)
97 ; get SSN (comp #1)
98 S STRING=$P($G(^VA(200,PTR200,1)),"^",9)
99 S:(STRING'?9N) STRING=NULL
100 S @ARRAY@(2,1)=STRING
101 F TMP=1:1:7 S @ARRAY@(2,TMP+1)=NULL
102 ; Assigning authority (comp #9) - Social Security Administration
103 S @ARRAY@(2,9)="SSA"
104 ;Done
105 Q
Note: See TracBrowser for help on using the repository browser.