- LA7VHLU1 ;DALOI/JMC - HL7 segment builder utility ;04/30/10 19:10
- ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,61,64,74**;Sep 27, 1994;Build 229
- ;
- ;
- SETID(LA76249,LA7ID,LA7X,LA7TYP) ; 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
- ; LA7TYP = type - primary(1) or additional(0)
- N Y
- I $G(LA7X)="" Q
- S Y=$O(^TMP("LA7-ID",$J,LA76249,""),-1)+1 ; get next entry
- S ^TMP("LA7-ID",$J,LA76249,Y)=LA7ID_LA7X_"^"_+$G(LA7TYP)
- 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,LA7ERR,LA7I,LA7TYP,LA7X
- ;
- S LA7I=0
- F S LA7I=$O(^TMP("LA7-ID",$J,LA76249,LA7I)) Q:'LA7I D
- . S LA7X=^TMP("LA7-ID",$J,LA76249,LA7I),LA7TYP=+$P(LA7X,"^",2)
- . I LA7TYP=1,$L($P(LA7X,"^"))<46 D
- . . S FDA(1,62.49,LA76249_",",5)=$P(LA7X,"^")
- . . D FILE^DIE("","FDA(1)","LA7ERR(1)"),CLEAN^DILF
- . I $D(^LAHM(62.49,LA76249,.2,"B",$P(LA7X,"^"))) Q
- . S FDA(2,62.49002,"+2,"_LA76249_",",.01)=$P(LA7X,"^")
- . D UPDATE^DIE("","FDA(2)","","LA7ERR(2)"),CLEAN^DILF
- ;
- ; Clean up
- D CLEAN^DILF
- 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 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
- ;
- ;
- GETISO(SUBFL,IENS) ; Retrieve isolate id for micro specimens from file #63
- ; Call with SUBFL = FileMan subfile #
- ; IENS = FileMan iens of record
- ;
- ; Returns LA7Y = isolate id as sub-id
- ;
- N LA7Y
- ;
- S LA7Y=$$GET1^DIQ(SUBFL,IENS,.1)
- I LA7Y="" D
- . N FDA,ID,LA74,LA7DIE
- . S ID=$S(SUBFL=63.3:3,SUBFL=63.34:6,SUBFL=63.37:9,SUBFL=63.39:12,SUBFL=63.43:17,1:"")
- . S ID=ID_"-"_$P(IENS,",")
- . S LA74=+$$KSP^XUPARAM("INST")
- . S LA7Y=$$MAKEISO^LRVRMI1(LA74,ID)
- . S FDA(63,SUBFL,IENS,.1)=LA7Y
- . D FILE^DIE("","FDA(63)","LA7DIE(2)")
- ;
- Q LA7Y
- ;
- ;
- LAHSTAT(LRLL,ISQN,ERR,ERRMSG) ;
- ; Determine related file #62.49 message(s) status for results in LAH global.
- ; Call with LRLL = ien of loadlist in LAH global
- ; ISQN = ien of entry in LAH(LRLL) global
- ; ERR = 0 (do not return error messages)
- ; = .5 (return status of last message processed)
- ; = 1 (return error messages in array ERRMSG)
- ;
- ; ERRMSG = array to return error messages (pass by reference)
- ;
- ; Returns STATUS = 0 (no related file #62.49 messages found)
- ; = 1 (one or more related file #62.49 messages encountered no errors in processing)
- ; = 2 (one or more related file #62.49 messages encountered errors in processing)
- ;
- ; ERRMSG = array listing related error messages (indexed by FM D/T of error)
- ; Example: ERRMSG(3061010.195711)="Msg #1070: No File #62.47 mapping found for OBX-3:0410.3\GRAM STAIN\99LAB"
- ;
- N I,K,LA7DT,LA7IEN,LA7X,STATUS,X
- S (LA7IEN,STATUS)=0
- F S LA7IEN=$O(^LAH(LRLL,1,ISQN,.01,LA7IEN)) Q:'LA7IEN D
- . I ERR=.5,LA7IEN'=$P(^LAH(LRLL,1,ISQN,0),"^",13) Q
- . S LA7X=$G(^LAHM(62.49,LA7IEN,0))
- . I $P(LA7X,"^",3)="X",STATUS=0 S STATUS=1 Q
- . I $P(LA7X,"^",3)'="E" Q
- . S STATUS=2 Q:'ERR
- . S LA7DT=$P(LA7X,"^",5),LA7DT(0)=LA7DT\1,LA7DT(1)=LA7DT#1
- . S K="LA7ERR^"_(LA7DT(0)-.1)
- . F S K=$O(^XTMP(K)) Q:K=""!($P(K,"^")'="LA7ERR") D
- . . I LA7DT(0)=$P(K,"^",2) S I=LA7DT(1)-.00000001
- . . E S I=0
- . . F S I=$O(^XTMP(K,I)) Q:'I D
- . . . S X=^XTMP(K,I)
- . . . I $P(X,"^",2)=LA7IEN S ERRMSG($P(K,"^",2)_I)=$$DECODEUP^XMCU1($P(X,"^",4))
- ;
- Q STATUS
- ;
- ;
- LAHSTATP(ERRMSG) ; Print/display error array from LAHSTAT function call.
- ; Call with ERRMSG = array of error messages (pass by reference)
- ;
- N A,LA7IEN,LAJ
- ;
- S LA7IEN=0,LAJ=1
- S A(LAJ)="Errors reported on message(s):",A(LAJ,"F")="!!"
- F S LA7IEN=$O(ERRMSG(LA7IEN)) Q:'LA7IEN S LAJ=LAJ+1,A(LAJ)=$$FMTE^XLFDT(LA7IEN,"1M")_" - "_ERRMSG(LA7IEN),A(LAJ,"F")="!?1"
- D EN^DDIOL(.A)
- Q
- ;
- ;
- 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;;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA7VHLU1 7894 printed Feb 18, 2025@23:06:31 Page 2
- LA7VHLU1 ;DALOI/JMC - HL7 segment builder utility ;04/30/10 19:10
- +1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,61,64,74**;Sep 27, 1994;Build 229
- +2 ;
- +3 ;
- SETID(LA76249,LA7ID,LA7X,LA7TYP) ; 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 ; LA7TYP = type - primary(1) or additional(0)
- +5 NEW Y
- +6 IF $GET(LA7X)=""
- QUIT
- +7 ; get next entry
- SET Y=$ORDER(^TMP("LA7-ID",$JOB,LA76249,""),-1)+1
- +8 SET ^TMP("LA7-ID",$JOB,LA76249,Y)=LA7ID_LA7X_"^"_+$GET(LA7TYP)
- +9 QUIT
- +10 ;
- +11 ;
- 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,LA7ERR,LA7I,LA7TYP,LA7X
- +4 ;
- +5 SET LA7I=0
- +6 FOR
- SET LA7I=$ORDER(^TMP("LA7-ID",$JOB,LA76249,LA7I))
- if 'LA7I
- QUIT
- Begin DoDot:1
- +7 SET LA7X=^TMP("LA7-ID",$JOB,LA76249,LA7I)
- SET LA7TYP=+$PIECE(LA7X,"^",2)
- +8 IF LA7TYP=1
- IF $LENGTH($PIECE(LA7X,"^"))<46
- Begin DoDot:2
- +9 SET FDA(1,62.49,LA76249_",",5)=$PIECE(LA7X,"^")
- +10 DO FILE^DIE("","FDA(1)","LA7ERR(1)")
- DO CLEAN^DILF
- End DoDot:2
- +11 IF $DATA(^LAHM(62.49,LA76249,.2,"B",$PIECE(LA7X,"^")))
- QUIT
- +12 SET FDA(2,62.49002,"+2,"_LA76249_",",.01)=$PIECE(LA7X,"^")
- +13 DO UPDATE^DIE("","FDA(2)","","LA7ERR(2)")
- DO CLEAN^DILF
- End DoDot:1
- +14 ;
- +15 ; Clean up
- +16 DO CLEAN^DILF
- +17 KILL ^TMP("LA7-ID",$JOB,LA76249)
- +18 QUIT
- +19 ;
- +20 ;
- 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 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 ;
- GETISO(SUBFL,IENS) ; Retrieve isolate id for micro specimens from file #63
- +1 ; Call with SUBFL = FileMan subfile #
- +2 ; IENS = FileMan iens of record
- +3 ;
- +4 ; Returns LA7Y = isolate id as sub-id
- +5 ;
- +6 NEW LA7Y
- +7 ;
- +8 SET LA7Y=$$GET1^DIQ(SUBFL,IENS,.1)
- +9 IF LA7Y=""
- Begin DoDot:1
- +10 NEW FDA,ID,LA74,LA7DIE
- +11 SET ID=$SELECT(SUBFL=63.3:3,SUBFL=63.34:6,SUBFL=63.37:9,SUBFL=63.39:12,SUBFL=63.43:17,1:"")
- +12 SET ID=ID_"-"_$PIECE(IENS,",")
- +13 SET LA74=+$$KSP^XUPARAM("INST")
- +14 SET LA7Y=$$MAKEISO^LRVRMI1(LA74,ID)
- +15 SET FDA(63,SUBFL,IENS,.1)=LA7Y
- +16 DO FILE^DIE("","FDA(63)","LA7DIE(2)")
- End DoDot:1
- +17 ;
- +18 QUIT LA7Y
- +19 ;
- +20 ;
- LAHSTAT(LRLL,ISQN,ERR,ERRMSG) ;
- +1 ; Determine related file #62.49 message(s) status for results in LAH global.
- +2 ; Call with LRLL = ien of loadlist in LAH global
- +3 ; ISQN = ien of entry in LAH(LRLL) global
- +4 ; ERR = 0 (do not return error messages)
- +5 ; = .5 (return status of last message processed)
- +6 ; = 1 (return error messages in array ERRMSG)
- +7 ;
- +8 ; ERRMSG = array to return error messages (pass by reference)
- +9 ;
- +10 ; Returns STATUS = 0 (no related file #62.49 messages found)
- +11 ; = 1 (one or more related file #62.49 messages encountered no errors in processing)
- +12 ; = 2 (one or more related file #62.49 messages encountered errors in processing)
- +13 ;
- +14 ; ERRMSG = array listing related error messages (indexed by FM D/T of error)
- +15 ; Example: ERRMSG(3061010.195711)="Msg #1070: No File #62.47 mapping found for OBX-3:0410.3\GRAM STAIN\99LAB"
- +16 ;
- +17 NEW I,K,LA7DT,LA7IEN,LA7X,STATUS,X
- +18 SET (LA7IEN,STATUS)=0
- +19 FOR
- SET LA7IEN=$ORDER(^LAH(LRLL,1,ISQN,.01,LA7IEN))
- if 'LA7IEN
- QUIT
- Begin DoDot:1
- +20 IF ERR=.5
- IF LA7IEN'=$PIECE(^LAH(LRLL,1,ISQN,0),"^",13)
- QUIT
- +21 SET LA7X=$GET(^LAHM(62.49,LA7IEN,0))
- +22 IF $PIECE(LA7X,"^",3)="X"
- IF STATUS=0
- SET STATUS=1
- QUIT
- +23 IF $PIECE(LA7X,"^",3)'="E"
- QUIT
- +24 SET STATUS=2
- if 'ERR
- QUIT
- +25 SET LA7DT=$PIECE(LA7X,"^",5)
- SET LA7DT(0)=LA7DT\1
- SET LA7DT(1)=LA7DT#1
- +26 SET K="LA7ERR^"_(LA7DT(0)-.1)
- +27 FOR
- SET K=$ORDER(^XTMP(K))
- if K=""!($PIECE(K,"^")'="LA7ERR")
- QUIT
- Begin DoDot:2
- +28 IF LA7DT(0)=$PIECE(K,"^",2)
- SET I=LA7DT(1)-.00000001
- +29 IF '$TEST
- SET I=0
- +30 FOR
- SET I=$ORDER(^XTMP(K,I))
- if 'I
- QUIT
- Begin DoDot:3
- +31 SET X=^XTMP(K,I)
- +32 IF $PIECE(X,"^",2)=LA7IEN
- SET ERRMSG($PIECE(K,"^",2)_I)=$$DECODEUP^XMCU1($PIECE(X,"^",4))
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +33 ;
- +34 QUIT STATUS
- +35 ;
- +36 ;
- LAHSTATP(ERRMSG) ; Print/display error array from LAHSTAT function call.
- +1 ; Call with ERRMSG = array of error messages (pass by reference)
- +2 ;
- +3 NEW A,LA7IEN,LAJ
- +4 ;
- +5 SET LA7IEN=0
- SET LAJ=1
- +6 SET A(LAJ)="Errors reported on message(s):"
- SET A(LAJ,"F")="!!"
- +7 FOR
- SET LA7IEN=$ORDER(ERRMSG(LA7IEN))
- if 'LA7IEN
- QUIT
- SET LAJ=LAJ+1
- SET A(LAJ)=$$FMTE^XLFDT(LA7IEN,"1M")_" - "_ERRMSG(LA7IEN)
- SET A(LAJ,"F")="!?1"
- +8 DO EN^DDIOL(.A)
- +9 QUIT
- +10 ;
- +11 ;
- 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;;