LA7VIN4A ;DALOI/JMC - Process Incoming UI Msgs, continued ;Jun 14, 2022@18:38
;;5.2;AUTOMATED LAB INSTRUMENTS;**74,80,88,101**;Sep 27, 1994;Build 6
;
;This routine is a continuation of LA7VIN4 and is only called from there.
Q
;
; ZEXCEPT is used to identify variables which are external to a specific TAG
; used in conjunction with Eclipse M-editor.
;
LAGEN ; Sets up variables for call to ^LAGEN, build entry in LAH
; requires LA7INST,LA7TRAY,LA7CUP,LA7AA,LA7AD,LA7AN,LA7LWL
; returns LA7ISQN=subscript to store results in ^LAH global
;
I LA7ENTRY="LOG" D
. I LA7INTYP>19,LA7INTYP<30 Q
. I '$D(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,0)) S LA7ERR=13,LA7AERR=$$CREATE^LA7LOG(LA7ERR,1)
I LA7ENTRY="LLIST" S:'LA7CUP LA7CUP=LA7IDE ;cup=sequence number
;
K LA7ISQN,LADT,LAGEN
K TRAY,CUP,LWL,WL,LROVER,METH,LOG,IDENT,ISQN
;
S LA7ISQN=""
S TRAY=+$G(LA7TRAY) S:'TRAY TRAY=1
S CUP=+$G(LA7CUP) S:'CUP CUP=1
;
S LWL=LA7LWL
I '$D(^LRO(68.2,+LWL,0)) D Q
. S LA7ERR=19,LA7AERR=$$CREATE^LA7LOG(LA7ERR,1)
;
; Set accession area to area of specimen, allow multiple areas on same instrument.
S WL=LA7AA
I '$D(^LRO(68,+WL,0)) D Q
. S LA7ERR=20,LA7AERR=$$CREATE^LA7LOG(LA7ERR,1)
S LROVER=$P(LA7624(0),"^",12)
;
; LEDI(MI & AP) override #62.4 setting so results never overlay unless same message
I LA7INTYP=10 D
. I LA7SS'?1(1"MI",1"SP",1"CY",1"EM") Q
. ; Use same entry in LAH if handling multiple OBR within same message for same accession/test
. I $P($G(LA7INTYP("ISQN",LWL)),"^",1,3)=(LA76249_"^"_LA7UID_"^"_LA7ONLT) S ISQN=$P(LA7INTYP("ISQN",LWL),"^",4),LROVER=2 Q
. S LROVER=0
S METH=$P(LA7624(0),"^",10)
S LOG=LA7AN
S IDENT=$P($G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,0)),"^",6) ;identity field
S IDE=+LA7IDE
S LADT=LA7AD
;
; If auto release then set flag to not overlay data in LAH unless from same message.
I LA7OBR49="AR" S LROVER=0
I $G(LA7UID)'="",$D(^TMP("LA7 AR",$J,LA7LWL,1,"AUTOREL-UID",LA7UID)) D
. N I
. S I=0
. F S I=$O(^TMP("LA7 AR",$J,LA7LWL,1,"AUTOREL-UID",LA7UID,I)) Q:'I I $D(^TMP("LA7 AR",$J,LA7LWL,1,"AUTOREL-UID",LA7UID,I,LA76249)) S ISQN=I,LROVER=2 Q
;
I LROVER<2 D
. N LRDFN ; Protect LRDFN - call into LAGEN can set to 0
. ;
. ; If POC interface call special entry point
. I LA7INTYP>19,LA7INTYP<30 S IDE=LA76249 D POC^LAGEN Q
. ;
. D @(LA7ENTRY_"^LAGEN") ;this disregards the CROSS LINK field in 62.4
;
S LA7ISQN=$G(ISQN)
;
I LA7ISQN<1 Q
; Save entry made in LAH for this load list and message for this accession (UID)
I LA7INTYP=10 S LA7INTYP("ISQN",LWL)=LA76249_"^"_LA7UID_"^"_LA7ONLT_"^"_LA7ISQN
;
; Build/store patient demographics array
N I,J,LA7OBRA,LA7PIDA,X,Y
S J="DFN^DOB^ICN^LOC^LRDFN^LRTDFN^PNM^SEX^SSN"
S J(0)="DFN^LA7DOB^LA7ICN^LA7LOC^LRDFN^LRTDFN^LA7PNM^LA7SEX^LA7SSN"
F I=1:1 S X=$P(J,"^",I) Q:X="" D
. S Y=$P(J(0),"^",I)
. I $G(@Y)'="" S LA7PIDA(X)=@Y
I $D(LA7PIDA) D POI^LAGEN(LA7LWL,LA7ISQN,"PID",.LA7PIDA)
;
; Build/store order info array
N LA7ONLTS
I LA7POP'="" S LA7POP=$P(LA7POP," [")
S X=$G(^LAH(LA7LWL,1,LA7ISQN,.1,"OBR","ORDNLT"))
I X'="",LA7ONLT'="",X'[LA7ONLT S LA7ONLTS=X_"^"_LA7ONLT
E S LA7ONLTS=LA7ONLT
S J="EOL^FID^ORCDT^ORDNLT^ORDP^ORDSPEC^PON^SID^PEB^PVB^PRI^ARI^TECH"
S J(0)="LA7EOL^LA7FID^LA7CDT^LA7ONLTS^LA7POP^LA7SPEC^LA7PON^LA7SID^LA7PEB^LA7PVB^LA7PRI^LA7ARI^LA7TECH"
F I=1:1 S X=$P(J,"^",I) Q:X="" D
. S Y=$P(J(0),"^",I)
. I $G(@Y)'="" S LA7OBRA(X)=@Y
I $D(LA7OBRA) D POI^LAGEN(LA7LWL,LA7ISQN,"OBR",.LA7OBRA)
;
; Save placer fields 1/2 and filler fields 1/2
I LA7SOBR>0 F I=18:1:21 S X=$P("PF1^PF2^FF1^FF2","^",I-17) S ^LAH(LA7LWL,1,LA7ISQN,.1,"OBR",X,LA7SOBR)=LA7OBR(I)
;
; Store interface type with results
D LATYP^LAGEN(LA7LWL,LA7ISQN,LA7INTYP)
;
; Store #62.49 ien with results
D LAMSGID^LAGEN(LA7LWL,LA7ISQN,LA76249)
;
; Store method name with LAH entry
D METH^LAGEN(LA7LWL,LA7ISQN,METH)
;
; Set flag if POC interface to start POC processing routine when
; finished - tasked by LA7VIN before shutdown
I LA7INTYP>19,LA7INTYP<30 S LA7INTYP("LWL",LA7LWL)=""
;
Q
;
;
SMUPDT ; Update shipping manifest in shipping event file #62.85
N LA7DATA,LA7NCS,LA7TST,LA7USID
;
S LA7USID=$$P^LA7VHLU(.LA7SEG,5,LA7FS) ; Universal Service ID (OBR-4)
S LA7TST=$P(LA7USID,LA7CS,1) ; Test code
S LA7NCS=$P(LA7USID,LA7CS,3) ; Name of coding system
S LA7TST(2)=$P(LA7USID,LA7CS,4) ; Alternate test code
S LA7NCS(2)=$P(LA7USID,LA7CS,6) ; Alternate coding system
;
; Determine ordered test, check primary and alternate
;LA*5.2*101: Pass in LA7629
S LA7OTST=$$DOT^LA7SMU1(LA7TST,LA7NCS,LA7UID,$P(LA7SM,"^"),$G(LA7629))
I 'LA7OTST,LA7TST(2)'="" S LA7OTST=$$DOT^LA7SMU1(LA7TST(2),LA7NCS(2),LA7UID,$P(LA7SM,"^"),$G(LA7629))
;
; Flag the Results Received Event in #62.85
I LA7MTYP="ORU" D
. S LA7DATA="SM70"_"^"_LA7MEDT_"^"_$G(LA7OTST)_"^"_$P(LA7SM,"^",2)
. D SEUP^LA7SMU(LA7UID,"2",LA7DATA)
;
; Flag the Test Received Event in #62.85
I LA7MTYP="ORR" D
. S LA7DATA="SM55"_"^"_LA7MEDT_"^"_$G(LA7OTST)_"^"_$P(LA7SM,"^",2)
. D SEUP^LA7SMU(LA7UID,"2",LA7DATA)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA7VIN4A 5143 printed Nov 22, 2024@16:50:38 Page 2
LA7VIN4A ;DALOI/JMC - Process Incoming UI Msgs, continued ;Jun 14, 2022@18:38
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**74,80,88,101**;Sep 27, 1994;Build 6
+2 ;
+3 ;This routine is a continuation of LA7VIN4 and is only called from there.
+4 QUIT
+5 ;
+6 ; ZEXCEPT is used to identify variables which are external to a specific TAG
+7 ; used in conjunction with Eclipse M-editor.
+8 ;
LAGEN ; Sets up variables for call to ^LAGEN, build entry in LAH
+1 ; requires LA7INST,LA7TRAY,LA7CUP,LA7AA,LA7AD,LA7AN,LA7LWL
+2 ; returns LA7ISQN=subscript to store results in ^LAH global
+3 ;
+4 IF LA7ENTRY="LOG"
Begin DoDot:1
+5 IF LA7INTYP>19
IF LA7INTYP<30
QUIT
+6 IF '$DATA(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,0))
SET LA7ERR=13
SET LA7AERR=$$CREATE^LA7LOG(LA7ERR,1)
End DoDot:1
+7 ;cup=sequence number
IF LA7ENTRY="LLIST"
if 'LA7CUP
SET LA7CUP=LA7IDE
+8 ;
+9 KILL LA7ISQN,LADT,LAGEN
+10 KILL TRAY,CUP,LWL,WL,LROVER,METH,LOG,IDENT,ISQN
+11 ;
+12 SET LA7ISQN=""
+13 SET TRAY=+$GET(LA7TRAY)
if 'TRAY
SET TRAY=1
+14 SET CUP=+$GET(LA7CUP)
if 'CUP
SET CUP=1
+15 ;
+16 SET LWL=LA7LWL
+17 IF '$DATA(^LRO(68.2,+LWL,0))
Begin DoDot:1
+18 SET LA7ERR=19
SET LA7AERR=$$CREATE^LA7LOG(LA7ERR,1)
End DoDot:1
QUIT
+19 ;
+20 ; Set accession area to area of specimen, allow multiple areas on same instrument.
+21 SET WL=LA7AA
+22 IF '$DATA(^LRO(68,+WL,0))
Begin DoDot:1
+23 SET LA7ERR=20
SET LA7AERR=$$CREATE^LA7LOG(LA7ERR,1)
End DoDot:1
QUIT
+24 SET LROVER=$PIECE(LA7624(0),"^",12)
+25 ;
+26 ; LEDI(MI & AP) override #62.4 setting so results never overlay unless same message
+27 IF LA7INTYP=10
Begin DoDot:1
+28 IF LA7SS'?1(1"MI",1"SP",1"CY",1"EM")
QUIT
+29 ; Use same entry in LAH if handling multiple OBR within same message for same accession/test
+30 IF $PIECE($GET(LA7INTYP("ISQN",LWL)),"^",1,3)=(LA76249_"^"_LA7UID_"^"_LA7ONLT)
SET ISQN=$PIECE(LA7INTYP("ISQN",LWL),"^",4)
SET LROVER=2
QUIT
+31 SET LROVER=0
End DoDot:1
+32 SET METH=$PIECE(LA7624(0),"^",10)
+33 SET LOG=LA7AN
+34 ;identity field
SET IDENT=$PIECE($GET(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,0)),"^",6)
+35 SET IDE=+LA7IDE
+36 SET LADT=LA7AD
+37 ;
+38 ; If auto release then set flag to not overlay data in LAH unless from same message.
+39 IF LA7OBR49="AR"
SET LROVER=0
+40 IF $GET(LA7UID)'=""
IF $DATA(^TMP("LA7 AR",$JOB,LA7LWL,1,"AUTOREL-UID",LA7UID))
Begin DoDot:1
+41 NEW I
+42 SET I=0
+43 FOR
SET I=$ORDER(^TMP("LA7 AR",$JOB,LA7LWL,1,"AUTOREL-UID",LA7UID,I))
if 'I
QUIT
IF $DATA(^TMP("LA7 AR",$JOB,LA7LWL,1,"AUTOREL-UID",LA7UID,I,LA76249))
SET ISQN=I
SET LROVER=2
QUIT
End DoDot:1
+44 ;
+45 IF LROVER<2
Begin DoDot:1
+46 ; Protect LRDFN - call into LAGEN can set to 0
NEW LRDFN
+47 ;
+48 ; If POC interface call special entry point
+49 IF LA7INTYP>19
IF LA7INTYP<30
SET IDE=LA76249
DO POC^LAGEN
QUIT
+50 ;
+51 ;this disregards the CROSS LINK field in 62.4
DO @(LA7ENTRY_"^LAGEN")
End DoDot:1
+52 ;
+53 SET LA7ISQN=$GET(ISQN)
+54 ;
+55 IF LA7ISQN<1
QUIT
+56 ; Save entry made in LAH for this load list and message for this accession (UID)
+57 IF LA7INTYP=10
SET LA7INTYP("ISQN",LWL)=LA76249_"^"_LA7UID_"^"_LA7ONLT_"^"_LA7ISQN
+58 ;
+59 ; Build/store patient demographics array
+60 NEW I,J,LA7OBRA,LA7PIDA,X,Y
+61 SET J="DFN^DOB^ICN^LOC^LRDFN^LRTDFN^PNM^SEX^SSN"
+62 SET J(0)="DFN^LA7DOB^LA7ICN^LA7LOC^LRDFN^LRTDFN^LA7PNM^LA7SEX^LA7SSN"
+63 FOR I=1:1
SET X=$PIECE(J,"^",I)
if X=""
QUIT
Begin DoDot:1
+64 SET Y=$PIECE(J(0),"^",I)
+65 IF $GET(@Y)'=""
SET LA7PIDA(X)=@Y
End DoDot:1
+66 IF $DATA(LA7PIDA)
DO POI^LAGEN(LA7LWL,LA7ISQN,"PID",.LA7PIDA)
+67 ;
+68 ; Build/store order info array
+69 NEW LA7ONLTS
+70 IF LA7POP'=""
SET LA7POP=$PIECE(LA7POP," [")
+71 SET X=$GET(^LAH(LA7LWL,1,LA7ISQN,.1,"OBR","ORDNLT"))
+72 IF X'=""
IF LA7ONLT'=""
IF X'[LA7ONLT
SET LA7ONLTS=X_"^"_LA7ONLT
+73 IF '$TEST
SET LA7ONLTS=LA7ONLT
+74 SET J="EOL^FID^ORCDT^ORDNLT^ORDP^ORDSPEC^PON^SID^PEB^PVB^PRI^ARI^TECH"
+75 SET J(0)="LA7EOL^LA7FID^LA7CDT^LA7ONLTS^LA7POP^LA7SPEC^LA7PON^LA7SID^LA7PEB^LA7PVB^LA7PRI^LA7ARI^LA7TECH"
+76 FOR I=1:1
SET X=$PIECE(J,"^",I)
if X=""
QUIT
Begin DoDot:1
+77 SET Y=$PIECE(J(0),"^",I)
+78 IF $GET(@Y)'=""
SET LA7OBRA(X)=@Y
End DoDot:1
+79 IF $DATA(LA7OBRA)
DO POI^LAGEN(LA7LWL,LA7ISQN,"OBR",.LA7OBRA)
+80 ;
+81 ; Save placer fields 1/2 and filler fields 1/2
+82 IF LA7SOBR>0
FOR I=18:1:21
SET X=$PIECE("PF1^PF2^FF1^FF2","^",I-17)
SET ^LAH(LA7LWL,1,LA7ISQN,.1,"OBR",X,LA7SOBR)=LA7OBR(I)
+83 ;
+84 ; Store interface type with results
+85 DO LATYP^LAGEN(LA7LWL,LA7ISQN,LA7INTYP)
+86 ;
+87 ; Store #62.49 ien with results
+88 DO LAMSGID^LAGEN(LA7LWL,LA7ISQN,LA76249)
+89 ;
+90 ; Store method name with LAH entry
+91 DO METH^LAGEN(LA7LWL,LA7ISQN,METH)
+92 ;
+93 ; Set flag if POC interface to start POC processing routine when
+94 ; finished - tasked by LA7VIN before shutdown
+95 IF LA7INTYP>19
IF LA7INTYP<30
SET LA7INTYP("LWL",LA7LWL)=""
+96 ;
+97 QUIT
+98 ;
+99 ;
SMUPDT ; Update shipping manifest in shipping event file #62.85
+1 NEW LA7DATA,LA7NCS,LA7TST,LA7USID
+2 ;
+3 ; Universal Service ID (OBR-4)
SET LA7USID=$$P^LA7VHLU(.LA7SEG,5,LA7FS)
+4 ; Test code
SET LA7TST=$PIECE(LA7USID,LA7CS,1)
+5 ; Name of coding system
SET LA7NCS=$PIECE(LA7USID,LA7CS,3)
+6 ; Alternate test code
SET LA7TST(2)=$PIECE(LA7USID,LA7CS,4)
+7 ; Alternate coding system
SET LA7NCS(2)=$PIECE(LA7USID,LA7CS,6)
+8 ;
+9 ; Determine ordered test, check primary and alternate
+10 ;LA*5.2*101: Pass in LA7629
+11 SET LA7OTST=$$DOT^LA7SMU1(LA7TST,LA7NCS,LA7UID,$PIECE(LA7SM,"^"),$GET(LA7629))
+12 IF 'LA7OTST
IF LA7TST(2)'=""
SET LA7OTST=$$DOT^LA7SMU1(LA7TST(2),LA7NCS(2),LA7UID,$PIECE(LA7SM,"^"),$GET(LA7629))
+13 ;
+14 ; Flag the Results Received Event in #62.85
+15 IF LA7MTYP="ORU"
Begin DoDot:1
+16 SET LA7DATA="SM70"_"^"_LA7MEDT_"^"_$GET(LA7OTST)_"^"_$PIECE(LA7SM,"^",2)
+17 DO SEUP^LA7SMU(LA7UID,"2",LA7DATA)
End DoDot:1
+18 ;
+19 ; Flag the Test Received Event in #62.85
+20 IF LA7MTYP="ORR"
Begin DoDot:1
+21 SET LA7DATA="SM55"_"^"_LA7MEDT_"^"_$GET(LA7OTST)_"^"_$PIECE(LA7SM,"^",2)
+22 DO SEUP^LA7SMU(LA7UID,"2",LA7DATA)
End DoDot:1
+23 QUIT
