source: FOIAVistA/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNHL2.m@ 1801

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

initial load of FOIAVistA 6/30/08 version
File size: 4.1 KB
Line 
1SPNHL2 ;WDE/SAN-DIEGO;Build the hl7 segment for file data 154.1
2 ;;2.0;Spinal Cord Dysfunction;**10,11,12,14,19,20**;01/02/97
3EN(SPNFD0) ;
4 ;this routine is called from spnhl71 spnhl71 is called from the
5 ;edit screen
6 ; spndd is the field name located in the dd
7 ; x is the field number from file 154.1
8 ; this routine is used to build the ORU segment in chapter 7 of
9 ; hl7 manual 2.3 (page 7-14)
10 ;-------------------------------------------------------------------
11 ;build the msh and pid segment
12 S SPNFDFN=$$GET1^DIQ(154.1,SPNFD0_",",.01,"I")
13 Q:SPNFDFN=""
14 ;build the msh & pid segments
15 S SPNOBR="OBR",$P(SPNOBR,"|",7)="|"
16 S $P(SPNOBR,"|",2)=1
17 S $P(SPNOBR,"|",5)="FUNCTIONAL STATUS OBR"
18 S SPNRDT=$$GET1^DIQ(154.1,SPNFD0_",",.04,"I")
19 Q:SPNRDT="" S SPNRDT=$$HLDATE^HLFNC(SPNRDT,"TS")
20 S $P(SPNOBR,"|",8)=SPNRDT K SPNRDT
21 S SPLINE="",SPLINE=$O(SPMSG(SPLINE),-1)+1
22 S SPMSG(SPLINE)=SPNOBR S SPLINE=SPLINE+1
23 K SPNOBR
24 S OBXCNT=1
25 ;check for date of death if so get it
26 S SPDATA=$$GET1^DIQ(2,SPNFDFN_",",.351,"I") I $G(SPDATA)'="" D
27 . S SPDATA=$$HLDATE^HLFNC(SPDATA,"TS")
28 . S SPMSG(SPLINE)="OBX|"_OBXCNT_"|TS|"_".351"_"^"_"DATE OF DEATH"_"||"_SPDATA
29 . S SPLINE=SPLINE+1,OBXCNT=OBXCNT+1,SPNDD="",SPDATA=""
30 ;
31 ;build obx from STRING values
32 F X=.05,.06,.07,.08,.09,.1,.11,.12,.13,.14,.15,.16,.161,.17,.18,.181,.19,.191,.2,.21,.22,2.01,2.02,2.03,2.04,2.05,2.06,2.07,2.08,999.03,999.04,999.05,999.06,999.08 D
33 . S SPDATA=$$GET1^DIQ(154.1,SPNFD0_",",X) I SPDATA'="" D
34 .. S SPNDD=$G(^DD(154.1,X,0)),SPNDD=$P(SPNDD,U,1) S:SPNDD="" SPNDD="ERROR"
35 .. S SPMSG(SPLINE)="OBX|"_OBXCNT_"|ST|"_X_"^"_SPNDD_"||"_SPDATA S SPLINE=SPLINE+1,OBXCNT=OBXCNT+1,SPNDD=""
36 ;
37 ;build the ASIA data values (new for patch 12)
38 F X=.021,.023,.024,7.01,7.02,7.03,7.04,7.05,7.06,7.07,7.08,7.09,7.1,7.11,7.12,7.13,7.14 D
39 . S SPDATA=$$GET1^DIQ(154.1,SPNFD0_",",X) I SPDATA'="" D
40 .. S SPNDD=$G(^DD(154.1,X,0)),SPNDD=$P(SPNDD,U,1) S:SPNDD="" SPNDD="ERROR"
41 .. S SPMSG(SPLINE)="OBX|"_OBXCNT_"|ST|"_X_"^"_SPNDD_"||"_SPDATA S SPLINE=SPLINE+1,OBXCNT=OBXCNT+1,SPNDD=""
42 ;
43 F X=1001,1002 D
44 . S SPDATA=$$GET1^DIQ(154.1,SPNFD0_",",X,"I") I SPDATA'="" D
45 .. S SPDATA=$$HLDATE^HLFNC(SPDATA,"TS")
46 .. S SPNDD=$G(^DD(154.1,X,0)),SPNDD=$P(SPNDD,U,1) S:SPNDD="" SPNDD="ERROR"
47 .. S SPMSG(SPLINE)="OBX|"_OBXCNT_"|TS|"_X_"^"_SPNDD_"||"_SPDATA
48 .. S SPLINE=SPLINE+1,OBXCNT=OBXCNT+1,SPNDD="",SPDATA=""
49 ; get ms data only the numbers
50 F X=3.1,3.2,3.3,3.4,3.5,3.6,3.7,3.8,3.9 D
51 . S SPDATA=$$GET1^DIQ(154.1,SPNFD0_",",X,"I") I SPDATA'="" D
52 .. S SPDATA=$$GET1^DIQ(154.2,SPDATA_",",.01)
53 .. S SPNDD=$G(^DD(154.1,X,0)),SPNDD=$P(SPNDD,U,1) S:SPNDD="" SPNDD="ERROR"
54 .. S SPMSG(SPLINE)="OBX|"_OBXCNT_"|NU|"_X_"^"_SPNDD_"||"_SPDATA S SPLINE=SPLINE+1,OBXCNT=OBXCNT+1,SPNDD="",SPDATA=""
55 ;
56 ;
57 F X=4.1,4.2,4.3,4.4,4.5,4.6,6.01,6.02,2.09,2.13 D
58 . S SPDATA=$$GET1^DIQ(154.1,SPNFD0_",",X) I SPDATA'="" D
59 .. S SPNDD=$G(^DD(154.1,X,0)),SPNDD=$P(SPNDD,U,1) S:SPNDD="" SPNDD="ERROR"
60 .. S SPMSG(SPLINE)="OBX|"_OBXCNT_"|NU|"_X_"^"_SPNDD_"||"_SPDATA
61 .. S SPLINE=SPLINE+1,OBXCNT=OBXCNT+1,SPNDD=""
62 ;
63 ;
64 F X=5.01,5.02,5.03,5.04,5.05,5.06,5.07,5.08,5.09,5.1,5.11,5.12 D
65 . S SPDATA=$$GET1^DIQ(154.1,SPNFD0_",",X,"I") I SPDATA'="" D
66 .. S SPDATA=$$GET1^DIQ(154.11,SPDATA_",",.02)
67 .. S SPNDD=$G(^DD(154.1,X,0)),SPNDD=$P(SPNDD,U,1) S:SPNDD="" SPNDD="ERROR"
68 .. S SPMSG(SPLINE)="OBX|"_OBXCNT_"|ST|"_X_"^"_SPNDD_"||"_SPDATA
69 .. S SPLINE=SPLINE+1,OBXCNT=OBXCNT+1,SPNDD=""
70 F X=.02,.03,1003 D
71 . S SPDATA=$$GET1^DIQ(154.1,SPNFD0_",",X) I SPDATA'="" D
72 .. S SPNTBL=$S(X=.02:"^VA501",X=.03:"^VA502",1:"")
73 .. S SPNDD=$G(^DD(154.1,X,0)),SPNDD=$P(SPNDD,U,1) S:SPNDD="" SPNDD="ERROR"
74 .. S SPMSG(SPLINE)="OBX|"_OBXCNT_"|ST|"_X_"^"_SPNDD_SPNTBL_"||"_SPDATA
75 .. S SPLINE=SPLINE+1,OBXCNT=OBXCNT+1,SPNDD="",SPDATA=""
76 ;get the clinician its a multiple but we will only record the first one
77 ;
78 S SPNTMP=""
79 D GETS^DIQ(154.1,SPNFD0_",","1.01*","","SPNTMP")
80 S SPNDD=$G(^DD(154.1,1.01,0)),SPNDD=$P(SPNDD,U,1) ;Get dd field name
81 S SPNET=0,SPNET=$O(SPNTMP(154.101,SPNET))
82 I SPNET'="" S CL=0,CL=$O(SPNTMP(154.101,SPNET,CL)) S SPNDOC=$G(SPNTMP(154.101,SPNET,CL))
83 I SPNET'="" I SPNDOC'="" S SPMSG(SPLINE)="OBX|"_OBXCNT_"|ST|154.101^"_SPNDD_"||"_$G(SPNDOC)
84 K SPNET,CL,SPNDOC,SPNDD,SPDATA,SPNTBL
Note: See TracBrowser for help on using the repository browser.