source: WorldVistAEHR/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNHL1.m@ 975

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

initial load of WorldVistAEHR

File size: 4.5 KB
Line 
1SPNHL1 ;WDE/SAN-DIEGO;Build the hl7 segment for file 154
2 ;;2.0;Spinal Cord Dysfunction;**10,12,15,24**;01/02/97
3 ;this routine is called from spnhl7 spnhl7 is called from the
4 ;edit rtn for file 154
5EN(SPNFDFN) ;
6 K OBXCNT,SPNOBR,SPLINE,DATA,X,Y,SPNDD,SPNDT,SPNTMP
7 ;collect the registration data from 154
8 S SPNOBR=1,OBXCNT=1
9 S OBXCNT=1
10 S SPLINE="",SPLINE=$O(SPMSG(SPLINE),-1)+1
11 S SPMSG(SPLINE)="OBR|"_SPNOBR_"|||Registration OBR"
12 ;set up the obr with the date of registration
13 S X=$$GET1^DIQ(154,SPNFDFN_",",.02,"I"),X=$$HLDATE^HLFNC(X,"TS")
14 S $P(SPMSG(SPLINE),"|",8)=X S SPLINE=SPLINE+1
15 S SPNDD=$G(^DD(154,.02,0)),SPNDD=$P(SPNDD,U,1)
16 ;loop through the fields and set up the message
17 ;this section will set up all data type of date (ts)
18 F X=.02,.05,8.8,10.2 D
19 . S SPNDD=$G(^DD(154,X,0)),SPNDD=$P(SPNDD,U,1) S:SPNDD="" SPNDD="ERROR"
20 . S SPDATA=$$GET1^DIQ(154,SPNFDFN_",",X,"I") I $G(SPDATA)'="" D
21 .. S SPDATA=$$HLDATE^HLFNC(SPDATA,"TS")
22 .. S SPMSG(SPLINE)="OBX|"_OBXCNT_"|TS|"_X_"^"_SPNDD_"||"_SPDATA
23 .. S SPLINE=SPLINE+1,OBXCNT=OBXCNT+1,SPNDD=""
24 .. S (SPDATA,SPNDD)=""
25 F SPNCOMP=999.06,999.07,999.08 D
26 . S X=$$GET1^DIQ(154,SPNFDFN_",",SPNCOMP,"") I $G(X)'="" D
27 .. D ^%DT S SPDATA=Y ;flip date around to fm type
28 .. S SPDATA=$$HLDATE^HLFNC(SPDATA,"TS")
29 .. S SPNDD=$G(^DD(154,SPNCOMP,0)),SPNDD=$P(SPNDD,U,1) S:SPNDD="" SPNDD="ERROR"
30 .. S SPMSG(SPLINE)="OBX|"_OBXCNT_"|TS|"_SPNCOMP_"^"_SPNDD_"||"_SPDATA
31 .. S SPLINE=SPLINE+1,OBXCNT=OBXCNT+1,SPNDD=""
32 .. S (SPDATA,SPNDD)=""
33 ;check for date of death if so get it
34 S SPDATA=$$GET1^DIQ(2,SPNFDFN_",",.351,"I") I $G(SPDATA)'="" D
35 . S SPDATA=$$HLDATE^HLFNC(SPDATA,"TS")
36 . S SPMSG(SPLINE)="OBX|"_OBXCNT_"|TS|"_".351"_"^"_"DATE OF DEATH"_"||"_SPDATA
37 . S SPLINE=SPLINE+1,OBXCNT=OBXCNT+1,SPNDD="",SPDATA=""
38 ;
39 ;this secton will set up all data types of free text (ST)
40 F X=.03,2.1,2.2,2.3,2.4,2.5,2.6,3.1,3.2,3.3,3.4,3.5,5.01,5.11,5.12,6.09,8.3,8.4,8.6,10.3,999.03,999.04,999.05 D
41 . S SPNDD=$G(^DD(154,X,0)),SPNDD=$P(SPNDD,U,1) S:SPNDD="" SPNDD="ERROR"
42 . S SPDATA=$$GET1^DIQ(154,SPNFDFN_",",X) I $G(SPDATA)'="" D
43 .. S SPNTBL=$S(X=".03":"^VA0504",X="2.2":"^VA0505",X="2.3":"^VA0506",X="2.6":"^VA0507",1:"")
44 .. S SPMSG(SPLINE)="OBX|"_OBXCNT_"|ST|"_X_"^"_SPNDD_SPNTBL_"||"_SPDATA
45 .. S SPLINE=SPLINE+1,OBXCNT=OBXCNT+1,SPNDD=""
46 .. S (SPDATA,SPNDD,SPNTBL)=""
47 ;
48 ;set up station suffix from 40.8
49 S SPMSG(SPLINE)="OBX|"_OBXCNT_"|ST|154.91.2^DIVISION||"_$$EN^SPNMAIN(DUZ)
50 S SPLINE=SPLINE+1,OBXCNT=OBXCNT+1,SPNDD=""
51 ;this section is as well data types of free text (ST)
52 F X=1.1,5.02,5.03,5.04,5.05,5.06,5.07,5.08,5.09,5.1,5.13,5.14,10.1,8.1,8.2 D
53 . S SPNDD=$G(^DD(154,X,0)),SPNDD=$P(SPNDD,U,1) S:SPNDD="" SPNDD="ERROR"
54 . S SPDATA=$$GET1^DIQ(154,SPNFDFN_",",X) I $G(SPDATA)'="" D
55 .. S SPMSG(SPLINE)="OBX|"_OBXCNT_"|ST|"_X_"^"_SPNDD_"||"_SPDATA
56 .. S SPLINE=SPLINE+1,OBXCNT=OBXCNT+1,SPNDD=""
57 .. S (SPDATA,SPNDD)=""
58 ;this section will collect the etiology information
59 D GETS^DIQ(154,SPNFDFN_",","4*","","SPNTMP")
60 S SPNET="" F S SPNET=$O(SPNTMP(154.004,SPNET)) Q:(SPNET="")!('+SPNET) D ETIOBR S SPND="" F S SPND=$O(SPNTMP(154.004,SPNET,SPND)) Q:(SPND="")!('+SPND) D
61 . S SPNDD=$G(^DD(154.004,SPND,0)),SPNDD=$P(SPNDD,U,1) S:SPNDD="" SPNDD="ERROR"
62 . S X=$G(SPNTMP(154.004,SPNET,SPND)) I $G(X)'="" D
63 .. I SPND=".02" D ^%DT S X=$$HLDATE^HLFNC(Y,"TS") ;make hl7 date
64 .. S SPNTBL=$S(SPND=.01:"^VA503",1:"")
65 .. S SPDTYPE=$S(SPND=.02:"TS",1:"ST")
66 .. S SPMSG(SPLINE)="OBX|"_OBXCNT_"|"_SPDTYPE_"|"_SPND_"^"_SPNDD_SPNTBL_"||"_X S SPLINE=SPLINE+1,OBXCNT=OBXCNT+1
67 .. K SPDTYPE,SPNTBL
68 .Q
69EVAL ;
70 K SPNTMP,SPDATA,SPDD,SPD
71 D GETS^DIQ(154,SPNFDFN_",","7*","I","SPNTMP")
72 S SPNET="" F S SPNET=$O(SPNTMP(154.07,SPNET)) Q:(SPNET="")!('+SPNET) D EVLOBR S SPND=0 F S SPND=$O(SPNTMP(154.07,SPNET,SPND)) Q:(SPND="")!('+SPND) D
73 . S SPDATA=$G(SPNTMP(154.07,SPNET,SPND,"I")) I $G(SPDATA)'="" D
74 .. S SPDATA=$$HLDATE^HLFNC(SPDATA,"TS")
75 .. S SPNDD=$G(^DD(154.07,SPND,0)),SPNDD=$P(SPNDD,U,1) S:SPNDD="" SPNDD="-----"
76 .. S SPMSG(SPLINE)="OBX|"_OBXCNT_"|TS|"_SPND_"^"_SPNDD_"||"_SPDATA
77 .. S SPLINE=SPLINE+1,OBXCNT=OBXCNT+1
78 .. S (SPDATA,SPNDD,SPD)=""
79 K SPNTMP
80 Q
81 ;
82ETIOBR ;
83 S SPNOBR=SPNOBR+1
84 S X=$G(SPNTMP(154.004,SPNET,.02)) D ^%DT S ETDATE=Y K Y,X
85 S ETDATE=$$HLDATE^HLFNC(ETDATE,"TS")
86 ;note that this resets the date to an hl7 format
87 S SPMSG(SPLINE)="OBR|"_SPNOBR_"|||154 ETIOLOGY DATA|||"_ETDATE
88 S SPLINE=SPLINE+1
89 S OBXCNT=1
90 Q
91EVLOBR ;
92 S SPNOBR=SPNOBR+1
93 S SPDT=$G(SPNTMP(154.07,SPNET,.01,"I"))
94 S SPDT=$$HLDATE^HLFNC(SPDT,"TS")
95 S SPMSG(SPLINE)="OBR|"_SPNOBR_"|||154 ANNUAL EVAL DATA|||"_SPDT
96 S SPLINE=SPLINE+1
97 S OBXCNT=1
98 Q
Note: See TracBrowser for help on using the repository browser.