Ignore:
Timestamp:
Oct 1, 2012, 9:32:46 PM (12 years ago)
Author:
Sam Habiel
Message:

Merged Routines in OHUM branch back in main tree

Location:
ccr/trunk/p
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • ccr/trunk/p

  • ccr/trunk/p/C0CVOBX1.m

    r1336 r1544  
    1 LA7VOBX1 ;DALOI/JMC - LAB OBX Segment message builder (CH subscript) cont'd; 04/21/09
    2  ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,61,63**;Sep 27, 1994
    3  ; JMC - mods to check for IHS V LAB file
    4  ;
    5 CH ; Observation/Result segment for "CH" subscript results.
    6  ; Called by LA7VOBX
    7  ;
    8  N LA76304,LA7ALT,LA7DIV,LA7I,LA7X,LA7Y,X
    9  ;
    10  ; "CH" subscript requires a dataname
    11  I '$G(LRSB) Q
    12  ;
    13  ; get result node from LR global.
    14  S LA76304(0)=$G(^LR(LRDFN,LRSS,LRIDT,0))
    15  S LA7VAL=$G(^LR(LRDFN,LRSS,LRIDT,LRSB))
    16  ;
    17  ; Check if test is OK to send - (O)utput or (B)oth
    18  S LA7X=$P(LA7VAL,"^",12)
    19  I LA7X]"","BO"'[LA7X Q
    20  I LA7X="",'$$OKTOSND^LA7VHLU1(LRSS,LRSB,+$P($P(LA7VAL,"^",3),"!",5)) Q
    21  ;
    22  ; If no result NLT or LOINC try to determine from file #60
    23  S LA7X=$P(LA7VAL,"^",3)
    24  ; WV check for IHS - NLT/LN codes from V LAB file
    25  I $D(^AUPNVLAB) D TMPCHK^C0CLA7Q
    26  ;
    27  I $P(LA7X,"!",2)=""!($P(LA7X,"!",3)="") S $P(LA7VAL,"^",3)=$$DEFCODE^LA7VHLU5(LRSS,LRSB,LA7X,$P(LA76304(0),"^",5))
    28  ; No result NLT code - log error
    29  I $P($P(LA7VAL,"^",3),"!",2)="" D
    30  . N LA7X
    31  . S LA7X="["_LRSB_"]"_$$GET1^DID(63.04,LRSB,"","LABEL")
    32  . D CREATE^LA7LOG(36)
    33  ;
    34  ; something missing - No NLT code, etc.
    35  I LA7VAL="" Q
    36  ;
    37  ; Check for missing units/reference ranges
    38  S LA7X=$P(LA7VAL,"^",5)
    39  ;
    40  ; Results missing units, lookup in file #60
    41  I $P(LA7X,"!",7)="" S $P(LA7X,"!",7)=$P($$REFUNIT^LA7VHLU1(LRSB,$P(LA76304(0),"^",5)),"^",3)
    42  ;
    43  ; If results missing reference ranges, use values from file #60.
    44  I $P(LA7X,"!",2)="",$P(LA7X,"!",3)="",$P(LA7X,"!",11)="",$P(LA7X,"!",12)="" D
    45  . S LA7Y=$$REFUNIT^LA7VHLU1(LRSB,$P(LA76304(0),"^",5))
    46  . S $P(LA7X,"!",2)=$P(LA7Y,"^")
    47  . S $P(LA7X,"!",3)=$P(LA7Y,"^",2)
    48  . S $P(LA7X,"!",11)=$P(LA7Y,"^",6)
    49  . S $P(LA7X,"!",12)=$P(LA7Y,"^",7)
    50  ; Use therapeutic low/high if low/high missing.
    51  I $P(LA7X,"!",2)="",$P(LA7X,"!",3)="" D
    52  . S $P(LA7X,"!",2)=$P(LA7X,"!",11)
    53  . S $P(LA7X,"!",3)=$P(LA7X,"!",12)
    54  ;
    55  ; Evaluate low/high reference ranges in case M code in these fields.
    56  S:$G(SEX)="" SEX="M" S:$G(AGE)="" AGE=99
    57  F LA7I=2,3 I $E($P(LA7X,"!",LA7I),1,3)="$S(" D
    58  . S @("X="_$P(LA7X,"!",LA7I))
    59  . S $P(LA7X,"!",LA7I)=X
    60  ;
    61  ; Put units/reference ranges back in variable LA7VAL
    62  S $P(LA7VAL,"^",5)=LA7X
    63  ;
    64  ; Initialize OBX segment
    65  S LA7OBX(0)="OBX"
    66  S LA7OBX(1)=$$OBX1^LA7VOBX(.LA7OBXSN)
    67  ;
    68  ; Value type
    69  S LA7OBX(2)=$$OBX2^LA7VOBX(63.04,LRSB)
    70  ;
    71  ; Observation identifer
    72  ; build alternate code based on dataname from file #63 in case it's needed
    73  S LA7X=$P(LA7VAL,"^",3)
    74  S LA7ALT="CH"_LRSB_"^"_$$GET1^DID(63.04,LRSB,"","LABEL")_"^"_"99VA63"
    75  S LA7OBX(3)=$$OBX3^LA7VOBX($P(LA7X,"!",2),$P(LA7X,"!",3),LA7ALT,LA7FS,LA7ECH)
    76  ;
    77  ; Test value
    78  S LA7OBX(5)=$$OBX5^LA7VOBX($P(LA7VAL,"^"),LA7OBX(2),LA7FS,LA7ECH)
    79  ;
    80  ; Units - remove leading and trailing spaces
    81  S LA7X=$P(LA7VAL,"^",5),LA7X=$$TRIM^XLFSTR(LA7X,"LR"," ")
    82  S LA7OBX(6)=$$OBX6^LA7VOBX($P(LA7X,"!",7),"",LA7FS,LA7ECH)
    83  ;
    84  ; Reference range
    85  S LA7OBX(7)=$$OBX7^LA7VOBX($P(LA7X,"!",2),$P(LA7X,"!",3),LA7FS,LA7ECH)
    86  ;
    87  ; Abnormal flags
    88  S LA7OBX(8)=$$OBX8^LA7VOBX($P(LA7VAL,U,2))
    89  ;
    90  ; "P"artial or "F"inal results
    91  S LA7OBX(11)=$$OBX11^LA7VOBX($S("canccommentpending"[$P(LA7VAL,"^"):$P(LA7VAL,"^"),1:"F"))
    92  ;
    93  ; Observation date/time - collection date/time per HL7 standard
    94  I $P(LA76304(0),"^") S LA7OBX(14)=$$OBX14^LA7VOBX($P(LA76304(0),"^"))
    95  ;
    96  S LA7DIV=$P(LA7VAL,"^",9)
    97  I LA7DIV="",$$DIV4^XUSER(.LA7DIV,$P(LA7VAL,"^",4)) S LA7DIV=$O(LA7DIV(0))
    98  ;
    99  ; Facility that performed the testing
    100  S LA7OBX(15)=$$OBX15^LA7VOBX(LA7DIV,LA7FS,LA7ECH)
    101  ;
    102  ; Person that verified the test
    103  S LA7OBX(16)=$$OBX16^LA7VOBX($P(LA7VAL,"^",4),LA7DIV,LA7FS,LA7ECH)
    104  ;
    105  ; Observation method
    106  S LA7X=$P($P(LA7VAL,"^",3),"!",4)
    107  I LA7X S LA7OBX(17)=$$OBX17^LA7VOBX(LA7X,LA7FS,LA7ECH)
    108  ;
    109  ; Equipment entity identifier
    110  I $L($P(LA7VAL,"^",11)) S LA7OBX(18)=$$OBX18^LA7VOBX($P(LA7VAL,"^",11),LA7FS,LA7ECH)
    111  ;
    112  D BUILDSEG^LA7VHLU(.LA7OBX,.LA7ARRAY,LA7FS)
    113  ;
    114  Q
     1LA7VOBX1        ;DALOI/JMC - LAB OBX Segment message builder (CH subscript) cont'd; 04/21/09
     2        ;;1.2;C0C;;May 11, 2012;Build 47
     3        ; JMC - mods to check for IHS V LAB file
     4        ;
     5CH      ; Observation/Result segment for "CH" subscript results.
     6        ; Called by LA7VOBX
     7        ;
     8        N LA76304,LA7ALT,LA7DIV,LA7I,LA7X,LA7Y,X
     9        ;
     10        ; "CH" subscript requires a dataname
     11        I '$G(LRSB) Q
     12        ;
     13        ; get result node from LR global.
     14        S LA76304(0)=$G(^LR(LRDFN,LRSS,LRIDT,0))
     15        S LA7VAL=$G(^LR(LRDFN,LRSS,LRIDT,LRSB))
     16        ;
     17        ; Check if test is OK to send - (O)utput or (B)oth
     18        S LA7X=$P(LA7VAL,"^",12)
     19        I LA7X]"","BO"'[LA7X Q
     20        I LA7X="",'$$OKTOSND^LA7VHLU1(LRSS,LRSB,+$P($P(LA7VAL,"^",3),"!",5)) Q
     21        ;
     22        ; If no result NLT or LOINC try to determine from file #60
     23        S LA7X=$P(LA7VAL,"^",3)
     24        ; WV check for IHS - NLT/LN codes from V LAB file
     25        I $D(^AUPNVLAB) D TMPCHK^C0CLA7Q
     26        ;
     27        I $P(LA7X,"!",2)=""!($P(LA7X,"!",3)="") S $P(LA7VAL,"^",3)=$$DEFCODE^LA7VHLU5(LRSS,LRSB,LA7X,$P(LA76304(0),"^",5))
     28        ; No result NLT code - log error
     29        I $P($P(LA7VAL,"^",3),"!",2)="" D
     30        . N LA7X
     31        . S LA7X="["_LRSB_"]"_$$GET1^DID(63.04,LRSB,"","LABEL")
     32        . D CREATE^LA7LOG(36)
     33        ;
     34        ; something missing - No NLT code, etc.
     35        I LA7VAL="" Q
     36        ;
     37        ; Check for missing units/reference ranges
     38        S LA7X=$P(LA7VAL,"^",5)
     39        ;
     40        ; Results missing units, lookup in file #60
     41        I $P(LA7X,"!",7)="" S $P(LA7X,"!",7)=$P($$REFUNIT^LA7VHLU1(LRSB,$P(LA76304(0),"^",5)),"^",3)
     42        ;
     43        ; If results missing reference ranges, use values from file #60.
     44        I $P(LA7X,"!",2)="",$P(LA7X,"!",3)="",$P(LA7X,"!",11)="",$P(LA7X,"!",12)="" D
     45        . S LA7Y=$$REFUNIT^LA7VHLU1(LRSB,$P(LA76304(0),"^",5))
     46        . S $P(LA7X,"!",2)=$P(LA7Y,"^")
     47        . S $P(LA7X,"!",3)=$P(LA7Y,"^",2)
     48        . S $P(LA7X,"!",11)=$P(LA7Y,"^",6)
     49        . S $P(LA7X,"!",12)=$P(LA7Y,"^",7)
     50        ; Use therapeutic low/high if low/high missing.
     51        I $P(LA7X,"!",2)="",$P(LA7X,"!",3)="" D
     52        . S $P(LA7X,"!",2)=$P(LA7X,"!",11)
     53        . S $P(LA7X,"!",3)=$P(LA7X,"!",12)
     54        ;
     55        ; Evaluate low/high reference ranges in case M code in these fields.
     56        S:$G(SEX)="" SEX="M" S:$G(AGE)="" AGE=99
     57        F LA7I=2,3 I $E($P(LA7X,"!",LA7I),1,3)="$S(" D
     58        . S @("X="_$P(LA7X,"!",LA7I))
     59        . S $P(LA7X,"!",LA7I)=X
     60        ;
     61        ; Put units/reference ranges back in variable LA7VAL
     62        S $P(LA7VAL,"^",5)=LA7X
     63        ;
     64        ; Initialize OBX segment
     65        S LA7OBX(0)="OBX"
     66        S LA7OBX(1)=$$OBX1^LA7VOBX(.LA7OBXSN)
     67        ;
     68        ; Value type
     69        S LA7OBX(2)=$$OBX2^LA7VOBX(63.04,LRSB)
     70        ;
     71        ; Observation identifer
     72        ; build alternate code based on dataname from file #63 in case it's needed
     73        S LA7X=$P(LA7VAL,"^",3)
     74        S LA7ALT="CH"_LRSB_"^"_$$GET1^DID(63.04,LRSB,"","LABEL")_"^"_"99VA63"
     75        S LA7OBX(3)=$$OBX3^LA7VOBX($P(LA7X,"!",2),$P(LA7X,"!",3),LA7ALT,LA7FS,LA7ECH)
     76        ;
     77        ; Test value
     78        S LA7OBX(5)=$$OBX5^LA7VOBX($P(LA7VAL,"^"),LA7OBX(2),LA7FS,LA7ECH)
     79        ;
     80        ; Units - remove leading and trailing spaces
     81        S LA7X=$P(LA7VAL,"^",5),LA7X=$$TRIM^XLFSTR(LA7X,"LR"," ")
     82        S LA7OBX(6)=$$OBX6^LA7VOBX($P(LA7X,"!",7),"",LA7FS,LA7ECH)
     83        ;
     84        ; Reference range
     85        S LA7OBX(7)=$$OBX7^LA7VOBX($P(LA7X,"!",2),$P(LA7X,"!",3),LA7FS,LA7ECH)
     86        ;
     87        ; Abnormal flags
     88        S LA7OBX(8)=$$OBX8^LA7VOBX($P(LA7VAL,U,2))
     89        ;
     90        ; "P"artial or "F"inal results
     91        S LA7OBX(11)=$$OBX11^LA7VOBX($S("canccommentpending"[$P(LA7VAL,"^"):$P(LA7VAL,"^"),1:"F"))
     92        ;
     93        ; Observation date/time - collection date/time per HL7 standard
     94        I $P(LA76304(0),"^") S LA7OBX(14)=$$OBX14^LA7VOBX($P(LA76304(0),"^"))
     95        ;
     96        S LA7DIV=$P(LA7VAL,"^",9)
     97        I LA7DIV="",$$DIV4^XUSER(.LA7DIV,$P(LA7VAL,"^",4)) S LA7DIV=$O(LA7DIV(0))
     98        ;
     99        ; Facility that performed the testing
     100        S LA7OBX(15)=$$OBX15^LA7VOBX(LA7DIV,LA7FS,LA7ECH)
     101        ;
     102        ; Person that verified the test
     103        S LA7OBX(16)=$$OBX16^LA7VOBX($P(LA7VAL,"^",4),LA7DIV,LA7FS,LA7ECH)
     104        ;
     105        ; Observation method
     106        S LA7X=$P($P(LA7VAL,"^",3),"!",4)
     107        I LA7X S LA7OBX(17)=$$OBX17^LA7VOBX(LA7X,LA7FS,LA7ECH)
     108        ;
     109        ; Equipment entity identifier
     110        I $L($P(LA7VAL,"^",11)) S LA7OBX(18)=$$OBX18^LA7VOBX($P(LA7VAL,"^",11),LA7FS,LA7ECH)
     111        ;
     112        D BUILDSEG^LA7VHLU(.LA7OBX,.LA7ARRAY,LA7FS)
     113        ;
     114        Q
Note: See TracChangeset for help on using the changeset viewer.