Changeset 508 for ccr/trunk/p/C0CLA7Q.m


Ignore:
Timestamp:
May 21, 2009, 1:12:11 PM (15 years ago)
Author:
George Lilly
Message:

formatting for Version 1

File:
1 edited

Legend:

Unmodified
Added
Removed

  • ccr/trunk/p/C0CLA7Q.m

    r505 r508  
    11C0CLA7Q ;WV/JMC - CCD/CCR Lab HL7 Query Utility ;May 4, 2009
    2         ;;n.n;;****;
    3         ;
    4         ;
    5         Q
    6         ;
    7         ;
     2 ;;1.0;C0C;;May 19, 2009;
     3 ;;n.n;;****;
     4 ;
     5 ;
     6 Q
     7 ;
     8 ;
    89LAB(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         ;
     10 ;
     11 ;
     12 K ^TMP("C0C-VLAB",$J)
     13 ;
     14 ; Check and retrieve lab results from LAB DATA file (#63)
     15 S C0CDEST=$$GCPR^LA7QRY($G(C0CPTID),$G(C0CSDT),$G(C0CEDT),.C0CSC,.C0CSPEC,.C0CERR,$G(C0CDEST),$G(C0CHL7))
     16 ;
     17 ; If V LAB file present then check for lab results that are only in this file
     18 ; If results found in V Lab file then build results and add to above results.
     19 I $D(^AUPNVLAB) D
     20 . D VCHECK
     21 . I $D(^TMP("C0C-VLAB",$J,3)) D VBUILD
     22 ;
     23 ;K ^TMP("C0C-VLAB",$J)
     24 ;
     25 Q C0CDEST
     26 ;
     27 ;
    2728VCHECK  ; 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 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         ;
     29 ;
     30 N C0CDA,C0CEND,C0CROOT,C0CVLAB,LA7PTID,LA7SC,LA7SCRC,LA7SPEC
     31 ;
     32 S LA7PTID=C0CPTID
     33 D PATID^LA7QRY2
     34 I $D(LA7ERR) Q
     35 ;
     36 ; Resolve search codes to lab datanames
     37 S LA7SC=$G(C0CSC)
     38 I $T(SCLIST^LA7QRY2)'="" D
     39 . N TMP
     40 . S LA7SCSRC=$G(C0CSC)
     41 . S TMP=$$SCLIST^LA7QRY2(LA7SCSRC)
     42 . S LA7SC=TMP
     43 ;
     44 I LA7SC'="*" D CHKSC^LA7QRY1
     45 ;
     46 ; Convert specimen codes to file #61 Topography entries
     47 S LA7SPEC=$G(C0CSPEC)
     48 I LA7SPEC'="*"  D SPEC^LA7QRY1
     49 ;
     50 S C0CROOT="^AUPNVLAB(""ALR4"",DFN,C0CSDT)",C0CEND=0
     51 ;
     52 F  S C0CROOT=$Q(@C0CROOT) Q:C0CROOT=""  D  Q:C0CEND
     53 . I $QS(C0CROOT,1)'="ALR4"!($QS(C0CROOT,2)'=DFN) S C0CEND=1 Q  ; Left x-ref or patient
     54 . I $QS(C0CROOT,3)>C0CEDT S C0CEND=1 Q  ; Exceeded end date/time
     55 . S C0CDA=$QS(C0CROOT,4)
     56 . I $D(^TMP("C0C-VLAB",$J,1,C0CDA)) Q  ; Already checked during scan of file #63
     57 . I $P($G(^AUPNVLAB(C0CDA,11)),"^",8)=1 Q  ; Source is LAB DATA file - skip
     58 . D VCHK1
     59 ;
     60 ;
     61 Q
     62 ;
     63 ;
    6364VBUILD  ; Build results found only in V LAB file into HL7 structure.
    64         ;
    65         ;
    66         Q
    67         ;
    68         ;
     65 ;
     66 ;
     67 Q
     68 ;
     69 ;
    6970LNCHK   ; 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="" S C0CPDA=C0CDA
    89         . S C0CTEST=$P($G(^AUPNVLAB(C0CDA,0)),"^"),X=$P($G(^LAB(60,C0CTEST,64)),"^",2)
    90         . I X S C0CTEST(64)=$P($G(^LAM(X,0)),"^",2)
    91         . S C0CPTEST=$P($G(^AUPNVLAB(C0CPDA,0)),"^"),X=$P($G(^LAB(60,C0CPTEST,64)),"^")
    92         . I X S C0CPTEST(64)=$P($G(^LAM(X,0)),"^",2)
    93         . S ^TMP("C0C-VLAB",$J,1,C0CDA)=""
    94         . I C0CDA'=C0CPDA S ^TMP("C0C-VLAB",$J,1,C0CPDA)=""
    95         . S ^TMP("C0C-VLAB",$J,2,LRDFN,LRSS,LRIDT,LRSB)=C0CPTEST(64)_"^"_C0CTEST(64)_"^"_C0CLN_"^"_C0CDA_"^"_C0CTEST_"^"_C0CPDA_"^"_C0CPTEST
    96         ;
    97         S X=$P(LA7X,"^",3)
    98         ; If order NLT then update if no order NLT
    99         I C0CPTEST(64),$P(X,"!")="" S $P(X,"!")=C0CPTEST(64)
    100         ;
    101         ; If result NLT then update if no result NLT
    102         I C0CTEST(64),$P(X,"!",2)="" S $P(X,"!",2)=C0CTEST(64)
    103         ;
    104         ; If LOINC found then update variable with LN code
    105         I C0CLN'="",$P(X,"!",3)="" S $P(X,"!",3)=C0CLN
    106         ;
    107         S $P(LA7X,"^",3)=X
    108         ;
    109         Q
    110         ;
    111         ;
     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 ;
    112113TMPCHK  ; Check if LN/NLT codes saved from V LAB file above and use when building OBR/OBX segments
    113         ; Called from LA7VOBX1
    114         ;
    115         N I,X
    116         ;
    117         S X=$G(^TMP("C0C-VLAB",$J,2,LRDFN,LRSS,LRIDT,LRSB))
    118         I X="" Q
    119         F I=1:1:3 I $P(LA7X,"!",I)="",$P(X,"^",I)'="" S $P(LA7X,"!",I)=$P(X,"^",I)
    120         S $P(LA7VAL,"^",3)=LA7X
    121         ;
    122         Q
    123         ;
    124         ;
     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 ;
    125126VCHK1   ; Check the entry in V Lab to determine if it meets criteria
    126         ;
    127         N C0CVLAB,I
    128         ;
    129         F I=0,12 S C0CVLAB(I)=$G(^AUPNVLAB(C0CDA,I))
    130         ;
    131         ; JMC 04/13/09 - Store anything for now that meets date criteria.
    132         D VSTORE
    133         ;
    134         Q
    135         ;
    136         ;
     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 ;
    137138VSTORE  ; Store entry for building in HL7 message when parent is from V LAB file.
    138         ;
    139         N C0CPDA,C0CPTEST
    140         ;
    141         ; Determine parent test to use for OBR segment
    142         S C0CPDA=$P(C0CVLAB(12),"^",8)
    143         I C0CPDA="" S C0CPDA=C0CDA
    144         ;
    145         ; Determine parent test
    146         S C0CPTEST=$P($G(^AUPNVLAB(C0CPDA,0)),"^")
    147         ;
    148         S ^TMP("C0C-VLAB",$J,3,$P(C0CVLAB(0),"^",2),$P(C0CVLAB(12),"^"),C0CPTEST,C0CDA)=C0CPDA
    149         ;
    150         Q
    151         ;
    152         ;
     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 ;
    153154FINDDT  ; Find entry in V LAB for the date/time or one close to it.
    154         ; RPMS stores related specimen entries under the same date/time.
    155         ; Lab file #63 creates unique entries with slightly different times.
    156         ;
    157         S C0CDA=$O(^AUPNVLAB("ALR1",DFN,C0CACC,C0C60,C0CDT,0))
    158         I C0CDA>0 Q
    159         ;
    160         ; If entry found then confirm that specimen type matches.
    161         N C0CDTY
    162         S C0CDTY=$O(^AUPNVLAB("ALR1",DFN,C0CACC,C0C60,0))
    163         I C0CDTY D
    164         . I $P(C0CDT,".")'=$P(C0CDTY,".") Q
    165         . S C0CDA=$O(^AUPNVLAB("ALR1",DFN,C0CACC,C0C60,C0CDTY,0))
    166         . I C0CSPEC'=$P($G(^AUPNVLAB(C0CDA,11)),"^",3) S C0CDA=""
    167         ;
    168         Q
     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.