- 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 Feb 18, 2025@23:06:16 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