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

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

initial load of WorldVistAEHR
File size: 5.4 KB
RevLine 
[613]1VAFHLRO2 ;BP/JRP - BUILD OUTPATIENT HL7 ROLE SEGMENT;11/18/1997 ; 7/3/01 4:09pm
2 ;;5.3;Registration;**160,215,389**;Aug 13, 1993
3 ;
4 ; ** Do not call this routine directly **
5 ; ** Use supported call OUTPAT^VAFHLROL **
6 ;
7OUTPAT ;Build role segment for transmission of outpatient data
8 ;
9 ;Input : As defined in OUTPAT^VAFHLROL
10 ;Output : As defined in OUTPAT^VAFHLROL
11 ;Notes : Existance & validity of input assumed
12 ; : Refer to OUTPAT^VAFHLROL for details
13 ;
14 ;Declare variables
15 N PTR200,CODEONLY,INSTID,ACTION,ROLE,ALTROLE,PERSON,TMP,RDATE
16 N VAFHLROL,CMPSEP,REPSEP,ESCSEP,SUBSEP
17 ;Break out individual seperators from encoding characters
18 S CMPSEP=$E(ENCODE,1)
19 S REPSEP=$E(ENCODE,2)
20 S ESCSEP=$E(ENCODE,3)
21 S SUBSEP=$E(ENCODE,4)
22 ;Initialize output array
23 K @OUTARR S @OUTARR@(0)=""
24 ;Get pointer to provider out of parameter array
25 S PTR200=+$G(@PARAM@("PTR200"))
26 S:('$D(^VA(200,PTR200,0))) PTR200=0
27 ;Get internal/external flag
28 S CODEONLY=+$G(@PARAM@("CODEONLY"))
29 ;Build segment into temporary location
30 S VAFHLROL(0)="ROL"
31S1 ;Role Instance ID (seq #1)
32 S INSTID=$G(@PARAM@("INSTID"),NULL)
33 S TMP=$P(INSTID,CMPSEP,1)
34 D:((TMP=NULL)!(TMP="")) ERROR^VAFHLRO1(1,OUTARR,"could not be determined")
35 S VAFHLROL(1)=FLDSEP_INSTID
36S2 ;Action Code (seq #2)
37 S ACTION=$G(@PARAM@("ACTION"),NULL)
38 S TMP=",AD,UP,DE,CO,LI,UN,UC,"
39 I (TMP'[(","_ACTION_",")) D
40 .I ((ACTION=NULL)!(ACTION="")) D ERROR^VAFHLRO1(2,OUTARR,"could not be determined") Q
41 .D ERROR^VAFHLRO1(2,OUTARR,"was not valid")
42 S VAFHLROL(2)=FLDSEP_ACTION
43S3 ;Role (seq #3, comp #1 - 3)
44 I ($D(@PARAM@("ROLE"))) D G S3C4
45 .;Use input value
46 .S ROLE=$G(@PARAM@("ROLE"),NULL)
47 .I ((ROLE="")!(ROLE=NULL)) D ERROR^VAFHLRO1(3,OUTARR,"could not be determined")
48 .S TMP=$P(ROLE,CMPSEP,1)
49 .S:(TMP="") TMP=NULL
50 .S VAFHLROL(3,1)=FLDSEP_TMP
51 .S TMP=$P(ROLE,CMPSEP,2)
52 .S:(TMP="") TMP=NULL
53 .S VAFHLROL(3,2)=CMPSEP_TMP
54 .S TMP=$P(ROLE,CMPSEP,3)
55 .S:(TMP="") TMP=NULL
56 .S VAFHLROL(3,3)=CMPSEP_TMP
57 ;Calculate value
58 I ('PTR200) D G S3C4
59 .D ERROR^VAFHLRO1(3,OUTARR,"could not be determined")
60 .S VAFHLROL(3)=FLDSEP_NULL_CMPSEP_NULL_CMPSEP_NULL
61 K ROLE S RDATE=$G(@PARAM@("RDATE"))
62 D ROLE^VAFHLRO3(PTR200,"ROLE",NULL,RDATE)
63 I ('$D(ROLE)) D G S3C4
64 .D ERROR^VAFHLRO1(3,OUTARR,"could not be determined")
65 .S VAFHLROL(3)=FLDSEP_NULL_CMPSEP_NULL_CMPSEP_NULL
66 ;Strip out external values
67 I (CODEONLY) F TMP=1:1:3 S ROLE(2,TMP)=NULL
68 ;Copy and add appropriate seperators
69 ; (Convert any HL7 characters into spaces)
70 S TMP=FLDSEP_ENCODE
71 S VAFHLROL(3,1)=FLDSEP_$TR(ROLE(1),TMP," ")
72 S VAFHLROL(3,2,1)=CMPSEP_$TR(ROLE(2,1),TMP," ")
73 S VAFHLROL(3,2,2)=SUBSEP_$TR(ROLE(2,2),TMP," ")
74 S VAFHLROL(3,2,3)=SUBSEP_$TR(ROLE(2,3),TMP," ")
75 S VAFHLROL(3,3)=CMPSEP_$TR(ROLE(3),TMP," ")
76S3C4 ;Alternate Role (seq #3, comp #4 - 6)
77 I ('$D(@PARAM@("ALTROLE"))) D G S4
78 .S VAFHLROL(3,4)=CMPSEP_NULL_CMPSEP_NULL_CMPSEP_NULL
79 ;Use input value
80 S TMP=NULL_CMPSEP_NULL_CMPSEP_NULL
81 S ALTROLE=$G(@PARAM@("ALTROLE"),TMP)
82 S:(ALTROLE="") ALTROLE=TMP
83 S TMP=$P(ALTROLE,CMPSEP,1)
84 S:(TMP="") TMP=NULL
85 S VAFHLROL(3,4)=CMPSEP_TMP
86 S TMP=$P(ALTROLE,CMPSEP,2)
87 S:(TMP="") TMP=NULL
88 S VAFHLROL(3,5)=CMPSEP_TMP
89 S TMP=$P(ALTROLE,CMPSEP,3)
90 S:(TMP="") TMP=NULL
91 S VAFHLROL(3,6)=CMPSEP_TMP
92S4 ;Role Person (seq #4)
93 I ($D(@PARAM@("PERSON"))) D G DONE
94 .;Use input value
95 .S PERSON=$G(@PARAM@("PERSON"),NULL)
96 .I ((PERSON="")!(PERSON=NULL)) D ERROR^VAFHLRO1(4,OUTARR,"could not be determined")
97 .S TMP=$P(PERSON,CMPSEP,1)
98 .S:(TMP="") TMP=NULL
99 .S VAFHLROL(4,1)=FLDSEP_TMP
100 .S TMP=$P(PERSON,CMPSEP,2)
101 .S:(TMP="") TMP=NULL
102 .S VAFHLROL(4,2)=CMPSEP_TMP
103 .S TMP=$P(PERSON,CMPSEP,3)
104 .S:(TMP="") TMP=NULL
105 .S VAFHLROL(4,3)=CMPSEP_TMP
106 .S TMP=$P(PERSON,CMPSEP,4)
107 .S:(TMP="") TMP=NULL
108 .S VAFHLROL(4,4)=CMPSEP_TMP
109 .S TMP=$P(PERSON,CMPSEP,5)
110 .S:(TMP="") TMP=NULL
111 .S VAFHLROL(4,5)=CMPSEP_TMP
112 .S TMP=$P(PERSON,CMPSEP,6)
113 .S:(TMP="") TMP=NULL
114 .S VAFHLROL(4,6)=CMPSEP_TMP
115 .S TMP=$P(PERSON,CMPSEP,7)
116 .S:(TMP="") TMP=NULL
117 .S VAFHLROL(4,7)=CMPSEP_TMP
118 .S TMP=$P(PERSON,CMPSEP,8)
119 .S:(TMP="") TMP=NULL
120 .S VAFHLROL(4,8)=CMPSEP_TMP
121 ;Calculate value
122 I ('PTR200) D G DONE
123 .D ERROR^VAFHLRO1(4,OUTARR,"could not be determined")
124 .S VAFHLROL(4)=FLDSEP_NULL_CMPSEP_NULL_CMPSEP_NULL_CMPSEP_NULL_CMPSEP_NULL_CMPSEP_NULL_CMPSEP_NULL_CMPSEP_NULL
125 K PERSON D PERSON^VAFHLRO3(PTR200,"PERSON",NULL)
126 I ('$D(PERSON)) D G DONE
127 .D ERROR^VAFHLRO1(4,OUTARR,"could not be determined")
128 .S VAFHLROL(4)=FLDSEP_NULL_CMPSEP_NULL_CMPSEP_NULL_CMPSEP_NULL_CMPSEP_NULL_CMPSEP_NULL_CMPSEP_NULL_CMPSEP_NULL
129 ;Strip out external values
130 I (CODEONLY) F TMP=2:1:7 S PERSON(1,TMP)=NULL
131 ;Copy and add appropriate seperators
132 ; (Convert any HL7 characters into spaces)
133 S TMP=FLDSEP_ENCODE
134 S VAFHLROL(4,1,1,1)=FLDSEP_$TR(PERSON(1,1,1),TMP," ")
135 S VAFHLROL(4,1,1,2)=SUBSEP_$TR(PERSON(1,1,2),TMP," ")
136 S VAFHLROL(4,1,2)=CMPSEP_$TR(PERSON(1,2),TMP," ")
137 S VAFHLROL(4,1,3)=CMPSEP_$TR(PERSON(1,3),TMP," ")
138 S VAFHLROL(4,1,4)=CMPSEP_$TR(PERSON(1,4),TMP," ")
139 S VAFHLROL(4,1,5)=CMPSEP_$TR(PERSON(1,5),TMP," ")
140 S VAFHLROL(4,1,6)=CMPSEP_$TR(PERSON(1,6),TMP," ")
141 S VAFHLROL(4,1,7)=CMPSEP_$TR(PERSON(1,7),TMP," ")
142 S VAFHLROL(4,1,8)=CMPSEP_$TR(PERSON(1,8),TMP," ")
143 S VAFHLROL(4,2,1)=REPSEP_$TR(PERSON(2,1),TMP," ")
144 F TMP=1:1:7 S VAFHLROL(4,2,TMP+1)=CMPSEP_$TR(PERSON(2,TMP+1),TMP," ")
145 S VAFHLROL(4,2,9)=CMPSEP_$TR(PERSON(2,9),TMP," ")
146DONE ;Collapse into output location
147 D FIXLEN^VAFHLRO1("VAFHLROL",OUTARR,MAXLEN,0)
148 ;Done
149 Q
Note: See TracBrowser for help on using the repository browser.