LA7VHLU1 ;VA/DALOI/JMC - HL7 segment builder utility ;JUL 06, 2010 3:14 PM
;;5.2;AUTOMATED LAB INSTRUMENTS;**46,61,64,1027**;NOV 01, 1997
;
;
SETID(LA76249,LA7ID,LA7X) ; Setup identifier's in TMP global for later storing.
; Call with LA76249 = ien of message in #62.49
; LA7ID = root of identifier
; LA7X = value to add to identifier
N Y
S Y=$O(^TMP("LA7-ID",$J,LA76249,""),-1) ; get last entry
S Y=Y+1
S ^TMP("LA7-ID",$J,LA76249,Y)=LA7ID_LA7X
Q
;
;
UTS(LA7628,LA7UID,LA760) ; Update test status on manifest
; Call with LA7628 = ien of shipping manifest in #62.8
; LA7UID = accession's UID
; LA760 = file # 60 ien of ordered test
;
; Sets to status 4 (partial). Will deal with 5 (completed) at later time
; when lab package has capability of designating an accession as completed.
;
N LA762801,LA7X
;
S LA762801=0
F S LA762801=$O(^LAHM(62.8,LA7628,10,"UID",LA7UID,LA762801)) Q:'LA762801 D
. S LA7X=$G(^LAHM(62.8,LA7628,10,LA762801,0))
. I $P(LA7X,"^",2)'=LA760 Q ; Not the test we're looking for.
. I $P(LA7X,"^",8)>2,$P(LA7X,"^",8)<5 D STSUP^LA7SMU(LA7628,LA762801,4)
Q
;
;
UPID(LA76249) ; Update identifier's associated with the message in #62.49
; Call with LA76249 = ien of message in #62.49
;
N FDA,LA7CNT,LA7ERR,LA7I,LA7X
;
S (LA7CNT,LA7I)=0
F S LA7I=$O(^TMP("LA7-ID",$J,LA76249,LA7I)) Q:'LA7I D
. S LA7CNT=LA7CNT+1
. S LA7X=^TMP("LA7-ID",$J,LA76249,LA7I)
. I LA7CNT=1 S FDA(1,62.49,LA76249_",",5)=LA7X
. ; Add code to store additional identifiers in new multiple field in #62.49
I $D(FDA(1)) D FILE^DIE("","FDA(1)","LA7ERR(1)")
;
; Clean up
K ^TMP("LA7-ID",$J,LA76249)
Q
;
;
CHKDT(LA7X) ; Check validity of date/time
; Adjust invalid times to closest valid time - correct for lab problem
; that generated invalid FileMan date/times.
; If hours>24 then set to 24 with no minutes/seconds
; If minutes greater than 59 then set to 59
; If seconds greater than 59 then set to 59
;
N I,LA7Y,X
;
S LA7Y=$P(LA7X,".",2)
;
; If time present then check otherwise skip and return input.
I $L(LA7Y) D
. F I=1:2:5 D
. . S LA7Y(I)=$E(LA7Y,I,I+1)
. . I $L(LA7Y(I))=1 S LA7Y(I)=LA7Y(I)_"0"
. . I LA7Y(I)>$S(I=1:24,1:59) S LA7Y(I)=$S(I=1:24,1:59)
. . I I=1,LA7Y(1)=24 S LA7Y=24
. S X="."_LA7Y(1)_LA7Y(3)_LA7Y(5),X=+X
. S $P(LA7X,".",2)=$P(X,".",2)
;
Q LA7X
;
;
REFUNIT(LA7SB,LA761) ; Find reference ranges/units from file #60
; Call with LA7SB = dataname from "CH" subscript
; LA761 = pointer to topography file #61
;
; Returns LA7Y = reference low^reference high^units^critcal low^critcal high^therapeutic low^therapeutic high
;
; Finds first entry in file #60 that is associated with this dataname.
N LA760,LA7X,LA7Y
;
S LA7Y=""
S LA760=+$O(^LAB(60,"C","CH;"_LA7SB_";1",0))
S LA7X=$G(^LAB(60,LA760,1,LA761,0))
S $P(LA7Y,"^")=$P(LA7X,"^",2)
S $P(LA7Y,"^",2)=$P(LA7X,"^",3)
S $P(LA7Y,"^",3)=$P(LA7X,"^",7)
S $P(LA7Y,"^",4)=$P(LA7X,"^",4)
S $P(LA7Y,"^",5)=$P(LA7X,"^",5)
S $P(LA7Y,"^",6)=$P(LA7X,"^",11)
S $P(LA7Y,"^",7)=$P(LA7X,"^",12)
;
Q LA7Y
;
;
OKTOSND(LRSS,LRSB,LA760) ; Check if test ok to send - is (O)utput or (B)oth
; Call with LRSS = file #63 subscript
; LRSB = file #63 data name or field reference
; LA760 = file #60 ien
;
; Returns LA7Y = 0-do not send, 1-yes-ok (default)
;
N LA760,LA7X,LA7Y
S LA7Y=1
;
; If "CH" subscript check file #60 test's type that use this dataname
; and if find one that is type "O" or "B" then set to yes.
I LRSS="CH" D
. I $G(LA760) D Q
. . I "BO"'[$P(^LAB(60,LA760,0),"^",3) S LA7Y=0
. S (LA760,LA7X)=0
. F S LA760=$O(^LAB(60,"C","CH;"_LRSB_";1",LA760)) Q:'LA760 D
. . I "BO"[$P(^LAB(60,LA760,0),"^",3) S LA7X=1
. S LA7Y=LA7X
;
Q LA7Y
;
;
FAMG(LA76248,LA7TYP) ; Find alert mail group for this alert type
; Call with LA76248 = ien of entry in file #62.48
; LA7TYP = type of alert
; (1-new results)
; (2-error on message)
; (3-orders received)
;
; Returns LA7MG = name of mail group
;
N LA7MG,X,Y
S (LA7MG,X)=""
F S X=$O(^LAHM(62.48,+$G(LA76248),20,"B",LA7TYP,X)) Q:'X D
. S Y=$G(^LAHM(62.48,LA76248,20,X,0))
. I $P(Y,"^",2)'="" S LA7MG=$P(Y,"^",2) ; Send to mail group.
;
; Fail safe mail group when no mail group specified
I LA7MG="" S LA7MG="LAB MESSAGING"
;
Q LA7MG
;
;
ABFLAGS ;; HL7 Table 0078 Abnormal flags
;;Below low normal;;
;;Above high normal;;
;;Below lower panic limits;;
;;Above upper panic limits;;
;;Below absolute low-off instrument scale;;
;;Above absolute high-off instrument scale;;
;;Normal;;
;;Abnormal;;
;;Very abnormal;;
;;Significant change up;;
;;Significant change down;;
;;Better;;
;;Worse;;
;;Susceptible;;
;;Resistant;;
;;Intermediate;;
;;Moderately susceptible;;
;;Very susceptible;;
LA7VHLU1 ;VA/DALOI/JMC - HL7 segment builder utility ;JUL 06, 2010 3:14 PM
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,61,64,1027**;NOV 01, 1997
+2 ;
+3 ;
SETID(LA76249,LA7ID,LA7X) ; Setup identifier's in TMP global for later storing.
+1 ; Call with LA76249 = ien of message in #62.49
+2 ; LA7ID = root of identifier
+3 ; LA7X = value to add to identifier
+4 NEW Y
+5 ; get last entry
SET Y=$ORDER(^TMP("LA7-ID",$JOB,LA76249,""),-1)
+6 SET Y=Y+1
+7 SET ^TMP("LA7-ID",$JOB,LA76249,Y)=LA7ID_LA7X
+8 QUIT
+9 ;
+10 ;
UTS(LA7628,LA7UID,LA760) ; Update test status on manifest
+1 ; Call with LA7628 = ien of shipping manifest in #62.8
+2 ; LA7UID = accession's UID
+3 ; LA760 = file # 60 ien of ordered test
+4 ;
+5 ; Sets to status 4 (partial). Will deal with 5 (completed) at later time
+6 ; when lab package has capability of designating an accession as completed.
+7 ;
+8 NEW LA762801,LA7X
+9 ;
+10 SET LA762801=0
+11 FOR
SET LA762801=$ORDER(^LAHM(62.8,LA7628,10,"UID",LA7UID,LA762801))
IF 'LA762801
QUIT
Begin DoDot:1
+12 SET LA7X=$GET(^LAHM(62.8,LA7628,10,LA762801,0))
+13 ; Not the test we're looking for.
IF $PIECE(LA7X,"^",2)'=LA760
QUIT
+14 IF $PIECE(LA7X,"^",8)>2
IF $PIECE(LA7X,"^",8)<5
DO STSUP^LA7SMU(LA7628,LA762801,4)
End DoDot:1
+15 QUIT
+16 ;
+17 ;
UPID(LA76249) ; Update identifier's associated with the message in #62.49
+1 ; Call with LA76249 = ien of message in #62.49
+2 ;
+3 NEW FDA,LA7CNT,LA7ERR,LA7I,LA7X
+4 ;
+5 SET (LA7CNT,LA7I)=0
+6 FOR
SET LA7I=$ORDER(^TMP("LA7-ID",$JOB,LA76249,LA7I))
IF 'LA7I
QUIT
Begin DoDot:1
+7 SET LA7CNT=LA7CNT+1
+8 SET LA7X=^TMP("LA7-ID",$JOB,LA76249,LA7I)
+9 IF LA7CNT=1
SET FDA(1,62.49,LA76249_",",5)=LA7X
+10 ; Add code to store additional identifiers in new multiple field in #62.49
End DoDot:1
+11 IF $DATA(FDA(1))
DO FILE^DIE("","FDA(1)","LA7ERR(1)")
+12 ;
+13 ; Clean up
+14 KILL ^TMP("LA7-ID",$JOB,LA76249)
+15 QUIT
+16 ;
+17 ;
CHKDT(LA7X) ; Check validity of date/time
+1 ; Adjust invalid times to closest valid time - correct for lab problem
+2 ; that generated invalid FileMan date/times.
+3 ; If hours>24 then set to 24 with no minutes/seconds
+4 ; If minutes greater than 59 then set to 59
+5 ; If seconds greater than 59 then set to 59
+6 ;
+7 NEW I,LA7Y,X
+8 ;
+9 SET LA7Y=$PIECE(LA7X,".",2)
+10 ;
+11 ; If time present then check otherwise skip and return input.
+12 IF $LENGTH(LA7Y)
Begin DoDot:1
+13 FOR I=1:2:5
Begin DoDot:2
+14 SET LA7Y(I)=$EXTRACT(LA7Y,I,I+1)
+15 IF $LENGTH(LA7Y(I))=1
SET LA7Y(I)=LA7Y(I)_"0"
+16 IF LA7Y(I)>$SELECT(I=1:24,1:59)
SET LA7Y(I)=$SELECT(I=1:24,1:59)
+17 IF I=1
IF LA7Y(1)=24
SET LA7Y=24
End DoDot:2
+18 SET X="."_LA7Y(1)_LA7Y(3)_LA7Y(5)
SET X=+X
+19 SET $PIECE(LA7X,".",2)=$PIECE(X,".",2)
End DoDot:1
+20 ;
+21 QUIT LA7X
+22 ;
+23 ;
REFUNIT(LA7SB,LA761) ; Find reference ranges/units from file #60
+1 ; Call with LA7SB = dataname from "CH" subscript
+2 ; LA761 = pointer to topography file #61
+3 ;
+4 ; Returns LA7Y = reference low^reference high^units^critcal low^critcal high^therapeutic low^therapeutic high
+5 ;
+6 ; Finds first entry in file #60 that is associated with this dataname.
+7 NEW LA760,LA7X,LA7Y
+8 ;
+9 SET LA7Y=""
+10 SET LA760=+$ORDER(^LAB(60,"C","CH;"_LA7SB_";1",0))
+11 SET LA7X=$GET(^LAB(60,LA760,1,LA761,0))
+12 SET $PIECE(LA7Y,"^")=$PIECE(LA7X,"^",2)
+13 SET $PIECE(LA7Y,"^",2)=$PIECE(LA7X,"^",3)
+14 SET $PIECE(LA7Y,"^",3)=$PIECE(LA7X,"^",7)
+15 SET $PIECE(LA7Y,"^",4)=$PIECE(LA7X,"^",4)
+16 SET $PIECE(LA7Y,"^",5)=$PIECE(LA7X,"^",5)
+17 SET $PIECE(LA7Y,"^",6)=$PIECE(LA7X,"^",11)
+18 SET $PIECE(LA7Y,"^",7)=$PIECE(LA7X,"^",12)
+19 ;
+20 QUIT LA7Y
+21 ;
+22 ;
OKTOSND(LRSS,LRSB,LA760) ; Check if test ok to send - is (O)utput or (B)oth
+1 ; Call with LRSS = file #63 subscript
+2 ; LRSB = file #63 data name or field reference
+3 ; LA760 = file #60 ien
+4 ;
+5 ; Returns LA7Y = 0-do not send, 1-yes-ok (default)
+6 ;
+7 NEW LA760,LA7X,LA7Y
+8 SET LA7Y=1
+9 ;
+10 ; If "CH" subscript check file #60 test's type that use this dataname
+11 ; and if find one that is type "O" or "B" then set to yes.
+12 IF LRSS="CH"
Begin DoDot:1
+13 IF $GET(LA760)
Begin DoDot:2
+14 IF "BO"'[$PIECE(^LAB(60,LA760,0),"^",3)
SET LA7Y=0
End DoDot:2
QUIT
+15 SET (LA760,LA7X)=0
+16 FOR
SET LA760=$ORDER(^LAB(60,"C","CH;"_LRSB_";1",LA760))
IF 'LA760
QUIT
Begin DoDot:2
+17 IF "BO"[$PIECE(^LAB(60,LA760,0),"^",3)
SET LA7X=1
End DoDot:2
+18 SET LA7Y=LA7X
End DoDot:1
+19 ;
+20 QUIT LA7Y
+21 ;
+22 ;
FAMG(LA76248,LA7TYP) ; Find alert mail group for this alert type
+1 ; Call with LA76248 = ien of entry in file #62.48
+2 ; LA7TYP = type of alert
+3 ; (1-new results)
+4 ; (2-error on message)
+5 ; (3-orders received)
+6 ;
+7 ; Returns LA7MG = name of mail group
+8 ;
+9 NEW LA7MG,X,Y
+10 SET (LA7MG,X)=""
+11 FOR
SET X=$ORDER(^LAHM(62.48,+$GET(LA76248),20,"B",LA7TYP,X))
IF 'X
QUIT
Begin DoDot:1
+12 SET Y=$GET(^LAHM(62.48,LA76248,20,X,0))
+13 ; Send to mail group.
IF $PIECE(Y,"^",2)'=""
SET LA7MG=$PIECE(Y,"^",2)
End DoDot:1
+14 ;
+15 ; Fail safe mail group when no mail group specified
+16 IF LA7MG=""
SET LA7MG="LAB MESSAGING"
+17 ;
+18 QUIT LA7MG
+19 ;
+20 ;
ABFLAGS ;; HL7 Table 0078 Abnormal flags
+1 ;;Below low normal;;
+2 ;;Above high normal;;
+3 ;;Below lower panic limits;;
+4 ;;Above upper panic limits;;
+5 ;;Below absolute low-off instrument scale;;
+6 ;;Above absolute high-off instrument scale;;
+7 ;;Normal;;
+8 ;;Abnormal;;
+9 ;;Very abnormal;;
+10 ;;Significant change up;;
+11 ;;Significant change down;;
+12 ;;Better;;
+13 ;;Worse;;
+14 ;;Susceptible;;
+15 ;;Resistant;;
+16 ;;Intermediate;;
+17 ;;Moderately susceptible;;
+18 ;;Very susceptible;;
