source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORHL02.m@ 770

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

initial load of FOIAVistA 6/30/08 version
File size: 5.5 KB
Line 
1RORHL02 ;HOIFO/CRT,SG - HL7 REGISTRY DATA: CSP,CSR,CSS ; 12/6/05 2:36pm
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 Q
5 ;
6 ;***** CSP SEGMENTS BUILDER
7 ;
8 ; RORIENS IENS of Patient Record in Registry File
9 ;
10 ; DXDTS Main time frame for data extraction in
11 ; StartDate^EndDate format
12 ;
13 ; Return Values:
14 ; <0 Error Code
15 ; 0 Ok
16 ; >0 Non-fatal error(s)
17 ;
18CSP(RORIENS,DXDTS) ;
19 N CS,ERRCNT,FLDS,RC,RORMSG,ROROUT,STATUS,TMP
20 S (ERRCNT,RC)=0
21 ;--- Check the parameters
22 S:$E(RORIENS,$L(RORIENS))'="," RORIENS=RORIENS_","
23 ;
24 S FLDS="1;2;3;3.2;6"
25 D GETS^DIQ(798,RORIENS,FLDS,"IE","ROROUT","RORMSG")
26 Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,798,RORIENS)
27 I $$ICRDEF^RORHIVUT(+RORIENS) D Q:RC<0 RC
28 . D GETS^DIQ(799.4,RORIENS,"9.01","IE","ROROUT","RORMSG")
29 . S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,,799.4,RORIENS)
30 ;
31 S STATUS=+$G(ROROUT(798,RORIENS,3,"I"))
32 ;--- UPDATE
33 I $G(DXDTS)>0 D Q:RC<0 RC
34 . S RC=$$CSPSEG(0,$P(DXDTS,U),$P(DXDTS,U,2))
35 ;--- SELECT
36 S RC=$$CSPSEG(1,$G(ROROUT(798,RORIENS,3.2,"I"))) Q:RC<0 RC
37 ;--- ADD
38 S RC=$$CSPSEG(2,$G(ROROUT(798,RORIENS,1,"I"))) Q:RC<0 RC
39 ;--- CONFIRM
40 I $G(ROROUT(798,RORIENS,2,"I"))>0 D Q:RC<0 RC
41 . S RC=$$CSPSEG(3,ROROUT(798,RORIENS,2,"I"))
42 ;--- DELETE
43 I STATUS=5 D Q:RC<0 RC
44 . S RC=$$CSPSEG(4,$G(ROROUT(798,RORIENS,6,"I")))
45 ;--- CDC
46 I $G(ROROUT(799.4,RORIENS,9.01,"I"))>0 D Q:RC<0 RC
47 . S RC=$$CSPSEG(5,ROROUT(799.4,RORIENS,9.01,"I"))
48 ;---
49 Q ERRCNT
50 ;
51 ;***** LOW-LEVEL CSP BUILDER
52 ;
53 ; RGEVC Registry event code
54 ; DATE Event date (FileMan)
55 ; [ENDT] End date (FileMan)
56 ;
57 ; Return Values:
58 ; <0 Error Code
59 ; 0 Ok
60 ;
61CSPSEG(RGEVC,DATE,ENDT,CSP4) ;
62 ;;UPDATE^SELECT^ADD^CONFIRM^DELETE^CDC^MERGE
63 N CS,RORSEG,TMP
64 D ECH^RORHL7(.CS)
65 ;
66 ;--- Initialize the segment
67 S RORSEG(0)="CSP"
68 ;
69 ;--- CSP-1
70 S TMP=$S(RGEVC'<0:$P($P($T(CSPSEG+1),";;",2),U,RGEVC+1),1:"")
71 Q:TMP="" $$ERROR^RORERR(-88,,,,"RGEVC",RGEVC)
72 S RORSEG(1)=RGEVC_CS_TMP
73 ;
74 ;--- CSP-2
75 S RORSEG(2)=$$FM2HL^RORHL7(DATE)
76 ;
77 ;--- CSP-3
78 S:$G(ENDT)>0 RORSEG(3)=$$FM2HL^RORHL7(ENDT)
79 ;
80 ;--- CSP-4
81 S:$G(CSP4)'?." " RORSEG(4)=CSP4
82 ;
83 ;--- Store the segment
84 D ADDSEG^RORHL7(.RORSEG)
85 Q 0
86 ;
87 ;***** CSR SEGMENT BUILDER
88 ;
89 ; [RORIENS] IENS of Patient Record in Registry File. Either this
90 ; parameter or the PTIEN must have a valid value.
91 ;
92 ; [PTIEN] Patient IEN (DFN). If no value is provided for this
93 ; parameter, then the function uses the value of the
94 ; .01 field of the patient's registry record.
95 ;
96 ; [RORFLDS] Segment Fields to populate
97 ; (1,3,4,6,9,10,12 available)
98 ;
99 ; Return Values:
100 ; <0 Error Code
101 ; 0 Ok
102 ; >0 Non-fatal error(s)
103 ;
104CSR(RORIENS,PTIEN,RORFLDS) ;
105 N BUF,CS,ERRCNT,HIVIENS,RC,RORMSG,ROROUT,RORSEG,RORTXT,RPS,SCS,TMP,VER
106 S (ERRCNT,RC)=0,HIVIENS=""
107 D ECH^RORHL7(.CS,.SCS,.RPS)
108 S PTIEN=+$G(PTIEN)
109 ;
110 I $G(RORIENS)>0 D Q:RC<0 RC
111 . S:$E(RORIENS,$L(RORIENS))'="," RORIENS=RORIENS_","
112 . D GETS^DIQ(798,RORIENS,".01;.02;1","IE","ROROUT","RORMSG")
113 . I $G(DIERR) S RC=$$DBS^RORERR("RORMSG",-9,,,798,RORIENS) Q
114 . S:PTIEN'>0 PTIEN=+$G(ROROUT(798,RORIENS,.01,"I"))
115 . S:$D(^RORDATA(799.4,+RORIENS,0)) HIVIENS=RORIENS
116 E S RORIENS=""
117 ;
118 I $G(RORFLDS)'="" D
119 . S:$E(RORFLDS)'="," RORFLDS=","_RORFLDS
120 . S:$E(RORFLDS,$L(RORFLDS))'="," RORFLDS=RORFLDS_","
121 E S RORFLDS=",1,3,4,6,9,10,12," ; Default HL7 fields
122 ;
123 ;--- Initialize the segment
124 S RORSEG(0)="CSR"
125 ;
126 ;--- CSR-1 - Name of the registry and version of the CCR
127 I RORFLDS[",1," D
128 . S VER=+$P(ROREXT("VERSION"),U) ; Version
129 . S:$P(VER,".",2)="" $P(VER,".",2)="0"
130 . S $P(VER,".",3)=+$P(ROREXT("VERSION"),U,2) ; Patch Number
131 . S $P(VER,".",4)=+$$BUILD^ROR ; Build Number
132 . S TMP=$S(RORIENS'="":$G(ROROUT(798,RORIENS,.02,"E")),1:"")
133 . S RORSEG(1)=$S(TMP'="":TMP,1:"CCR")_CS_VER
134 ;
135 ;--- CSR-3 - Institution
136 I RORFLDS[",3," D
137 . S RORSEG(3)=$$SITE^RORUTL03(CS)
138 ;
139 ;--- CSR-4 - Patient ID
140 I RORFLDS[",4," D
141 . S RORSEG(4)=PTIEN_CS_CS_CS_"USVHA"_CS_"PI"
142 ;
143 ;--- CSR-6 - Date when added to the registry
144 I RORFLDS[",6,",RORIENS'="" D Q:RC<0 RC
145 . S TMP=$$FMTHL7^XLFDT($G(ROROUT(798,RORIENS,1,"I"))\1)
146 . I TMP'>0 S RC=$$ERROR^RORERR(-95,,,,798,RORIENS,1) Q
147 . S RORSEG(6)=TMP
148 ;
149 ;--- CSR-9 - Date of Clinical AIDS (HIV)
150 I RORFLDS[",9,",HIVIENS'="" D Q:RC<0 RC
151 . D GETS^DIQ(799.4,HIVIENS,".02;.03","I","ROROUT","RORMSG")
152 . I $G(DIERR) D S ERRCNT=ERRCNT+1 Q
153 . . D DBS^RORERR("RORMSG",-9,,,799.4,HIVIENS)
154 . I '$G(ROROUT(799.4,HIVIENS,.02,"I")) S TMP=""
155 . E S TMP=$G(ROROUT(799.4,HIVIENS,.03,"I"))
156 . S RORSEG(9)=$$FM2HL^RORHL7(TMP)
157 ;
158 ;--- CSR-10 - Reason for addition of the patient to the registry
159 I RORFLDS[",10,",RORIENS'="" D Q:RC<0 RC
160 . S RORSEG(10)=$$ADREASON^RORHLUT1(RORIENS,CS)
161 ;
162 ;--- CSR-12 - Risk factors
163 I RORFLDS[",12,",HIVIENS'="" D Q:RC<0 RC
164 . N CNT,EV,FLD,RFLST,RORBUF,RORQUIT,RORRISK
165 . S RFLST="14.01;14.02;14.03;14.04;14.07;14.08;14.09;14.1;14.11;14.12;14.13;14.16;14.17"
166 . D GETS^DIQ(799.4,HIVIENS,RFLST,"I","RORBUF","RORMSG")
167 . I $G(DIERR) D S ERRCNT=ERRCNT+1
168 . . D DBS^RORERR("RORMSG",-9,,,799.4,HIVIENS)
169 . ;---
170 . S RORRISK="",RORQUIT=0
171 . F CNT=1:1 S FLD=$P(RFLST,";",CNT) Q:FLD="" D:FLD>0 Q:RORQUIT
172 . . S TMP=$G(RORBUF(799.4,HIVIENS,FLD,"I"))
173 . . S EV=$S(TMP=0:"NO",TMP=1:"YES",TMP=9:"UNKNOWN",1:"")
174 . . I EV="" S RORRISK="",RORQUIT=1 Q
175 . . S $P(RORRISK,RPS,CNT)=TMP_CS_EV
176 . S RORSEG(12)=RORRISK
177 ;
178 ;--- Store the segment
179 D ADDSEG^RORHL7(.RORSEG)
180 Q $S(RC<0:RC,1:ERRCNT)
Note: See TracBrowser for help on using the repository browser.