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

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

initial load of WorldVistAEHR
File size: 3.5 KB
Line 
1VAFHLZEN ;ALB/KCL - Create generic HL7 Enrollment (ZEN) segment ; 12-SEPTEMBER-1997
2 ;;5.3;Registration;**122,147,232**;Aug 13, 1993
3 ;
4 ;
5 ; This generic extrinsic function is designed to return the
6 ; HL7 Enrollment (ZEN) segment. This segment contains VA-specific
7 ; current enrollment information for a patient.
8 ;
9EN(DFN,VAFSTR,VAFNUM,VAFHLQ,VAFHLFS) ; --
10 ; Entry point for creating HL7 Enrollment (ZEN) segment.
11 ;
12 ; Input(s):
13 ; DFN - internal entry number of Patient (#2) file
14 ; VAFSTR - (optional) string of fields requested, separated by
15 ; commas. If not passed, return all data fields.
16 ; VAFNUM - (optional) sequential number for SET ID (default=1)
17 ; VAFHLQ - (optional) HL7 null variable.
18 ; VAFHLFS - (optional) HL7 field separator.
19 ;
20 ; Output(s):
21 ; String containing the desired components of the HL7 ZEN segment
22 ;
23 N VAFENR,VAFIEN,VAFPREF,VAFY,SEQ
24 ;
25 ; if VAFHLQ or VAFHLFS not passed, use default HL7 variables
26 S VAFHLQ=$S($D(VAFHLQ):VAFHLQ,1:$G(HLQ)),VAFHLFS=$S($D(VAFHLFS):VAFHLFS,1:$G(HLFS))
27 ;
28 ; if set id not passed, use default
29 S VAFNUM=$S($G(VAFNUM):VAFNUM,1:1)
30 ;
31 ; if DFN not passed, exit
32 I '$G(DFN) S VAFY=1 G ENQ
33 ;
34 ; if VAFSTR not passed, return all data fields (SEQ's)
35 I $G(VAFSTR)']"" F SEQ=1:1:13 S $P(VAFSTR,",",SEQ)=SEQ
36 ;
37 ; find IEN of patients 'current' enrollment record using
38 ; enrollment API, exit if not successful
39 S VAFIEN=$$FINDCUR^DGENA(DFN)
40 I '$G(VAFIEN) S VAFY=1 G ENQ
41 ;
42 ; get current enrollment record from Patient Enrollment (#27.11) file
43 ; using enrollment API, exit if not successful
44 I '$$GET^DGENA(VAFIEN,.VAFENR) S VAFY=1 G ENQ
45 ;
46 ; initialize output string and requested data fields
47 S $P(VAFY,VAFHLFS,12)="",VAFSTR=","_VAFSTR_","
48 ;
49 ; set-up segment data fields
50 S $P(VAFY,VAFHLFS,1)=$S($G(VAFNUM):VAFNUM,1:1) ; Set ID
51 ;
52 ;!!!!!! until HEC is ready to accept new Application Date, must transmit
53 ;Application Date in the Enrollment Date field
54 ;I VAFSTR[",2," S $P(VAFY,VAFHLFS,2)=$S($G(VAFENR("DATE")):$$HLDATE^HLFNC(VAFENR("DATE")),1:VAFHLQ) ; Enrollment Date
55 I VAFSTR[",2," S $P(VAFY,VAFHLFS,2)=$S($G(VAFENR("APP")):$$HLDATE^HLFNC(VAFENR("APP")),1:VAFHLQ) ; Enrollment Date filled with Application Date
56 ;
57 I VAFSTR[",3," S $P(VAFY,VAFHLFS,3)=$S($G(VAFENR("SOURCE"))]"":VAFENR("SOURCE"),1:VAFHLQ) ; Enrollment Source
58 I VAFSTR[",4," S $P(VAFY,VAFHLFS,4)=$S($G(VAFENR("STATUS"))]"":VAFENR("STATUS"),1:VAFHLQ) ; Enrollment Status
59 I VAFSTR[",5," S $P(VAFY,VAFHLFS,5)=$S($G(VAFENR("REASON"))]"":VAFENR("REASON"),1:VAFHLQ) ; Enrollment Reason Canceled/Declined
60 I VAFSTR[",6," S $P(VAFY,VAFHLFS,6)=$S($G(VAFENR("REMARKS"))]"":VAFENR("REMARKS"),1:VAFHLQ) ; Canceled/Declined Remarks
61 I VAFSTR[",7," S X=$$STATION^VAFHLFNC(VAFENR("FACREC")) S $P(VAFY,VAFHLFS,7)=$S(X]"":X,1:VAFHLQ) ; Facility Received
62 I VAFSTR[",8," S X=$$STATION^VAFHLFNC($$PREF^DGENPTA(DFN)) S $P(VAFY,VAFHLFS,8)=$S(X]"":X,1:VAFHLQ) ; Preferred Facility
63 I VAFSTR[",9," S $P(VAFY,VAFHLFS,9)=$S($G(VAFENR("PRIORITY"))]"":VAFENR("PRIORITY"),1:VAFHLQ) ; Enrollment Priority
64 I VAFSTR[",10," S $P(VAFY,VAFHLFS,10)=$S($G(VAFENR("EFFDATE")):$$HLDATE^HLFNC(VAFENR("EFFDATE")),1:VAFHLQ) ; Effective Date
65 I VAFSTR[",11," S $P(VAFY,VAFHLFS,11)=$S($G(VAFENR("APP")):$$HLDATE^HLFNC(VAFENR("APP")),1:VAFHLQ) ; Enrollment Application Date
66 I VAFSTR[",12," S $P(VAFY,VAFHLFS,12)=$S($G(VAFENR("END")):$$HLDATE^HLFNC(VAFENR("END")),1:VAFHLQ) ; Enrollment End Date
67 I VAFSTR[",13," S $P(VAFY,VAFHLFS,13)=$S($G(VAFENR("SUBGRP"))]"":VAFENR("SUBGRP"),1:VAFHLQ) ; Enrollment Priority Subgroup
68 ;
69ENQ Q "ZEN"_VAFHLFS_$G(VAFY)
Note: See TracBrowser for help on using the repository browser.