Changeset 434 for ccr/trunk/p
- Timestamp:
- Apr 14, 2009, 10:57:24 AM (16 years ago)
- Location:
- ccr/trunk/p
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/C0CLA7Q.m
r433 r434 1 C0CLA7Q ;WV/JMC - CCD/CCR Lab HL7 Query Utility ;Apr 1 2, 20092 ;; 5.2;;****;Sep 27, 19941 C0CLA7Q ;WV/JMC - CCD/CCR Lab HL7 Query Utility ;Apr 13, 2009 2 ;;n.n;;****; 3 3 ; 4 4 ; … … 12 12 ; 13 13 ; Check and retrieve lab results from LAB DATA file (#63) 14 D GCPR^LA7QRY( C0CPTID,C0CSDT,C0CEDT,.C0CSC,.C0CSPEC,.C0CERR,C0CDEST,C0CHL7)14 D GCPR^LA7QRY($G(C0CPTID),$G(C0CSDT),$G(C0CEDT),.C0CSC,.C0CSPEC,.C0CERR,$G(C0CDEST),$G(C0CHL7)) 15 15 ; 16 16 ; If V LAB file present then check for lab results that are only in this file 17 I $D(^AUPNVLAB) D VCHECK18 ;19 17 ; If results found in V Lab file then build results and add to above results. 20 I $D(^TMP("C0C-VLAB",$J,3)) D VBUILD 18 I $D(^AUPNVLAB) D 19 . D VCHECK 20 . I $D(^TMP("C0C-VLAB",$J,3)) D VBUILD 21 21 ; 22 22 ;K ^TMP("C0C-VLAB",$J) … … 84 84 I C0CLN'="" D 85 85 . S X=$P(LA7X,"^",3) 86 . S $P(X,"!",3)=C0CLN86 . I $P(X,"!",3)="" S $P(X,"!",3)=C0CLN 87 87 . S $P(LA7X,"^",3)=X 88 88 ; … … 96 96 F I=0,12 S C0CVLAB(I)=^AUPNVLAB(C0CDA,I) 97 97 ; 98 ; JMC 04/13/09 - Store anything for now that meets date criteria. 98 99 D VSTORE 99 100 ; … … 103 104 VSTORE ; Store entry for building in HL7 message when parent is from V LAB file. 104 105 ; 105 S ^TMP("C0C-VLAB",$J,3,$P(C0CVLAB(12),"^"),$P(C0CVLAB,"^",2))="" 106 N PARENT 107 ; 108 ; Determine parent test to use for OBR segment 109 S PARENT=$P(C0CVLAB(12),"^",8) 110 I PARENT="" S PARENT=$P(C0CVLAB(0),"^") 111 ; 112 ; patient ien 113 ; | collection date/time 114 ; | | parent test (ordered test) 115 ; | | | ien of entry in V LAB file 116 ; | | | | 117 S ^TMP("C0C-VLAB",$J,3,$P(C0CVLAB(0),"^",2),$P(C0CVLAB(12),"^"),PARENT,C0CDA)="" 118 ; 106 119 Q -
ccr/trunk/p/LA7QRY2.m
r433 r434 1 LA7QRY2 ;DALOI/JMC - Lab HL7 Query Utility ; 1/30/07 19:052 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46 ,69,73**;Sep 27, 1994;Build 71 LA7QRY2 ;DALOI/JMC - Lab HL7 Query Utility ; 04/13/09 2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46**;Sep 27, 1994 3 3 ; JMC - mods to check for IHS V LAB file 4 4 ; … … 10 10 ; 11 11 S (DFN,LRDFN)="",LA7PTYP=0 12 ; VOE changes, Use HRN cross reference, Daou;;June 8,200513 S LA7X=$O(^AUPNPAT("D",LA7PTID,""))14 I LA7X>0 D SETDFN(LA7X) S LA7PTYP=115 12 ; 16 ; See if SSN passed as patient identifier 17 I DFN'>0 S LA7X=$O(^DPT("SSN",LA7PTID,0)) I LA7X>0 D SETDFN(LA7X) S LA7PTYP=1 13 ; SSN passed as patient identifier 14 I LA7PTID?9N.1A D 15 . S LA7PTYP=1 16 . S LA7X=$O(^DPT("SSN",LA7PTID,0)) 17 . I LA7X>0 D SETDFN(LA7X) 18 18 ; 19 19 ; MPI/ICN (integration control number) passed as patient identifier 20 I DFN'>0 S LA7X=$$GETDFN^MPIF001($P(LA7PTID,"V")) I LA7X>0 D SETDFN(LA7X) S LA7PTYP=2 20 I LA7PTID?10N1"V"6N D 21 . S LA7PTYP=2 22 . S LA7X=$$GETDFN^MPIF001($P(LA7PTID,"V")) 23 . I LA7X>0 D SETDFN(LA7X) 21 24 ; 22 25 ; If no patient identified/no laboratory record - return exception message … … 36 39 I LA7EDT S LA7EDT(0)=9999999-LA7EDT 37 40 ; 38 S LRSS="" 39 F S LRSS=$O(LRSSLST(LRSS)) Q:LRSS="" D 41 F LRSS="CH","MI","SP" D 40 42 . S (LA7QUIT,LRIDT)=0 41 43 . I LA7EDT(0) S LRIDT=$O(^LR(LRDFN,LRSS,LA7EDT(0)),-1) … … 68 70 . . F S LA7ROOT=$Q(@LA7ROOT) Q:LA7ROOT=""!($QS(LA7ROOT,2)'=LA7DT)!($QS(LA7ROOT,4)'="AN") D 69 71 . . . I $QS(LA7ROOT,6)'=LRDFN Q 70 . . . S LRIDT=$QS(LA7ROOT,7) ,LRSS=""71 . . . F S LRSS=$O(LRSSLST(LRSS)) Q:LRSS=""D SEARCH72 . . . S LRIDT=$QS(LA7ROOT,7) 73 . . . F LRSS="CH","MI","SP" D SEARCH 72 74 ; 73 75 ; If no orders in #69 then do long search through file #63. 74 I 'LA7SRC D 75 . S LRSS="" 76 . F S LRSS=$O(LRSSLST(LRSS)) Q:LRSS="" D 76 I 'LA7SRC D 77 . F LRSS="CH","MI","SP" D 77 78 . . S LRIDT=0 78 79 . . F S LRIDT=$O(^LR(LRDFN,LRSS,LRIDT)) Q:'LRIDT D … … 118 119 F S LRSB=$O(^LR(LRDFN,LRSS,LRIDT,LRSB)) Q:'LRSB D 119 120 . S LA7X=$G(^LR(LRDFN,LRSS,LRIDT,LRSB)) 120 . I $ P($P(LA7X,"^",3),"!",3)="",$D(^AUPNVLAB) D LNCHK^C0CLA7Q ; WV check for IHS.121 . I $D(^AUPNVLAB) D LNCHK^C0CLA7Q ; WV check for IHS. 121 122 . S LA7CODE=$$DEFCODE^LA7VHLU5(LRSS,LRSB,$P(LA7X,"^",3),LA761) 122 123 . D CHECK … … 182 183 S DFN=LA7X,LRDFN=$P($G(^DPT(DFN,"LR")),"^") 183 184 Q 184 ;185 ;***** SETUP THE SEARCH CODES186 SCLIST(SCLST) ;187 N I,RC,SCALL,TMP K LRSSLST188 S SCALL=",CH,MI,SP,"189 S SCLST=$$UP^XLFSTR($TR(SCLST," ")),RC="*"190 S:SCLST?.1"*" RC=SCLST,SCLST=$P(SCALL,",",2,999)191 F I=1:1 S TMP=$P(SCLST,",",I) Q:TMP="" D Q:$D(LA7ERR)>1192 . I SCALL[(","_TMP_",") S LRSSLST(TMP)="" Q193 . S LA7ERR(7)="Invalid list of subscripts: '"_SCLST_"'"194 Q RC -
ccr/trunk/p/LA7VOBX1.m
r433 r434 1 LA7VOBX1 ;DALOI/JMC - LAB OBX Segment message builder (CH subscript) cont'd ;Apr 8, 20092 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,61,63 ,64,71**;Sep 27, 19941 LA7VOBX1 ;DALOI/JMC - LAB OBX Segment message builder (CH subscript) cont'd; 04/13/09 2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,61,63**;Sep 27, 1994 3 3 ; JMC - mods to check for IHS V LAB file 4 4 ; … … 6 6 ; Called by LA7VOBX 7 7 ; 8 N LA76304,LA7ALT,LA7DIV,LA7I,LA7 RS,LA7X,LA7Y,X8 N LA76304,LA7ALT,LA7DIV,LA7I,LA7X,LA7Y,X 9 9 ; 10 10 ; "CH" subscript requires a dataname … … 13 13 ; get result node from LR global. 14 14 S LA76304(0)=$G(^LR(LRDFN,LRSS,LRIDT,0)) 15 S LA7RS=$P(LRSB,"^",2),LRSB=$P(LRSB,"^")16 15 S LA7VAL=$G(^LR(LRDFN,LRSS,LRIDT,LRSB)) 17 ; If previous results have been corrected then send corrected status18 I LA7RS="",$P(LA7VAL,"^",10)=2 S LA7RS="C"19 16 ; 20 17 ; Check if test is OK to send - (O)utput or (B)oth 21 18 S LA7X=$P(LA7VAL,"^",12) 22 19 I LA7X]"","BO"'[LA7X Q 23 I LA7X="",'$$OKTOSND^LA7VHLU1(LRSS,LRSB,+$P($P(LA7VAL,"^",3),"!", 7)) Q20 I LA7X="",'$$OKTOSND^LA7VHLU1(LRSS,LRSB,+$P($P(LA7VAL,"^",3),"!",5)) Q 24 21 ; 25 22 ; If no result NLT or LOINC try to determine from file #60 26 23 S LA7X=$P(LA7VAL,"^",3) 27 ; 28 ; Check for no LOINC in 63 and LOINC found in V LAB file. 29 I $P(LA7X,"!",3)="",$D(^TMP("C0C-VLAB",$J,2,LRDFN,LRSS,LRIDT,LRSB)) S $P(LA7X,"!",3)=$P(^TMP("C0C-VLAB",$J,2,LRDFN,LRSS,LRIDT,LRSB),"^") 30 ; 24 ; Check for no LOINC in 63 and LOINC found in V LAB file. 25 I $P(LA7X,"!",3)="",$D(^TMP("LA7-VLAB",$J,2,LRDFN,LRSS,LRIDT,LRSB)) S $P(LA7X,"!",3)=$P(^TMP("LA7-VLAB",$J,2,LRDFN,LRSS,LRIDT,LRSB),"^") 26 ; 31 27 I $P(LA7X,"!",2)=""!($P(LA7X,"!",3)="") S $P(LA7VAL,"^",3)=$$DEFCODE^LA7VHLU5(LRSS,LRSB,LA7X,$P(LA76304(0),"^",5)) 32 28 ; No result NLT code - log error … … 71 67 ; 72 68 ; Value type 73 ; If result is "cancel" or "comment" then data type is ST - string data 74 S LA7X=$S("canccomment"[$P(LA7VAL,"^"):1,1:0) 75 I LA7X S LA7OBX(2)="ST" 76 E S LA7OBX(2)=$$OBX2^LA7VOBX(63.04,LRSB) 69 S LA7OBX(2)=$$OBX2^LA7VOBX(63.04,LRSB) 77 70 ; 78 71 ; Observation identifer … … 83 76 ; 84 77 ; Test value 85 ; If DoD and "canc" then report "PL Cancelled" per Lab Interop ICD. 86 S LA7X=$P(LA7VAL,"^") 87 I LA7X'="canc",$$GET1^DID(63.04,LRSB,"","TYPE","","LA7ERR")="SET" D 88 . S LA7X=$$EXTERNAL^DILFD(63.04,LRSB,"",LA7X) 89 . I LA7X="" S LA7X=$P(LA7VAL,"^") 90 I $G(LA7NVAF)=1,LA7X="canc" S LA7X="PL Cancelled" 91 S LA7OBX(5)=$$OBX5^LA7VOBX(LA7X,LA7OBX(2),LA7FS,LA7ECH) 78 S LA7OBX(5)=$$OBX5^LA7VOBX($P(LA7VAL,"^"),LA7OBX(2),LA7FS,LA7ECH) 92 79 ; 93 ; Units 94 S LA7X=$P(LA7VAL,"^",5) 80 ; Units - remove leading and trailing spaces 81 S LA7X=$P(LA7VAL,"^",5),LA7X=$$TRIM^XLFSTR(LA7X,"LR"," ") 95 82 S LA7OBX(6)=$$OBX6^LA7VOBX($P(LA7X,"!",7),"",LA7FS,LA7ECH) 96 83 ; … … 99 86 ; 100 87 ; Abnormal flags 101 S LA7OBX(8)=$$OBX8^LA7VOBX($P(LA7VAL, "^",2))88 S LA7OBX(8)=$$OBX8^LA7VOBX($P(LA7VAL,U,2)) 102 89 ; 103 90 ; "P"artial or "F"inal results 104 S LA7X=$S("canccommentpending"[$P(LA7VAL,"^"):$P(LA7VAL,"^"),1:"F") 105 I LA7RS="C" S LA7X=LA7RS 106 S LA7OBX(11)=$$OBX11^LA7VOBX(LA7X) 91 S LA7OBX(11)=$$OBX11^LA7VOBX($S("canccommentpending"[$P(LA7VAL,"^"):$P(LA7VAL,"^"),1:"F")) 107 92 ; 108 93 ; Observation date/time - collection date/time per HL7 standard
Note:
See TracChangeset
for help on using the changeset viewer.
