source: FOIAVistA/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7VHLU1.m@ 1328

Last change on this file since 1328 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.7 KB
Line 
1LA7VHLU1 ;DALOI/JMC - HL7 segment builder utility ; 11-25-1998
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,61,64**;Sep 27, 1994
3 ;
4 ;
5SETID(LA76249,LA7ID,LA7X) ; Setup identifier's in TMP global for later storing.
6 ; Call with LA76249 = ien of message in #62.49
7 ; LA7ID = root of identifier
8 ; LA7X = value to add to identifier
9 N Y
10 S Y=$O(^TMP("LA7-ID",$J,LA76249,""),-1) ; get last entry
11 S Y=Y+1
12 S ^TMP("LA7-ID",$J,LA76249,Y)=LA7ID_LA7X
13 Q
14 ;
15 ;
16UTS(LA7628,LA7UID,LA760) ; Update test status on manifest
17 ; Call with LA7628 = ien of shipping manifest in #62.8
18 ; LA7UID = accession's UID
19 ; LA760 = file # 60 ien of ordered test
20 ;
21 ; Sets to status 4 (partial). Will deal with 5 (completed) at later time
22 ; when lab package has capability of designating an accession as completed.
23 ;
24 N LA762801,LA7X
25 ;
26 S LA762801=0
27 F S LA762801=$O(^LAHM(62.8,LA7628,10,"UID",LA7UID,LA762801)) Q:'LA762801 D
28 . S LA7X=$G(^LAHM(62.8,LA7628,10,LA762801,0))
29 . I $P(LA7X,"^",2)'=LA760 Q ; Not the test we're looking for.
30 . I $P(LA7X,"^",8)>2,$P(LA7X,"^",8)<5 D STSUP^LA7SMU(LA7628,LA762801,4)
31 Q
32 ;
33 ;
34UPID(LA76249) ; Update identifier's associated with the message in #62.49
35 ; Call with LA76249 = ien of message in #62.49
36 ;
37 N FDA,LA7CNT,LA7ERR,LA7I,LA7X
38 ;
39 S (LA7CNT,LA7I)=0
40 F S LA7I=$O(^TMP("LA7-ID",$J,LA76249,LA7I)) Q:'LA7I D
41 . S LA7CNT=LA7CNT+1
42 . S LA7X=^TMP("LA7-ID",$J,LA76249,LA7I)
43 . I LA7CNT=1 S FDA(1,62.49,LA76249_",",5)=LA7X
44 . ; Add code to store additional identifiers in new multiple field in #62.49
45 I $D(FDA(1)) D FILE^DIE("","FDA(1)","LA7ERR(1)")
46 ;
47 ; Clean up
48 K ^TMP("LA7-ID",$J,LA76249)
49 Q
50 ;
51 ;
52CHKDT(LA7X) ; Check validity of date/time
53 ; Adjust invalid times to closest valid time - correct for lab problem
54 ; that generated invalid FileMan date/times.
55 ; If hours>24 then set to 24 with no minutes/seconds
56 ; If minutes greater than 59 then set to 59
57 ; If seconds greater than 59 then set to 59
58 ;
59 N I,LA7Y,X
60 ;
61 S LA7Y=$P(LA7X,".",2)
62 ;
63 ; If time present then check otherwise skip and return input.
64 I $L(LA7Y) D
65 . F I=1:2:5 D
66 . . S LA7Y(I)=$E(LA7Y,I,I+1)
67 . . I $L(LA7Y(I))=1 S LA7Y(I)=LA7Y(I)_"0"
68 . . I LA7Y(I)>$S(I=1:24,1:59) S LA7Y(I)=$S(I=1:24,1:59)
69 . . I I=1,LA7Y(1)=24 S LA7Y=24
70 . S X="."_LA7Y(1)_LA7Y(3)_LA7Y(5),X=+X
71 . S $P(LA7X,".",2)=$P(X,".",2)
72 ;
73 Q LA7X
74 ;
75 ;
76REFUNIT(LA7SB,LA761) ; Find reference ranges/units from file #60
77 ; Call with LA7SB = dataname from "CH" subscript
78 ; LA761 = pointer to topography file #61
79 ;
80 ; Returns LA7Y = reference low^reference high^units^critcal low^critcal high^therapeutic low^therapeutic high
81 ;
82 ; Finds first entry in file #60 that is associated with this dataname.
83 N LA760,LA7X,LA7Y
84 ;
85 S LA7Y=""
86 S LA760=+$O(^LAB(60,"C","CH;"_LA7SB_";1",0))
87 S LA7X=$G(^LAB(60,LA760,1,LA761,0))
88 S $P(LA7Y,"^")=$P(LA7X,"^",2)
89 S $P(LA7Y,"^",2)=$P(LA7X,"^",3)
90 S $P(LA7Y,"^",3)=$P(LA7X,"^",7)
91 S $P(LA7Y,"^",4)=$P(LA7X,"^",4)
92 S $P(LA7Y,"^",5)=$P(LA7X,"^",5)
93 S $P(LA7Y,"^",6)=$P(LA7X,"^",11)
94 S $P(LA7Y,"^",7)=$P(LA7X,"^",12)
95 ;
96 Q LA7Y
97 ;
98 ;
99OKTOSND(LRSS,LRSB,LA760) ; Check if test ok to send - is (O)utput or (B)oth
100 ; Call with LRSS = file #63 subscript
101 ; LRSB = file #63 data name or field reference
102 ; LA760 = file #60 ien
103 ;
104 ; Returns LA7Y = 0-do not send, 1-yes-ok (default)
105 ;
106 N LA760,LA7X,LA7Y
107 S LA7Y=1
108 ;
109 ; If "CH" subscript check file #60 test's type that use this dataname
110 ; and if find one that is type "O" or "B" then set to yes.
111 I LRSS="CH" D
112 . I $G(LA760) D Q
113 . . I "BO"'[$P(^LAB(60,LA760,0),"^",3) S LA7Y=0
114 . S (LA760,LA7X)=0
115 . F S LA760=$O(^LAB(60,"C","CH;"_LRSB_";1",LA760)) Q:'LA760 D
116 . . I "BO"[$P(^LAB(60,LA760,0),"^",3) S LA7X=1
117 . S LA7Y=LA7X
118 ;
119 Q LA7Y
120 ;
121 ;
122FAMG(LA76248,LA7TYP) ; Find alert mail group for this alert type
123 ; Call with LA76248 = ien of entry in file #62.48
124 ; LA7TYP = type of alert
125 ; (1-new results)
126 ; (2-error on message)
127 ; (3-orders received)
128 ;
129 ; Returns LA7MG = name of mail group
130 ;
131 N LA7MG,X,Y
132 S (LA7MG,X)=""
133 F S X=$O(^LAHM(62.48,+$G(LA76248),20,"B",LA7TYP,X)) Q:'X D
134 . S Y=$G(^LAHM(62.48,LA76248,20,X,0))
135 . I $P(Y,"^",2)'="" S LA7MG=$P(Y,"^",2) ; Send to mail group.
136 ;
137 ; Fail safe mail group when no mail group specified
138 I LA7MG="" S LA7MG="LAB MESSAGING"
139 ;
140 Q LA7MG
141 ;
142 ;
143ABFLAGS ;; HL7 Table 0078 Abnormal flags
144 ;;Below low normal;;
145 ;;Above high normal;;
146 ;;Below lower panic limits;;
147 ;;Above upper panic limits;;
148 ;;Below absolute low-off instrument scale;;
149 ;;Above absolute high-off instrument scale;;
150 ;;Normal;;
151 ;;Abnormal;;
152 ;;Very abnormal;;
153 ;;Significant change up;;
154 ;;Significant change down;;
155 ;;Better;;
156 ;;Worse;;
157 ;;Susceptible;;
158 ;;Resistant;;
159 ;;Intermediate;;
160 ;;Moderately susceptible;;
161 ;;Very susceptible;;
Note: See TracBrowser for help on using the repository browser.