LA7UIO ;DALOI/JMC - Process Download Message for #62.48 ;05/30/13 15:59
;;5.2;AUTOMATED LAB INSTRUMENTS;**66,80**;Sep 27, 1994;Build 19
;
Q
;
EN ; Called from LA7UID
; Converts the information for each test in the load list
; into HL7 messages and hands them to the HL7 package for delivery.
; LRLL= IEN in 68.2 Load Worklist file, from field in 62.4
; LRINST= IEN IN 62.4 Auto Inst file
; LRAUTO= zero node of 62.4 entry
; LA76248= IEN in 62.48 Message Parameter file
;
N LA76281,LA7,LA7CUP,LA7CUP1,LA7TRAY,LA7TRAY1
;
; Preparing automatic download.
I $G(LA7ADL) D ADL Q
;
S LA7=^LRO(68.2,LRLL,2)
S LA7TRAY=$P(LA7,"^",2),LA7TRAY1=$P(LA7,"^",4)
S LA7CUP=$P(LA7,"^",3),LA7CUP1=$P(LA7,"^",5)
S:$G(LRTRAY1) LA7TRAY=LRTRAY1
S:$G(LRCUP1) LA7CUP=LRCUP1
;
; Process each tray on load list
S LA76821=LA7TRAY-1
F S LA76821=$O(^LRO(68.2,LRLL,1,LA76821)) Q:'LA76821!(LA76821>LA7TRAY1) D
. I '$D(ZTQUEUED) D
. . W !!,"Building download record for:"
. . I LRTYPE W " Tray: ",LA76821,!,"Cup: "
. . E W !,"Seq: "
. D CUP
D EXIT
Q
;
;
CUP ; Process each cup on load list
N LA761,LA76822,LA7QUIT,X
;
S LA76822=LA7CUP-1,LA7QUIT=0
F S LA76822=$O(^LRO(68.2,LRLL,1,LA76821,1,LA76822)) Q:'LA76822 D Q:LA7QUIT
. I LA76821=LA7TRAY1,LA76822>LA7CUP1 S LA7QUIT=1 Q
. ; Kill array of tests for this accession
. K LA76249,LA7ACC
. S LA7ACC=^LRO(68.2,LRLL,1,LA76821,1,LA76822,0)
. ; Not requested loadlist profile.
. I 'LRPROF,($P(LRPROF,"^",2)'=$P(LA7ACC,"^",4)) Q
. ;
. S LRAA=+LA7ACC,LRAD=$P(LA7ACC,"^",2),LRAN=$P(LA7ACC,"^",3)
. S LA768=LRAA,LA76801=LRAD,LA76802=LRAN
. S LA7ACC0=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,0),0)
. ;
. S LA761=0
. S X=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,5,0))
. I X>0 S LA761=+$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,5,X,0)),"^")
. ;
. ; Accession has been removed, skip.
. I 'LA7ACC0 D Q
. . D CREATE^LA7LOG(24)
. ;
. D TEST
. S LA7INST=LRINST D CHKTEST^LA7ADL
. N LA7QUIT
. I $O(LA7ACC(0)) D BUILD^LA7UIO1
Q
;
;
TEST ;
N LA7TST
;
K LA7TREE
;
S LA7TST=0
F S LA7TST=$O(^LRO(68.2,LRLL,1,LA76821,1,LA76822,1,LA7TST)) Q:'LA7TST D
. N LA7X,LA7PCNT
. S LA7X=$G(^LRO(68.2,LRLL,1,LA76821,1,LA76822,1,LA7TST,0))
. S LA7PCNT=0
. D UNWIND^LA7ADL1(+LA7X,$P(LA7X,"^",2),0)
Q
;
;
ADL ; Process/build messages for automatic download, no loadlist.
; Called from above by LA7ADL.
;
S LRLL=0,LRAUTO=LA7AUTO(LA7INST)
; Set tray/cup to null.
S (LA76821,LA76822)=""
;
S LA768=LRAA,LA76801=LRAD,LA76802=LRAN
; Zeroth node of accession.
; Log error if accession has been removed, skip
S LA7ACC0=$G(^LRO(68,LA768,1,LA76801,1,LA76802,0),0)
I 'LA7ACC0 D Q
. D CREATE^LA7LOG(24)
;
D BUILD^LA7UIO1
D EXIT
K LRAUTO,LRINST,LRLL
Q
;
EXIT ;
D KVAR^LRX
K LA7,LA71,LA76249,LA768,LA76801,LA76802,LA76821,LA76822,LA7ACC,LA7ACC0
K LA7CNT,LA7CODE,LA7DATA,LA7DTIM,LA7MSH,LA7NVAF,LA7OBR,LA7ORC,LA7PID,LA7PIDSN,LA7PV1,LA7TMP,LRINFW
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA7UIO 2996 printed Dec 13, 2024@01:39:53 Page 2
LA7UIO ;DALOI/JMC - Process Download Message for #62.48 ;05/30/13 15:59
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**66,80**;Sep 27, 1994;Build 19
+2 ;
+3 QUIT
+4 ;
EN ; Called from LA7UID
+1 ; Converts the information for each test in the load list
+2 ; into HL7 messages and hands them to the HL7 package for delivery.
+3 ; LRLL= IEN in 68.2 Load Worklist file, from field in 62.4
+4 ; LRINST= IEN IN 62.4 Auto Inst file
+5 ; LRAUTO= zero node of 62.4 entry
+6 ; LA76248= IEN in 62.48 Message Parameter file
+7 ;
+8 NEW LA76281,LA7,LA7CUP,LA7CUP1,LA7TRAY,LA7TRAY1
+9 ;
+10 ; Preparing automatic download.
+11 IF $GET(LA7ADL)
DO ADL
QUIT
+12 ;
+13 SET LA7=^LRO(68.2,LRLL,2)
+14 SET LA7TRAY=$PIECE(LA7,"^",2)
SET LA7TRAY1=$PIECE(LA7,"^",4)
+15 SET LA7CUP=$PIECE(LA7,"^",3)
SET LA7CUP1=$PIECE(LA7,"^",5)
+16 if $GET(LRTRAY1)
SET LA7TRAY=LRTRAY1
+17 if $GET(LRCUP1)
SET LA7CUP=LRCUP1
+18 ;
+19 ; Process each tray on load list
+20 SET LA76821=LA7TRAY-1
+21 FOR
SET LA76821=$ORDER(^LRO(68.2,LRLL,1,LA76821))
if 'LA76821!(LA76821>LA7TRAY1)
QUIT
Begin DoDot:1
+22 IF '$DATA(ZTQUEUED)
Begin DoDot:2
+23 WRITE !!,"Building download record for:"
+24 IF LRTYPE
WRITE " Tray: ",LA76821,!,"Cup: "
+25 IF '$TEST
WRITE !,"Seq: "
End DoDot:2
+26 DO CUP
End DoDot:1
+27 DO EXIT
+28 QUIT
+29 ;
+30 ;
CUP ; Process each cup on load list
+1 NEW LA761,LA76822,LA7QUIT,X
+2 ;
+3 SET LA76822=LA7CUP-1
SET LA7QUIT=0
+4 FOR
SET LA76822=$ORDER(^LRO(68.2,LRLL,1,LA76821,1,LA76822))
if 'LA76822
QUIT
Begin DoDot:1
+5 IF LA76821=LA7TRAY1
IF LA76822>LA7CUP1
SET LA7QUIT=1
QUIT
+6 ; Kill array of tests for this accession
+7 KILL LA76249,LA7ACC
+8 SET LA7ACC=^LRO(68.2,LRLL,1,LA76821,1,LA76822,0)
+9 ; Not requested loadlist profile.
+10 IF 'LRPROF
IF ($PIECE(LRPROF,"^",2)'=$PIECE(LA7ACC,"^",4))
QUIT
+11 ;
+12 SET LRAA=+LA7ACC
SET LRAD=$PIECE(LA7ACC,"^",2)
SET LRAN=$PIECE(LA7ACC,"^",3)
+13 SET LA768=LRAA
SET LA76801=LRAD
SET LA76802=LRAN
+14 SET LA7ACC0=$GET(^LRO(68,LRAA,1,LRAD,1,LRAN,0),0)
+15 ;
+16 SET LA761=0
+17 SET X=$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN,5,0))
+18 IF X>0
SET LA761=+$PIECE($GET(^LRO(68,LRAA,1,LRAD,1,LRAN,5,X,0)),"^")
+19 ;
+20 ; Accession has been removed, skip.
+21 IF 'LA7ACC0
Begin DoDot:2
+22 DO CREATE^LA7LOG(24)
End DoDot:2
QUIT
+23 ;
+24 DO TEST
+25 SET LA7INST=LRINST
DO CHKTEST^LA7ADL
+26 NEW LA7QUIT
+27 IF $ORDER(LA7ACC(0))
DO BUILD^LA7UIO1
End DoDot:1
if LA7QUIT
QUIT
+28 QUIT
+29 ;
+30 ;
TEST ;
+1 NEW LA7TST
+2 ;
+3 KILL LA7TREE
+4 ;
+5 SET LA7TST=0
+6 FOR
SET LA7TST=$ORDER(^LRO(68.2,LRLL,1,LA76821,1,LA76822,1,LA7TST))
if 'LA7TST
QUIT
Begin DoDot:1
+7 NEW LA7X,LA7PCNT
+8 SET LA7X=$GET(^LRO(68.2,LRLL,1,LA76821,1,LA76822,1,LA7TST,0))
+9 SET LA7PCNT=0
+10 DO UNWIND^LA7ADL1(+LA7X,$PIECE(LA7X,"^",2),0)
End DoDot:1
+11 QUIT
+12 ;
+13 ;
ADL ; Process/build messages for automatic download, no loadlist.
+1 ; Called from above by LA7ADL.
+2 ;
+3 SET LRLL=0
SET LRAUTO=LA7AUTO(LA7INST)
+4 ; Set tray/cup to null.
+5 SET (LA76821,LA76822)=""
+6 ;
+7 SET LA768=LRAA
SET LA76801=LRAD
SET LA76802=LRAN
+8 ; Zeroth node of accession.
+9 ; Log error if accession has been removed, skip
+10 SET LA7ACC0=$GET(^LRO(68,LA768,1,LA76801,1,LA76802,0),0)
+11 IF 'LA7ACC0
Begin DoDot:1
+12 DO CREATE^LA7LOG(24)
End DoDot:1
QUIT
+13 ;
+14 DO BUILD^LA7UIO1
+15 DO EXIT
+16 KILL LRAUTO,LRINST,LRLL
+17 QUIT
+18 ;
EXIT ;
+1 DO KVAR^LRX
+2 KILL LA7,LA71,LA76249,LA768,LA76801,LA76802,LA76821,LA76822,LA7ACC,LA7ACC0
+3 KILL LA7CNT,LA7CODE,LA7DATA,LA7DTIM,LA7MSH,LA7NVAF,LA7OBR,LA7ORC,LA7PID,LA7PIDSN,LA7PV1,LA7TMP,LRINFW
+4 ;
+5 QUIT
