source: WorldVistAEHR/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORHL01.m@ 738

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

initial load of WorldVistAEHR
File size: 2.8 KB
Line 
1RORHL01 ;HOIFO/CRT - HL7 PATIENT DATA: PID,ZSP,ZRD ; 6/19/06 2:08pm
2 ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
3 ;
4 ; This routine uses the following IAs:
5 ;
6 ; #263 $$EN^VAFHLPID (controlled)
7 ; #3630 BLDPID^VAFCQRY (controlled)
8 ; #4535 EN^VAFHLZRD (private)
9 ; #4536 $$EN^VAFHLZSP (private)
10 ; #10035 Read access to the PATIENT file (supported)
11 ;
12 Q
13 ;
14 ;***** PID SEGMENT BUILDER
15 ;
16 ; RORDFN DFN of Patient Record in File #2
17 ;
18 ; Return Values:
19 ; <0 Error Code
20 ; 0 Ok
21 ; >0 Non-fatal error(s)
22 ;
23PID(RORDFN) ;
24 N CS,ERRCNT,I,PTID,RC,RORBUF,RORMSG,RPS,SCS,SEG,TMP
25 S (ERRCNT,RC)=0
26 D ECH^RORHL7(.CS,.SCS,.RPS)
27 ;
28 ;--- Check if the patient exists
29 S RORDFN=+$G(RORDFN)
30 I '$D(^DPT(RORDFN,0)) D Q RC
31 . S RC=$$ERROR^RORERR(-36,,,RORDFN,2)
32 ;
33 ;--- Call Standard PID Segment builder
34 S TMP="3,5,7,8,10,11,19,22,29"
35 D BLDPID^VAFCQRY(RORDFN,"",TMP,.RORBUF,.RORHL,.RORMSG)
36 ;---
37 D LOADSEG^RORHL7A(.SEG,"RORBUF")
38 ;
39 ;--- PID-3 Patient Identifiers
40 S PTID=""
41 F I=1:1 S TMP=$P(SEG(3),RPS,I) Q:TMP="" D
42 . S:"NI,PI"[$P(TMP,CS,5) PTID=PTID_RPS_TMP
43 S SEG(3)=$P(PTID,RPS,2,99)
44 ;
45 ;--- PID-5 Remove the Patient Name
46 S SEG(5)=""
47 ;
48 ;--- PID-10 Send the old race if the new format is not available
49 I $G(SEG(10))?."""" D
50 . N VAFPID
51 . S TMP=$$EN^VAFHLPID(RORDFN,"10")
52 . S:$G(VAFPID(1))'="" RORSEG=RORSEG_VAFPID(1)
53 . S SEG(10)=$P(TMP,HLFS,11)
54 ;
55 ;--- PID-11 Remove Address (leave ZIP only)
56 S SEG(11)=CS_CS_CS_CS_$P($G(SEG(11)),CS,5)
57 ;
58 ;--- PID-19 Encrypt SSN
59 S SEG(19)=$$XOR^RORUTL03($G(SEG(19)))
60 ;
61 ;--- Store the segment
62 D ADDSEG^RORHL7(.SEG)
63 Q ERRCNT
64 ;
65 ;***** ZSP SEGMENT BUILDER
66 ;
67 ; RORDFN DFN of Patient Record in File #2
68 ;
69 ; Return Values:
70 ; <0 Error Code
71 ; 0 Ok
72 ; >0 Non-fatal error(s)
73 ;
74ZSP(RORDFN) ;
75 N RC,RORFLDS,RORSEG
76 S RC=0
77 ;
78 ;--- Check if the patient exists
79 S RORDFN=+$G(RORDFN)
80 I '$D(^DPT(RORDFN,0)) D Q RC
81 . S RC=$$ERROR^RORERR(-36,,,RORDFN,2)
82 ;
83 S RORFLDS="1,2,3,4" ; Default HL7 fields
84 ;
85 ;--- Call Standard ZSP Segment Builder
86 S RORSEG=$$EN^VAFHLZSP(RORDFN)
87 ;
88 ;--- Store the segment
89 D ADDSEG^RORHL7(.RORSEG,"C")
90 Q $S(RC<0:RC,1:0)
91 ;
92 ;***** ZRD SEGMENT BUILDER
93 ;
94 ; RORDFN DFN of Patient Record in File #2
95 ;
96 ; Return Values:
97 ; <0 Error Code
98 ; 0 Ok
99 ; >0 Non-fatal error(s)
100 ;
101ZRD(RORDFN) ;
102 N I,RC,RORFLDS,RORSEG
103 S RC=0
104 ;
105 ;--- Check if the patient exists
106 S RORDFN=+$G(RORDFN)
107 I '$D(^DPT(RORDFN,0)) D Q RC
108 . S RC=$$ERROR^RORERR(-36,,,RORDFN,2)
109 ;
110 S RORFLDS="1,2,3,4" ; Default HL7 fields
111 ;
112 ;--- Call Standard ZRD Segment Builder
113 D EN^VAFHLZRD(RORDFN,RORFLDS,,HLFS,"RORSEG")
114 ;
115 ;--- Store the segment(s)
116 S I=""
117 F S I=$O(RORSEG(I)) Q:I="" Q:$P($G(RORSEG(I,0)),HLFS,3)="" D
118 . D ADDSEG^RORHL7(RORSEG(I,0),"C")
119 Q $S(RC<0:RC,1:0)
Note: See TracBrowser for help on using the repository browser.