- Timestamp:
- Jun 1, 2009, 10:27:32 PM (15 years ago)
- Location:
- ccr/trunk/p
- Files:
-
- 2 edited
-
C0CLA7DD.m (modified) (1 diff)
-
C0CLA7Q.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/C0CLA7DD.m
r509 r529 1 C0CLA7DD ;xxxx/JMC-CREATE NEW-STYLE XREF ;8:32 PM 18 May 2009 2 ;;1.0;C0C;;May 19, 2009; 3 ; 4 N C0CXR,C0CRES,C0COUT 5 S C0CXR("FILE")=9000010.09 6 S C0CXR("NAME")="ALR5" 7 S C0CXR("TYPE")="R" 8 S C0CXR("USE")="S" 9 S C0CXR("EXECUTION")="R" 10 S C0CXR("ACTIVITY")="IR" 11 S C0CXR("SHORT DESCR")="X-ref by patient and results availble date/time" 12 S C0CXR("DESCR",1)="This cross-reference is used to identify all lab results for a" 13 S C0CXR("DESCR",2)="patient by results available date/time. This includes results that are only in" 14 S C0CXR("DESCR",3)="this file and therefore do not have a corresponding entry in LAB DATA" 15 S C0CXR("DESCR",4)="file (#63)." 16 S C0CXR("VAL",1)=.02 17 S C0CXR("VAL",1,"SUBSCRIPT")=1 18 S C0CXR("VAL",1,"COLLATION")="F" 19 S C0CXR("VAL",2)=1212 20 S C0CXR("VAL",2,"SUBSCRIPT")=2 21 S C0CXR("VAL",2,"COLLATION")="F" 22 D CREIXN^DDMOD(.C0CXR,"SW",.C0CRES,"C0COUT") 23 Q 1 C0CLA7DD ;WV/JMC - CCD/CCR Post Install DD X-Ref Setup Routine; ;18 May 2009 2 ;;1.0;C0C;;May 19, 2009; 3 ; 4 ; Tasked by C0C post-install routine C0CENV to create C0C cross-references on V LAB file. 5 ; 6 Q 7 ; 8 ; 9 EN ; Add new style cross-references to V LAB file if it exists. 10 ; 11 ; 12 ; Quit if AUPNVLAB global does not exist. 13 I $$VFILE^DILFD(9000010.09)'=1 Q 14 ; 15 N MSG 16 ; 17 S MSG="Starting installation of ALR1 cross-reference at "_$$HTE^XLFDT($H,"1Z") 18 D MES^XPDUTL(MSG) 19 D ALR1 20 S MSG="Installation of ALR1 cross-reference completed at "_$$HTE^XLFDT($H,"1Z") 21 D MES^XPDUTL(MSG) 22 ; 23 S MSG="Starting installation of ALR2 cross-reference at "_$$HTE^XLFDT($H,"1Z") 24 D MES^XPDUTL(MSG) 25 D ALR2 26 S MSG="Installation of ALR2 cross-reference completed at "_$$HTE^XLFDT($H,"1Z") 27 D MES^XPDUTL(MSG) 28 ; 29 S MSG="Starting installation of ALR3 cross-reference at "_$$HTE^XLFDT($H,"1Z") 30 D MES^XPDUTL(MSG) 31 D ALR3 32 S MSG="Installation of ALR3 cross-reference completed at "_$$HTE^XLFDT($H,"1Z") 33 D MES^XPDUTL(MSG) 34 ; 35 S MSG="Starting installation of ALR4 cross-reference at "_$$HTE^XLFDT($H,"1Z") 36 D MES^XPDUTL(MSG) 37 D ALR4 38 S MSG="Installation of ALR4 cross-reference completed at "_$$HTE^XLFDT($H,"1Z") 39 D MES^XPDUTL(MSG) 40 ; 41 S MSG="Starting installation of ALR5 cross-reference at "_$$HTE^XLFDT($H,"1Z") 42 D MES^XPDUTL(MSG) 43 D ALR5 44 S MSG="Installation of ALR5 cross-reference completed at "_$$HTE^XLFDT($H,"1Z") 45 D MES^XPDUTL(MSG) 46 ; 47 Q 48 ; 49 ; 50 ALR1 ; 51 ; 52 N C0CFLAG,C0CXR,C0CRES,C0COUT 53 ; 54 S C0CFLAG="S" 55 I '$D(ZTQUEUED) S C0CFLAG=COCFLAG_"W" 56 ; 57 S C0CXR("FILE")=9000010.09 58 S C0CXR("NAME")="ALR1" 59 S C0CXR("TYPE")="R" 60 S C0CXR("USE")="S" 61 S C0CXR("EXECUTION")="R" 62 S C0CXR("ACTIVITY")="IR" 63 S C0CXR("SHORT DESCR")="X-ref to link entry with parent in LAB DATA file (#63)" 64 S C0CXR("VAL",1)=.02 65 S C0CXR("VAL",1,"SUBSCRIPT")=1 66 S C0CXR("VAL",1,"COLLATION")="F" 67 S C0CXR("VAL",2)=.06 68 S C0CXR("VAL",2,"SUBSCRIPT")=2 69 S C0CXR("VAL",2,"LENGTH")=30 70 S C0CXR("VAL",2,"COLLATION")="F" 71 S C0CXR("VAL",3)=.01 72 S C0CXR("VAL",3,"SUBSCRIPT")=3 73 S C0CXR("VAL",3,"COLLATION")="F" 74 S C0CXR("VAL",4)=1201 75 S C0CXR("VAL",4,"SUBSCRIPT")=4 76 S C0CXR("VAL",4,"COLLATION")="F" 77 D CREIXN^DDMOD(.C0CXR,COCFLAG,.C0CRES,"C0COUT") 78 ; 79 Q 80 ; 81 ; 82 ALR2 ; 83 ; 84 N C0CFLAG,C0CXR,C0CRES,C0COUT 85 ; 86 S C0CFLAG="S" 87 I '$D(ZTQUEUED) S C0CFLAG=COCFLAG_"W" 88 ; 89 S C0CXR("FILE")=9000010.09 90 S C0CXR("NAME")="ALR2" 91 S C0CXR("TYPE")="MU" 92 S C0CXR("USE")="S" 93 S C0CXR("EXECUTION")="R" 94 S C0CXR("ACTIVITY")="IR" 95 S C0CXR("SHORT DESCR")="X-ref for LOINC code related to test result." 96 S C0CXR("DESCR",1)="This cross-reference is used to identify the LOINC codes" 97 S C0CXR("DESCR",2)="that has been assigned to a lab result. Allows queries to" 98 S C0CXR("DESCR",3)="retrieve the LOINC code associated with a specific test" 99 S C0CXR("DESCR",4)="result." 100 S C0CXR("SET")="S ^AUPNVLAB(""ALR2"",X(1),X(2),X(3),X(4),X(5),DA)=""""" 101 S C0CXR("KILL")="K ^AUPNVLAB(""ALR2"",X(1),X(2),X(3),X(4),X(5),DA)" 102 S C0CXR("WHOLE KILL")="K ^AUPNVLAB(""ALR2"")" 103 S C0CXR("VAL",1)=.02 104 S C0CXR("VAL",1,"SUBSCRIPT")=1 105 S C0CXR("VAL",1,"COLLATION")="F" 106 S C0CXR("VAL",2)=1201 107 S C0CXR("VAL",2,"SUBSCRIPT")=2 108 S C0CXR("VAL",2,"COLLATION")="F" 109 S C0CXR("VAL",3)=.06 110 S C0CXR("VAL",3,"SUBSCRIPT")=3 111 S C0CXR("VAL",3,"COLLATION")="F" 112 S C0CXR("VAL",4)=.01 113 S C0CXR("VAL",4,"SUBSCRIPT")=4 114 S C0CXR("VAL",4,"COLLATION")="F" 115 S C0CXR("VAL",5)=1113 116 S C0CXR("VAL",5,"SUBSCRIPT")=5 117 S C0CXR("VAL",5,"COLLATION")="F" 118 D CREIXN^DDMOD(.C0CXR,C0CFLAG,.C0CRES,"C0COUT") 119 ; 120 Q 121 ; 122 ; 123 ALR3 ; 124 ; 125 N C0CFLAG,C0CXR,C0CRES,C0COUT 126 ; 127 S C0CFLAG="S" 128 I '$D(ZTQUEUED) S C0CFLAG=COCFLAG_"W" 129 ; 130 S C0CXR("FILE")=9000010.09 131 S C0CXR("NAME")="ALR2" 132 S C0CXR("TYPE")="MU" 133 S C0CXR("USE")="S" 134 S C0CXR("EXECUTION")="R" 135 S C0CXR("ACTIVITY")="IR" 136 S C0CXR("SHORT DESCR")="X-ref for LOINC code related to test result." 137 S C0CXR("DESCR",1)="This cross-reference is used to identify the LOINC codes" 138 S C0CXR("DESCR",2)="that has been assigned to a lab result. Allows queries to" 139 S C0CXR("DESCR",3)="retrieve the LOINC code associated with a specific test" 140 S C0CXR("DESCR",4)="result." 141 S C0CXR("SET")="S ^AUPNVLAB(""ALR2"",X(1),X(2),X(3),X(4),X(5),DA)=""""" 142 S C0CXR("KILL")="K ^AUPNVLAB(""ALR2"",X(1),X(2),X(3),X(4),X(5),DA)" 143 S C0CXR("WHOLE KILL")="K ^AUPNVLAB(""ALR2"")" 144 S C0CXR("VAL",1)=.02 145 S C0CXR("VAL",1,"SUBSCRIPT")=1 146 S C0CXR("VAL",1,"COLLATION")="F" 147 S C0CXR("VAL",2)=1201 148 S C0CXR("VAL",2,"SUBSCRIPT")=2 149 S C0CXR("VAL",2,"COLLATION")="F" 150 S C0CXR("VAL",3)=.06 151 S C0CXR("VAL",3,"SUBSCRIPT")=3 152 S C0CXR("VAL",3,"COLLATION")="F" 153 S C0CXR("VAL",4)=.01 154 S C0CXR("VAL",4,"SUBSCRIPT")=4 155 S C0CXR("VAL",4,"COLLATION")="F" 156 S C0CXR("VAL",5)=1113 157 S C0CXR("VAL",5,"SUBSCRIPT")=5 158 S C0CXR("VAL",5,"COLLATION")="F" 159 D CREIXN^DDMOD(.C0CXR,C0CFLAG,.C0CRES,"C0COUT") 160 ; 161 Q 162 ; 163 ; 164 ALR4 ; 165 ; 166 N C0CFLAG,C0CXR,C0CRES,C0COUT 167 ; 168 S C0CFLAG="S" 169 I '$D(ZTQUEUED) S C0CFLAG=COCFLAG_"W" 170 ; 171 S C0CXR("FILE")=9000010.09 172 S C0CXR("NAME")="ALR2" 173 S C0CXR("TYPE")="MU" 174 S C0CXR("USE")="S" 175 S C0CXR("EXECUTION")="R" 176 S C0CXR("ACTIVITY")="IR" 177 S C0CXR("SHORT DESCR")="X-ref for LOINC code related to test result." 178 S C0CXR("DESCR",1)="This cross-reference is used to identify the LOINC codes" 179 S C0CXR("DESCR",2)="that has been assigned to a lab result. Allows queries to" 180 S C0CXR("DESCR",3)="retrieve the LOINC code associated with a specific test" 181 S C0CXR("DESCR",4)="result." 182 S C0CXR("SET")="S ^AUPNVLAB(""ALR2"",X(1),X(2),X(3),X(4),X(5),DA)=""""" 183 S C0CXR("KILL")="K ^AUPNVLAB(""ALR2"",X(1),X(2),X(3),X(4),X(5),DA)" 184 S C0CXR("WHOLE KILL")="K ^AUPNVLAB(""ALR2"")" 185 S C0CXR("VAL",1)=.02 186 S C0CXR("VAL",1,"SUBSCRIPT")=1 187 S C0CXR("VAL",1,"COLLATION")="F" 188 S C0CXR("VAL",2)=1201 189 S C0CXR("VAL",2,"SUBSCRIPT")=2 190 S C0CXR("VAL",2,"COLLATION")="F" 191 S C0CXR("VAL",3)=.06 192 S C0CXR("VAL",3,"SUBSCRIPT")=3 193 S C0CXR("VAL",3,"COLLATION")="F" 194 S C0CXR("VAL",4)=.01 195 S C0CXR("VAL",4,"SUBSCRIPT")=4 196 S C0CXR("VAL",4,"COLLATION")="F" 197 S C0CXR("VAL",5)=1113 198 S C0CXR("VAL",5,"SUBSCRIPT")=5 199 S C0CXR("VAL",5,"COLLATION")="F" 200 D CREIXN^DDMOD(.C0CXR,C0CFLAG,.C0CRES,"C0COUT") 201 ; 202 Q 203 ; 204 ; 205 ALR5 ; 206 ; 207 N C0CFLAG,C0CXR,C0CRES,C0COUT 208 ; 209 S C0CFLAG="S" 210 I '$D(ZTQUEUED) S C0CFLAG=COCFLAG_"W" 211 ; 212 S C0CXR("FILE")=9000010.09 213 S C0CXR("NAME")="ALR2" 214 S C0CXR("TYPE")="MU" 215 S C0CXR("USE")="S" 216 S C0CXR("EXECUTION")="R" 217 S C0CXR("ACTIVITY")="IR" 218 S C0CXR("SHORT DESCR")="X-ref for LOINC code related to test result." 219 S C0CXR("DESCR",1)="This cross-reference is used to identify the LOINC codes" 220 S C0CXR("DESCR",2)="that has been assigned to a lab result. Allows queries to" 221 S C0CXR("DESCR",3)="retrieve the LOINC code associated with a specific test" 222 S C0CXR("DESCR",4)="result." 223 S C0CXR("SET")="S ^AUPNVLAB(""ALR2"",X(1),X(2),X(3),X(4),X(5),DA)=""""" 224 S C0CXR("KILL")="K ^AUPNVLAB(""ALR2"",X(1),X(2),X(3),X(4),X(5),DA)" 225 S C0CXR("WHOLE KILL")="K ^AUPNVLAB(""ALR2"")" 226 S C0CXR("VAL",1)=.02 227 S C0CXR("VAL",1,"SUBSCRIPT")=1 228 S C0CXR("VAL",1,"COLLATION")="F" 229 S C0CXR("VAL",2)=1201 230 S C0CXR("VAL",2,"SUBSCRIPT")=2 231 S C0CXR("VAL",2,"COLLATION")="F" 232 S C0CXR("VAL",3)=.06 233 S C0CXR("VAL",3,"SUBSCRIPT")=3 234 S C0CXR("VAL",3,"COLLATION")="F" 235 S C0CXR("VAL",4)=.01 236 S C0CXR("VAL",4,"SUBSCRIPT")=4 237 S C0CXR("VAL",4,"COLLATION")="F" 238 S C0CXR("VAL",5)=1113 239 S C0CXR("VAL",5,"SUBSCRIPT")=5 240 S C0CXR("VAL",5,"COLLATION")="F" 241 D CREIXN^DDMOD(.C0CXR,C0CFLAG,.C0CRES,"C0COUT") 242 ; 243 Q -
ccr/trunk/p/C0CLA7Q.m
r508 r529 1 C0CLA7Q ;WV/JMC - CCD/CCR Lab HL7 Query Utility ;May 4, 2009 2 ;;1.0;C0C;;May 19, 2009; 3 ;;n.n;;****; 4 ; 5 ; 6 Q 7 ; 8 ; 1 C0CLA7Q ;WV/JMC - CCD/CCR Lab HL7 Query Utility ;May 31, 2009 2 ;;1.0;C0C;;May 19, 2009; 3 ; 4 ; 5 Q 6 ; 7 ; 9 8 LAB(C0CPTID,C0CSDT,C0CEDT,C0CSC,C0CSPEC,C0CERR,C0CDEST,C0CHL7) ; Entry point for Lab Result Query 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 9 ; 10 ; 11 K ^TMP("C0C-VLAB",$J) 12 ; 13 ; Check and retrieve lab results from LAB DATA file (#63) 14 S C0CDEST=$$GCPR^LA7QRY($G(C0CPTID),$G(C0CSDT),$G(C0CEDT),.C0CSC,.C0CSPEC,.C0CERR,$G(C0CDEST),$G(C0CHL7)) 15 ; 16 ; If V LAB file present then check for lab results that are only in this file 17 ; If results found in V Lab file then build results and add to above results. 18 I $D(^AUPNVLAB) D 19 . D VCHECK 20 . I $D(^TMP("C0C-VLAB",$J,3)) D VBUILD 21 ; 22 ;K ^TMP("C0C-VLAB",$J) 23 ; 24 Q C0CDEST 25 ; 26 ; 28 27 VCHECK ; If V LAB file present then check for lab results that are only in this file. 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 28 ; 29 N C0CDA,C0CEND,C0CROOT,C0CVLAB,LA7PTID,LA7SC,LA7SCRC,LA7SPEC 30 ; 31 S LA7PTID=C0CPTID 32 D PATID^LA7QRY2 33 I $D(LA7ERR) Q 34 ; 35 ; Resolve search codes to lab datanames 36 S LA7SC=$G(C0CSC) 37 I $T(SCLIST^LA7QRY2)'="" D 38 . N TMP 39 . S LA7SCSRC=$G(C0CSC) 40 . S TMP=$$SCLIST^LA7QRY2(LA7SCSRC) 41 . S LA7SC=TMP 42 ; 43 I LA7SC'="*" D CHKSC^LA7QRY1 44 ; 45 ; Convert specimen codes to file #61 Topography entries 46 S LA7SPEC=$G(C0CSPEC) 47 I LA7SPEC'="*" D SPEC^LA7QRY1 48 ; 49 S C0CROOT="^AUPNVLAB(""ALR4"",DFN,C0CSDT)",C0CEND=0 50 ; 51 F S C0CROOT=$Q(@C0CROOT) Q:C0CROOT="" D Q:C0CEND 52 . I $QS(C0CROOT,1)'="ALR4"!($QS(C0CROOT,2)'=DFN) S C0CEND=1 Q ; Left x-ref or patient 53 . I $QS(C0CROOT,3)>C0CEDT S C0CEND=1 Q ; Exceeded end date/time 54 . S C0CDA=$QS(C0CROOT,4) 55 . I $D(^TMP("C0C-VLAB",$J,1,C0CDA)) Q ; Already checked during scan of file #63 56 . I $P($G(^AUPNVLAB(C0CDA,11)),"^",8)=1 Q ; Source is LAB DATA file - skip 57 . D VCHK1 58 ; 59 ; 60 Q 61 ; 62 ; 64 63 VBUILD ; Build results found only in V LAB file into HL7 structure. 65 66 67 68 69 64 ; 65 ; 66 Q 67 ; 68 ; 70 69 LNCHK ; Check for corresponding entry in V LAB file and related LOINC code for a result in file #63. 71 ; Call from LA7QRY2 72 ; 73 N DFN,C0C60,C0C63,C0CACC,C0CDA,C0CDT,C0CLN,C0CPDA,C0CPTEST,C0CSPEC,C0CTEST,X 74 ; 75 S DFN=$P(^LR(LRDFN,0),"^",3) 76 S C0C63(0)=^LR(LRDFN,LRSS,LRIDT,0) 77 S C0CDT=$P(C0C63(0),"^"),C0CACC=$P(C0C63(0),"^",6),C0CSPEC=$P(C0C63(0),"^",5) 78 S (C0CTEST,C0CTEST(64),C0CPTEST,C0CPTEST(64),C0CLN)="" 79 ; 80 ; ^AUPNVLAB("ALR1",5380,"EKT 0307 48",173,3080307.211055,5427197)="" 81 ; 82 S C0C60="" 83 F S C0C60=$O(^LAB(60,"C",LRSS_";"_LRSB_";1",C0C60)) Q:'C0C60 D Q:C0CLN'="" 84 . D FINDDT 85 . I C0CDA<1 Q 86 . I $P($G(^AUPNVLAB(C0CDA,11)),"^",8)'=1 Q ; Source is not LAB DATA file - skip 87 . S C0CLN=$P($G(^AUPNVLAB(C0CDA,11)),"^",13) 88 . S C0CPDA=$P($G(^AUPNVLAB(C0CDA,12)),"^",8) 89 . I C0CPDA="" S C0CPDA=C0CDA 90 . S C0CTEST=$P($G(^AUPNVLAB(C0CDA,0)),"^"),X=$P($G(^LAB(60,C0CTEST,64)),"^",2) 91 . I X S C0CTEST(64)=$P($G(^LAM(X,0)),"^",2) 92 . S C0CPTEST=$P($G(^AUPNVLAB(C0CPDA,0)),"^"),X=$P($G(^LAB(60,C0CPTEST,64)),"^") 93 . I X S C0CPTEST(64)=$P($G(^LAM(X,0)),"^",2) 94 . S ^TMP("C0C-VLAB",$J,1,C0CDA)="" 95 . I C0CDA'=C0CPDA S ^TMP("C0C-VLAB",$J,1,C0CPDA)="" 96 . S ^TMP("C0C-VLAB",$J,2,LRDFN,LRSS,LRIDT,LRSB)=C0CPTEST(64)_"^"_C0CTEST(64)_"^"_C0CLN_"^"_C0CDA_"^"_C0CTEST_"^"_C0CPDA_"^"_C0CPTEST 97 ; 98 S X=$P(LA7X,"^",3) 99 ; If order NLT then update if no order NLT 100 I C0CPTEST(64),$P(X,"!")="" S $P(X,"!")=C0CPTEST(64) 101 ; 102 ; If result NLT then update if no result NLT 103 I C0CTEST(64),$P(X,"!",2)="" S $P(X,"!",2)=C0CTEST(64) 104 ; 105 ; If LOINC found then update variable with LN code 106 I C0CLN'="",$P(X,"!",3)="" S $P(X,"!",3)=C0CLN 107 ; 108 S $P(LA7X,"^",3)=X 109 ; 110 Q 111 ; 112 ; 70 ; Call from LA7QRY2 71 ; 72 N DFN,C0C60,C0C63,C0CACC,C0CDA,C0CDT,C0CLN,C0CPDA,C0CPTEST,C0CSPEC,C0CTEST,X 73 ; 74 S DFN=$P(^LR(LRDFN,0),"^",3) 75 S C0C63(0)=^LR(LRDFN,LRSS,LRIDT,0) 76 S C0CDT=$P(C0C63(0),"^"),C0CACC=$P(C0C63(0),"^",6),C0CSPEC=$P(C0C63(0),"^",5) 77 S (C0CTEST,C0CTEST(64),C0CPTEST,C0CPTEST(64),C0CLN)="" 78 ; 79 ; ^AUPNVLAB("ALR1",5380,"EKT 0307 48",173,3080307.211055,5427197)="" 80 ; 81 S C0C60="" 82 F S C0C60=$O(^LAB(60,"C",LRSS_";"_LRSB_";1",C0C60)) Q:'C0C60 D Q:C0CLN'="" 83 . D FINDDT 84 . I C0CDA<1 Q 85 . I $P($G(^AUPNVLAB(C0CDA,11)),"^",8)'=1 Q ; Source is not LAB DATA file - skip 86 . S C0CLN=$P($G(^AUPNVLAB(C0CDA,11)),"^",13) 87 . S C0CPDA=$P($G(^AUPNVLAB(C0CDA,12)),"^",8) 88 . I C0CPDA,'$D(^AUPNVLAB(C0CPDA,0)) S C0CPDA="" ; Dangling pointer 89 . I C0CPDA="" S C0CPDA=C0CDA 90 . S C0CTEST=$P($G(^AUPNVLAB(C0CDA,0)),"^"),X=$P($G(^LAB(60,C0CTEST,64)),"^",2) 91 . I X S C0CTEST(64)=$P($G(^LAM(X,0)),"^",2) 92 . S C0CPTEST=$P($G(^AUPNVLAB(C0CPDA,0)),"^"),X=$P($G(^LAB(60,C0CPTEST,64)),"^") 93 . I X S C0CPTEST(64)=$P($G(^LAM(X,0)),"^",2) 94 . S ^TMP("C0C-VLAB",$J,1,C0CDA)="" 95 . I C0CDA'=C0CPDA S ^TMP("C0C-VLAB",$J,1,C0CPDA)="" 96 . S ^TMP("C0C-VLAB",$J,2,LRDFN,LRSS,LRIDT,LRSB)=C0CPTEST(64)_"^"_C0CTEST(64)_"^"_C0CLN_"^"_C0CDA_"^"_C0CTEST_"^"_C0CPDA_"^"_C0CPTEST 97 ; 98 S X=$P(LA7X,"^",3) 99 ; If order NLT then update if no order NLT 100 I C0CPTEST(64),$P(X,"!")="" S $P(X,"!")=C0CPTEST(64) 101 ; 102 ; If result NLT then update if no result NLT 103 I C0CTEST(64),$P(X,"!",2)="" S $P(X,"!",2)=C0CTEST(64) 104 ; 105 ; If LOINC found then update variable with LN code 106 I C0CLN'="",$P(X,"!",3)="" S $P(X,"!",3)=C0CLN 107 ; 108 S $P(LA7X,"^",3)=X 109 ; 110 Q 111 ; 112 ; 113 113 TMPCHK ; Check if LN/NLT codes saved from V LAB file above and use when building OBR/OBX segments 114 115 116 117 118 119 120 121 122 123 124 125 114 ; Called from LA7VOBX1 115 ; 116 N I,X 117 ; 118 S X=$G(^TMP("C0C-VLAB",$J,2,LRDFN,LRSS,LRIDT,LRSB)) 119 I X="" Q 120 F I=1:1:3 I $P(LA7X,"!",I)="",$P(X,"^",I)'="" S $P(LA7X,"!",I)=$P(X,"^",I) 121 S $P(LA7VAL,"^",3)=LA7X 122 ; 123 Q 124 ; 125 ; 126 126 VCHK1 ; Check the entry in V Lab to determine if it meets criteria 127 128 129 130 131 132 133 134 135 136 137 127 ; 128 N C0CVLAB,I 129 ; 130 F I=0,12 S C0CVLAB(I)=$G(^AUPNVLAB(C0CDA,I)) 131 ; 132 ; JMC 04/13/09 - Store anything for now that meets date criteria. 133 D VSTORE 134 ; 135 Q 136 ; 137 ; 138 138 VSTORE ; Store entry for building in HL7 message when parent is from V LAB file. 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 139 ; 140 N C0CPDA,C0CPTEST 141 ; 142 ; Determine parent test to use for OBR segment 143 S C0CPDA=$P(C0CVLAB(12),"^",8) 144 I C0CPDA="" S C0CPDA=C0CDA 145 ; 146 ; Determine parent test 147 S C0CPTEST=$P($G(^AUPNVLAB(C0CPDA,0)),"^") 148 ; 149 S ^TMP("C0C-VLAB",$J,3,$P(C0CVLAB(0),"^",2),$P(C0CVLAB(12),"^"),C0CPTEST,C0CDA)=C0CPDA 150 ; 151 Q 152 ; 153 ; 154 154 FINDDT ; Find entry in V LAB for the date/time or one close to it. 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 155 ; RPMS stores related specimen entries under the same date/time. 156 ; Lab file #63 creates unique entries with slightly different times. 157 ; 158 S C0CDA=$O(^AUPNVLAB("ALR1",DFN,C0CACC,C0C60,C0CDT,0)) 159 I C0CDA>0 Q 160 ; 161 ; If entry found then confirm that specimen type matches. 162 N C0CDTY 163 S C0CDTY=$O(^AUPNVLAB("ALR1",DFN,C0CACC,C0C60,0)) 164 I C0CDTY D 165 . I $P(C0CDT,".")'=$P(C0CDTY,".") Q 166 . S C0CDA=$O(^AUPNVLAB("ALR1",DFN,C0CACC,C0C60,C0CDTY,0)) 167 . I C0CSPEC'=$P($G(^AUPNVLAB(C0CDA,11)),"^",3) S C0CDA="" 168 ; 169 Q
Note:
See TracChangeset
for help on using the changeset viewer.
