LA7SMB1 ;DALOI/JMC - Shipping Manifest Build ;03/07/12 08:31
;;5.2;AUTOMATED LAB INSTRUMENTS;**74**;Sep 27, 1994;Build 229
;
ADD ; Add test to shipping manifest
; Called from LA7SMB, LA7SM
; Lock on ^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,LA760) should be set before entering here.
;
N FDA,IENS,LA7628,LA768,LA7DATA,X,Y
;
S LRDFN=+$G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,0))
S LA7UID=$P($G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,.3)),"^")
I LA7UID="" S LA7UID=$$LRUID^LRX(LA7AA,LA7AD,LA7AN)
S LA7SMCNT=$G(LA7SMCNT)+1
S ^TMP("LA7SMADD",$J,LA7SMCNT)=LRDFN_"^"_LA760_"^"_LA76805_"^"_LA76205_"^"_LA7UID
S LA7628(1)=+LA7SM,IENS="+2,"_LA7628(1)_","
S FDA(2,62.801,IENS,.01)=LRDFN
S FDA(2,62.801,IENS,.02)=LA760
I LA76805 S FDA(2,62.801,IENS,.03)=LA76805
S FDA(2,62.801,IENS,.04)=LA76205
S FDA(2,62.801,IENS,.05)=LA7UID
S FDA(2,62.801,IENS,.08)=1
I $D(LA7X(0)) D
. I $P(LA7X(0),"^",5) S FDA(2,62.801,IENS,.06)=$P(LA7X(0),"^",5)
. I $P(LA7X(0),"^",6) S FDA(2,62.801,IENS,.07)=$P(LA7X(0),"^",6)
. I $P(LA7X(0),"^",7) S FDA(2,62.801,IENS,.09)=$P(LA7X(0),"^",7)
I $D(LA7X(1)) D
. I $P(LA7X(1),"^",1)]"" S FDA(2,62.801,IENS,1.1)=$P(LA7X(1),"^",1)
. I $P(LA7X(1),"^",2)]"" S FDA(2,62.801,IENS,1.13)=$P(LA7X(1),"^",2)
. I $P(LA7X(1),"^",5)]"" S FDA(2,62.801,IENS,1.14)=$P(LA7X(1),"^",5)
. I $P(LA7X(1),"^",3)]"" S FDA(2,62.801,IENS,1.2)=$P(LA7X(1),"^",3)
. I $P(LA7X(1),"^",4)]"" S FDA(2,62.801,IENS,1.23)=$P(LA7X(1),"^",4)
. I $P(LA7X(1),"^",6)]"" S FDA(2,62.801,IENS,1.24)=$P(LA7X(1),"^",6)
I $D(LA7X(2)) D
. I $P(LA7X(2),"^",1)]"" S FDA(2,62.801,IENS,2.1)=$P(LA7X(2),"^",1)
. I $P(LA7X(2),"^",2)]"" S FDA(2,62.801,IENS,2.13)=$P(LA7X(2),"^",2)
. I $P(LA7X(2),"^",7)]"" S FDA(2,62.801,IENS,2.14)=$P(LA7X(2),"^",7)
. I $P(LA7X(2),"^",3)]"" S FDA(2,62.801,IENS,2.2)=$P(LA7X(2),"^",3)
. I $P(LA7X(2),"^",4)]"" S FDA(2,62.801,IENS,2.23)=$P(LA7X(2),"^",4)
. I $P(LA7X(2),"^",8)]"" S FDA(2,62.801,IENS,2.24)=$P(LA7X(2),"^",8)
. I $P(LA7X(2),"^",5)]"" S FDA(2,62.801,IENS,2.3)=$P(LA7X(2),"^",5)
. I $P(LA7X(2),"^",6)]"" S FDA(2,62.801,IENS,2.33)=$P(LA7X(2),"^",6)
. I $P(LA7X(2),"^",9)]"" S FDA(2,62.801,IENS,2.34)=$P(LA7X(2),"^",9)
I $D(LA7X(5)) D
. F I=1:1:9 I $P(LA7X(5),"^",I)]"" S FDA(2,62.801,IENS,"5."_I)=$P(LA7X(5),"^",I)
;
; Check for Non-VA SNOMED mapping on interface for specimen and/or collection sample.
I $P(LA7SCFG(0),"^",7),$D(^LAHM(62.48,$P(LA7SCFG(0),"^",7),"SCT")) D
. I LA76805 D
. . S X=$O(^LAHM(62.48,$P(LA7SCFG(0),"^",7),"SCT","AC",LA76805_";LAB(61,",""))
. . I X'="" S FDA(2,62.801,IENS,20.1)=X
. I LA762 D
. . S X=$O(^LAHM(62.48,$P(LA7SCFG(0),"^",7),"SCT","AC",LA762_";LAB(62,",""))
. . I X'="" S FDA(2,62.801,IENS,20.2)=X
;
D UPDATE^DIE("","FDA(2)","LA7628","LA7DIE(2)")
;
; Update event file
S LA7DATA="SM50^"_$$NOW^XLFDT_"^"_LA760_"^"_$P(LA7SM,"^",2)
D SEUP^LA7SMU(LA7UID,2,LA7DATA)
;
; Update accession
D ACCSUP^LA7SMU(LA7UID,LA760,+LA7SM)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA7SMB1 2953 printed Dec 13, 2024@01:39:30 Page 2
LA7SMB1 ;DALOI/JMC - Shipping Manifest Build ;03/07/12 08:31
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**74**;Sep 27, 1994;Build 229
+2 ;
ADD ; Add test to shipping manifest
+1 ; Called from LA7SMB, LA7SM
+2 ; Lock on ^LRO(68,LA7AA,1,LA7AD,1,LA7AN,4,LA760) should be set before entering here.
+3 ;
+4 NEW FDA,IENS,LA7628,LA768,LA7DATA,X,Y
+5 ;
+6 SET LRDFN=+$GET(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,0))
+7 SET LA7UID=$PIECE($GET(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,.3)),"^")
+8 IF LA7UID=""
SET LA7UID=$$LRUID^LRX(LA7AA,LA7AD,LA7AN)
+9 SET LA7SMCNT=$GET(LA7SMCNT)+1
+10 SET ^TMP("LA7SMADD",$JOB,LA7SMCNT)=LRDFN_"^"_LA760_"^"_LA76805_"^"_LA76205_"^"_LA7UID
+11 SET LA7628(1)=+LA7SM
SET IENS="+2,"_LA7628(1)_","
+12 SET FDA(2,62.801,IENS,.01)=LRDFN
+13 SET FDA(2,62.801,IENS,.02)=LA760
+14 IF LA76805
SET FDA(2,62.801,IENS,.03)=LA76805
+15 SET FDA(2,62.801,IENS,.04)=LA76205
+16 SET FDA(2,62.801,IENS,.05)=LA7UID
+17 SET FDA(2,62.801,IENS,.08)=1
+18 IF $DATA(LA7X(0))
Begin DoDot:1
+19 IF $PIECE(LA7X(0),"^",5)
SET FDA(2,62.801,IENS,.06)=$PIECE(LA7X(0),"^",5)
+20 IF $PIECE(LA7X(0),"^",6)
SET FDA(2,62.801,IENS,.07)=$PIECE(LA7X(0),"^",6)
+21 IF $PIECE(LA7X(0),"^",7)
SET FDA(2,62.801,IENS,.09)=$PIECE(LA7X(0),"^",7)
End DoDot:1
+22 IF $DATA(LA7X(1))
Begin DoDot:1
+23 IF $PIECE(LA7X(1),"^",1)]""
SET FDA(2,62.801,IENS,1.1)=$PIECE(LA7X(1),"^",1)
+24 IF $PIECE(LA7X(1),"^",2)]""
SET FDA(2,62.801,IENS,1.13)=$PIECE(LA7X(1),"^",2)
+25 IF $PIECE(LA7X(1),"^",5)]""
SET FDA(2,62.801,IENS,1.14)=$PIECE(LA7X(1),"^",5)
+26 IF $PIECE(LA7X(1),"^",3)]""
SET FDA(2,62.801,IENS,1.2)=$PIECE(LA7X(1),"^",3)
+27 IF $PIECE(LA7X(1),"^",4)]""
SET FDA(2,62.801,IENS,1.23)=$PIECE(LA7X(1),"^",4)
+28 IF $PIECE(LA7X(1),"^",6)]""
SET FDA(2,62.801,IENS,1.24)=$PIECE(LA7X(1),"^",6)
End DoDot:1
+29 IF $DATA(LA7X(2))
Begin DoDot:1
+30 IF $PIECE(LA7X(2),"^",1)]""
SET FDA(2,62.801,IENS,2.1)=$PIECE(LA7X(2),"^",1)
+31 IF $PIECE(LA7X(2),"^",2)]""
SET FDA(2,62.801,IENS,2.13)=$PIECE(LA7X(2),"^",2)
+32 IF $PIECE(LA7X(2),"^",7)]""
SET FDA(2,62.801,IENS,2.14)=$PIECE(LA7X(2),"^",7)
+33 IF $PIECE(LA7X(2),"^",3)]""
SET FDA(2,62.801,IENS,2.2)=$PIECE(LA7X(2),"^",3)
+34 IF $PIECE(LA7X(2),"^",4)]""
SET FDA(2,62.801,IENS,2.23)=$PIECE(LA7X(2),"^",4)
+35 IF $PIECE(LA7X(2),"^",8)]""
SET FDA(2,62.801,IENS,2.24)=$PIECE(LA7X(2),"^",8)
+36 IF $PIECE(LA7X(2),"^",5)]""
SET FDA(2,62.801,IENS,2.3)=$PIECE(LA7X(2),"^",5)
+37 IF $PIECE(LA7X(2),"^",6)]""
SET FDA(2,62.801,IENS,2.33)=$PIECE(LA7X(2),"^",6)
+38 IF $PIECE(LA7X(2),"^",9)]""
SET FDA(2,62.801,IENS,2.34)=$PIECE(LA7X(2),"^",9)
End DoDot:1
+39 IF $DATA(LA7X(5))
Begin DoDot:1
+40 FOR I=1:1:9
IF $PIECE(LA7X(5),"^",I)]""
SET FDA(2,62.801,IENS,"5."_I)=$PIECE(LA7X(5),"^",I)
End DoDot:1
+41 ;
+42 ; Check for Non-VA SNOMED mapping on interface for specimen and/or collection sample.
+43 IF $PIECE(LA7SCFG(0),"^",7)
IF $DATA(^LAHM(62.48,$PIECE(LA7SCFG(0),"^",7),"SCT"))
Begin DoDot:1
+44 IF LA76805
Begin DoDot:2
+45 SET X=$ORDER(^LAHM(62.48,$PIECE(LA7SCFG(0),"^",7),"SCT","AC",LA76805_";LAB(61,",""))
+46 IF X'=""
SET FDA(2,62.801,IENS,20.1)=X
End DoDot:2
+47 IF LA762
Begin DoDot:2
+48 SET X=$ORDER(^LAHM(62.48,$PIECE(LA7SCFG(0),"^",7),"SCT","AC",LA762_";LAB(62,",""))
+49 IF X'=""
SET FDA(2,62.801,IENS,20.2)=X
End DoDot:2
End DoDot:1
+50 ;
+51 DO UPDATE^DIE("","FDA(2)","LA7628","LA7DIE(2)")
+52 ;
+53 ; Update event file
+54 SET LA7DATA="SM50^"_$$NOW^XLFDT_"^"_LA760_"^"_$P(LA7SM,"^",2)
+55 DO SEUP^LA7SMU(LA7UID,2,LA7DATA)
+56 ;
+57 ; Update accession
+58 DO ACCSUP^LA7SMU(LA7UID,LA760,+LA7SM)
+59 QUIT
