source: WorldVistAEHR/trunk/r/VISTA_OFFICE_EHR-VEPE/VEPER7S2.m@ 1000

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

initial load of WorldVistAEHR

File size: 4.6 KB
Line 
1VEPER7S2 ;DOQ-IT HL7 Segment generation routine ; 10/11/05 10:22am
2 ;;1.0;VOE;;Nov 16, 2005
3 ;
4OBXCPT(OBXC) ;
5 ;
6 ; OBXC - Observation Record Count
7 ;
8 N REC
9 S REC="",OBXC=OBXC+1
10 S $P(REC,"|")=OBXC ;SEQUENCE NUMBER
11 S OBCODE=$G(VOBX(9000010.18,XAMIEN,.01))
12 S OBTXT=$G(VOBX(9000010.18,XAMIEN,.04))
13 S $P(REC,"|",3)=OBCODE_"^"_OBTXT_"^C4" ;Observation ID List Code & Sys
14 S $P(REC,"|",11)="F"
15 S X=$G(VOBX(9000010.18,XAMIEN,.03)),X=$P(X,"@"),%DT="T" I X="" S X=VISITDT
16 D ^%DT ;get date
17 S $P(REC,"|",14)=$P($$FMTHL7^XLFDT(Y),"-") ;Observation Date
18 S $P(REC,"|",16)=PRIPHN ;Physician Upin
19 W "OBX|"_REC
20 W !
21 Q
22 ;
23 ;
24OBX(OBXC) ;
25 ;
26 ; OBXC - Observation Record Count
27 ;
28 N REC,FILENUM,OBCODE,CODSYS
29 S REC="",OBCODE="",CODSYS="SNM"
30 S FILENUM=$S(EXAM="XAM":9000010.13,EXAM="PED":9000010.16,EXAM="HF":9000010.23,1:"")
31 I FILENUM="" Q
32 S OBTEXT=$G(VOBX(FILENUM,XAMIEN,.01))
33 ;
34 ;***CBF***Since the DOQ-IT HL7 tables are not present in VOE, manual mapping was done to properly set this segment.
35 ; As new exams, patient education topics and health factors are added, this section must be updated. If the
36 ; tables are eventually added, this section can be modified appropriately.
37 ;
38 I EXAM="XAM" S OBCODE=$S(OBTEXT["FOOT PULSE":21224004,OBTEXT["FOOT VISUAL":385954004,OBTEXT["FOOT":385954004,OBTEXT["EYE":282096008,1:"")
39 I EXAM="PED" S OBCODE=$S(OBTEXT["HTN":39155009,OBTEXT["CESSATION":384742004,1:311401005)
40 I EXAM="PED" S OBTEXT=$S(OBCODE=39155009:"HYPERTENSION EDUCATION",OBCODE=384742004:"SMOKING CESSATION ASSISTANCE",1:"PATIENT EDUCATION")
41 I EXAM="HF" S OBCODE=$S(OBTEXT["SMOKELESS":81703003,OBTEXT["CHEWING":81703003,OBTEXT["SMOKE I":229819007,1:"")
42 I EXAM="HF" I OBCODE="" S OBCODE=$S(OBTEXT["SMOKER":65568007,OBTEXT["SMOKING":229819007,1:"")
43 I EXAM="HF" I OBCODE="" S OBCODE=$S(OBTEXT="HF-MI IMAGING EF FIRST PASS":41466009,OBTEXT="HF-VENT EF PROB TECH":46258004,1:"")
44 I EXAM="HF" I OBCODE="" S OBCODE=$S(OBTEXT="HF-CARDIAC EF":70822001,OBTEXT="LEFT VENT EF":250908004,1:"")
45 I EXAM="HF" I OBCODE="" S OBCODE=$S(OBTEXT="HF-NORM LV SYST DYS WALL MOTION":371857005,OBTEXT="HF-NO EVIDENCE LV SYST DYS FUNCTION":395172009,1:"")
46 I EXAM="HF" S OBTEXT=$S(OBCODE=81703003:"CHEWS TOBACCO",OBCODE=229819007:"TOBACCO USE AND EXPOSURE",OBCODE=65568007:"CIGARETTE SMOKER",1:OBTEXT)
47 I EXAM="HF" I OBTEXT["PATIENT REASON"!(OBTEXT["PHYSICIAN REASON") S OBCODE=$E(OBTEXT,1,4),CODSYS="IFMC"
48 I OBCODE="" K REC Q
49 S OBXC=OBXC+1
50 S $P(REC,"|")=OBXC ;SEQUENCE NUMBER
51 I CODSYS'="IFMC" S $P(REC,"|",2)="ST" ;Observation Value Type
52 S $P(REC,"|",3)=OBCODE_"^"_OBTEXT_"^"_CODSYS ;Observation ID List Code & Sys
53 I CODSYS'="IFMC" I EXAM="XAM" S $P(REC,"|",5)=$G(VOBX(FILENUM,XAMIEN,.04)) ;Observation Value
54 I CODSYS'="IFMC" I EXAM="HF" S $P(REC,"|",5)=$G(VOBX(FILENUM,XAMIEN,.04))
55 I CODSYS'="IFMC" I EXAM="PED" S $P(REC,"|",5)=$G(VOBX(FILENUM,XAMIEN,.06))
56 I $P(REC,"|",2)="ST" I $P(REC,"|",5)="" S $P(REC,"|",5)="NONE"
57 S $P(REC,"|",6)="" ;Observation Units
58 S $P(REC,"|",11)="F"
59 S X=$G(VOBX(FILENUM,XAMIEN,.03)) I X="" S X=VISITDT
60 S X=$P(X,"@"),%DT="T" D ^%DT
61 S $P(REC,"|",14)=$P($$FMTHL7^XLFDT(Y),"-") ;Observation Date
62 S $P(REC,"|",16)=PRIPHN ;Physician Upin
63 W "OBX|"_REC
64 W !
65 Q
66 ;
67 ;
68OBXVITAL(OBXC) ;
69 ;
70 ; OBXC - Observation Record Count
71 ;
72 N REC
73 S REC="",OBXC=OBXC+1
74 S $P(REC,"|")=OBXC ;SEQUENCE NUMBER
75 S $P(REC,"|",2)="ST" ;Observation Value Type
76 S $P(REC,"|",3)=OBCODE_"^"_OBTXT_"^SNM" ;Observation ID List Code & Sys
77 S $P(REC,"|",5)=OBVALUE ;Observation Value
78 S $P(REC,"|",6)=OBID ;Observation Units - IDENTIFIER^TEXT
79 S X=$G(VOBX(120.5,XAMIEN,.01)),X=$P(X,"@"),%DT="T" I X="" S X=VISITDT
80 D ^%DT ;get date
81 S $P(REC,"|",11)="F"
82 S $P(REC,"|",14)=$P($$FMTHL7^XLFDT(Y),"-") ;Observation Date
83 S $P(REC,"|",16)=PRIPHN ;Physician Upin
84 W "OBX|"_REC
85 W !
86 Q
87 ;
88 ;
89OBXLABS(OBXC) ;
90 ;
91 ; OBXC - Observation Record Count
92 ;
93 N REC,VOELAB,VOEOBX3,VOEOBX31,VOEOBX32 S (REC,VOELAB,VOEOBX3,VOEOBX31,VOEOBX32)=""
94 F S VOELAB=$O(^VOELABS(VOELAB)) Q:'VOELAB D
95 . I $P($G(^VOELABS(VOELAB)),"|")'="OBX" Q
96 . S VOEOBX3=$P($G(^VOELABS(VOELAB)),"|",4)
97 . S VOEOBX31=$P(VOEOBX3,"^")
98 . I VOEOBX31'["-" Q
99 . S VOEOBX32="^"_$P(VOEOBX3,"^",2)_"^LN"
100 . S OBXC=OBXC+1
101 . S $P(REC,"|")=OBXC ;SEQUENCE NUMBER
102 . S $P(REC,"|",2)="ST" ;Observation Value Type
103 . S $P(REC,"|",3)=VOEOBX31_VOEOBX32 ;Observation ID List Code & Sys
104 . S $P(REC,"|",5)=$P($G(^VOELABS(VOELAB)),"|",6) ;Observation Value
105 . S $P(REC,"|",6)=$P($G(^VOELABS(VOELAB)),"|",7) ;Observation Units
106 . S $P(REC,"|",11)="F"
107 . S $P(REC,"|",14)=$P($$FMTHL7^XLFDT(DTTM),"-") ;Observation Date
108 . S $P(REC,"|",16)=PRIPHN ;Physician Upin REUSE PRIPHN - NOT PERFECT, BUT OKAY
109 . W "OBX|"_REC
110 . W !
111 Q
112 ;
113 ;
114
115
Note: See TracBrowser for help on using the repository browser.