iSharkFly-Open
/
VistA-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

update to lab extract for RPMS

This commit is contained in:
george 2009-05-06 16:36:14 +00:00
parent caf6343783
commit 67db6019e3
1 changed files with 5 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
labRPMS/C0CLA7Q.m
View File

@ -1,4 +1,4 @@
C0CLA7Q ;WV/JMC - CCD/CCR Lab HL7 Query Utility ;Apr 21, 2009
C0CLA7Q ;WV/JMC - CCD/CCR Lab HL7 Query Utility ;May 4, 2009
;;n.n;;****;
;
;
@ -53,6 +53,7 @@ VCHECK ; If V LAB file present then check for lab results that are only in this
. I $QS(C0CROOT,3)>C0CEDT S C0CEND=1 Q ; Exceeded end date/time
. S C0CDA=$QS(C0CROOT,4)
. I $D(^TMP("C0C-VLAB",$J,1,C0CDA)) Q ; Already checked during scan of file #63
. I $P($G(^AUPNVLAB(C0CDA,11)),"^",8)=1 Q ; Source is LAB DATA file - skip
. D VCHK1
;
;
@ -75,12 +76,13 @@ LNCHK ; Check for corresponding entry in V LAB file and related LOINC code for a
S C0CDT=$P(C0C63(0),"^"),C0CACC=$P(C0C63(0),"^",6),C0CSPEC=$P(C0C63(0),"^",5)
S (C0CTEST,C0CTEST(64),C0CPTEST,C0CPTEST(64),C0CLN)=""
;
; ^AUPNVLAB("ALR1",5380,3080307.211055,"EKT 0307 48",188,5427202)=""
; ^AUPNVLAB("ALR1",5380,"EKT 0307 48",173,3080307.211055,5427197)=""
;
S C0C60=""
F S C0C60=$O(^LAB(60,"C",LRSS_";"_LRSB_";1",C0C60)) Q:'C0C60 D Q:C0CLN'=""
. D FINDDT
. I C0CDA<1 Q
. I $P($G(^AUPNVLAB(C0CDA,11)),"^",8)'=1 Q ; Source is not LAB DATA file - skip
. S C0CLN=$P($G(^AUPNVLAB(C0CDA,11)),"^",13)
. S C0CPDA=$P($G(^AUPNVLAB(C0CDA,12)),"^",8)
. I C0CPDA="" S C0CPDA=C0CDA
@ -124,7 +126,7 @@ VCHK1 ; Check the entry in V Lab to determine if it meets criteria
;
N C0CVLAB,I
;
F I=0,12 S C0CVLAB(I)=^AUPNVLAB(C0CDA,I)
F I=0,12 S C0CVLAB(I)=$G(^AUPNVLAB(C0CDA,I))
;
; JMC 04/13/09 - Store anything for now that meets date criteria.
D VSTORE