Changeset 529 for ccr/trunk/p


Ignore:
Timestamp:
Jun 1, 2009, 10:27:32 PM (15 years ago)
Author:
George Lilly
Message:

updates to handle dangling pointers in the V LAB file

Location:
ccr/trunk/p
Files:
2 edited

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
     1C0CLA7DD        ;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        ;
     9EN      ; 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        ;
     50ALR1    ;
     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        ;
     82ALR2    ;
     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        ;
     123ALR3    ;
     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        ;
     164ALR4    ;
     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        ;
     205ALR5    ;
     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  ;
     1C0CLA7Q ;WV/JMC - CCD/CCR Lab HL7 Query Utility ;May 31, 2009
     2        ;;1.0;C0C;;May 19, 2009;
     3        ;
     4        ;
     5        Q
     6        ;
     7        ;
    98LAB(C0CPTID,C0CSDT,C0CEDT,C0CSC,C0CSPEC,C0CERR,C0CDEST,C0CHL7)  ; Entry point for Lab Result Query
    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  ;
     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        ;
    2827VCHECK  ; If V LAB file present then check for lab results that are only in this file.
    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  ;
     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        ;
    6463VBUILD  ; Build results found only in V LAB file into HL7 structure.
    65  ;
    66  ;
    67  Q
    68  ;
    69  ;
     64        ;
     65        ;
     66        Q
     67        ;
     68        ;
    7069LNCHK   ; 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        ;
    113113TMPCHK  ; 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  ;
     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        ;
    126126VCHK1   ; 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  ;
     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        ;
    138138VSTORE  ; 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  ;
     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        ;
    154154FINDDT  ; 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
     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.