Changeset 1325 for ccr/branches/ohum/p/C0CLA7Q.m
- Timestamp:
- Dec 31, 2011, 12:08:05 AM (12 years ago)
- File:
-
- 1 edited
-
ccr/branches/ohum/p/C0CLA7Q.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
ccr/branches/ohum/p/C0CLA7Q.m
r1204 r1325 1 C0CLA7Q 2 ;;1.0;C0C;;May 19, 2009;Build 38 3 4 5 6 7 8 LAB(C0CPTID,C0CSDT,C0CEDT,C0CSC,C0CSPEC,C0CERR,C0CDEST,C0CHL7) 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 VCHECK 28 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 VBUILD 64 65 66 67 68 69 LNCHK 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 TMPCHK 114 115 116 117 118 119 120 121 122 123 124 125 126 VCHK1 127 128 129 130 131 132 133 134 135 136 137 138 VSTORE 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 FINDDT 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 1 C0CLA7Q ;WV/JMC - CCD/CCR Lab HL7 Query Utility ;Jul 6, 2009 2 ;;1.0;C0C;;May 19, 2009;Build 39 3 ; 4 ; 5 Q 6 ; 7 ; 8 LAB(C0CPTID,C0CSDT,C0CEDT,C0CSC,C0CSPEC,C0CERR,C0CDEST,C0CHL7) ; Entry point for Lab Result Query 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 ; 27 VCHECK ; If V LAB file present then check for lab results that are only in this file. 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 LA7SCRC=$G(C0CSC) 40 . S TMP=$$SCLIST^LA7QRY2(LA7SCRC) 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 ; 63 VBUILD ; Build results found only in V LAB file into HL7 structure. 64 ; 65 ; 66 Q 67 ; 68 ; 69 LNCHK ; Check for corresponding entry in V LAB file and related LOINC code for a result in file #63. 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 TMPCHK ; Check if LN/NLT codes saved from V LAB file above and use when building OBR/OBX segments 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 VCHK1 ; Check the entry in V Lab to determine if it meets criteria 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 VSTORE ; Store entry for building in HL7 message when parent is from V LAB file. 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 FINDDT ; Find entry in V LAB for the date/time or one close to it. 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.
