LRVRMI5 ;DALOI/STAFF - LAB MICRO LEDI INTERFACE ;Jun 26, 2008
;;5.2;LAB SERVICE;**350**;Sep 27, 1994;Build 230
;
SETTMP ; Setup TMP global with accession to resend.
;
N LA763,LA764,LA768,LA7CNT,LA7I,LA7NLT,LA7NLTN,LA7UID,LA7VDB,LA7X,LA7Y,LR60,LR61,X,ZFIL,ZFLD,ZPTR,ZEDTYP
;
S LRSS=$P(^LRO(68,LRAA,0),"^",2)
F LA7I=0,.2,.3,3 S LA768(LA7I)=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,LA7I))
S LA7UID=$P(LA768(.3),"^")
;
; Not a LEDI specimen
;
I '$P($G(LA768(.3)),"^",3) Q
;
; Check file #63 for order codes and results
; If no order NLT code found then use default NLT
; Check if test has been added to order then report results using NLT code of the added test.
;
S LRDFN=$P(LA768(0),"^"),LRODT=$P(LA768(0),"^",4),LRIDT=$P(LA768(3),"^",5)
;
; Check for date report completed.
;
I '$$OK2SEND^LA7SRR D Q
. Q
. N LA7X
. S LA7X="No date report completed - Accession "_$P(LA768(.2),"^")_" ("_LA7UID_") skipped"
. D EN^DDIOL(LA7X,"","!")
;
K ^TMP("LA7S-RTM",$J)
;
I LRSS="MI" D
. S LR60=0
. F S LR60=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LR60)) Q:'LR60 D
. . S LA764=$P($G(^LAB(60,LR60,64)),"^")
. . S LA7NLT=$$GET1^DIQ(64,LA764_",",1)
. . S LRDB=$$GET1^DIQ(64,LA764_",",63)
. . I LA7NLT'="" D
. . . S LA7Y(LA7NLT)=""
. . . I LRDB'="" S LA7Y(LA7NLT,LRDB)=""
;
I LA7UID'="",$D(LA7Y) D
. S LA7CNT=$G(LA7CNT)+1
. S X=$P(LA768(.3),"^",1)_"^"_$P(LA768(.3),"^",2)_"^"_$P(LA768(.3),"^",5)_"^"_$P(LA768(.3),"^",3)_"^"_LRIDT_"^"_LRSS_"^"_LRDFN_"^"_LRODT
. S ^TMP("LA7S-RTM",$J,LA7UID)=X
. S LA7I=""
. F S LA7I=$O(LA7Y(LA7I)) Q:LA7I="" M ^TMP("LA7S-RTM",$J,LA7UID,LA7I)=LA7Y(LA7I)
S LA7CNT=0,LA7UID=""
F S LA7UID=$O(^TMP("LA7S-RTM",$J,LA7UID)) Q:LA7UID="" D
. K LA7X
. S LA7X=^TMP("LA7S-RTM",$J,LA7UID)
. S LA7NLT="",LA7CNT=LA7CNT+1
. F S LA7NLT=$O(^TMP("LA7S-RTM",$J,LA7UID,LA7NLT)) Q:LA7NLT="" D
. . S LA764=$$FIND1^DIC(64,"","MX",LA7NLT,"C")
. . I 'LA764 Q
. . S LA7NLTN=$$GET1^DIQ(64,LA764_",",.01)
. . K LA7Y
. . M LA7Y=^TMP("LA7S-RTM",$J,LA7UID,LA7NLT)
. . ;
. . ; Now send the message to LEDI for transmission to remote site
. . ;
. . S ZPTR=0
. . ;
. . ; this is the TYPE: 1=NORMAL, 2=SUPPLEMENTAL, 3=CORRECTED
. . S ZEDTYP=""
. . S ZEDTYP=$O(^LR(LRDFN,"MI",LRIDT,32,ZEDTYP))
. . S:$G(ZEDTYP) ZEDTYP=$P($G(^LR(LRDFN,"MI",LRIDT,32,ZEDTYP)),"^",4)
. . ;
. . I ZEDTYP=3 S LA7VDB(LA7NLT,ZPTR)="C"
. . I 'ZEDTYP S LA7VDB(LA7NLT,ZPTR)=""
. . D SET^LA7VMSG($P(LA7X,"^"),$P(LA7X,"^",2),$P(LA7X,"^",3),$P(LA7X,"^",4),LA7NLTN,LA7NLT,$P(LA7X,"^",5),$P(LA7X,"^",6),$P(LA7X,"^",7),$P(LA7X,"^",8),.LA7VDB,"ORU")
;
K ^TMP("LA7S-RTM",$J)
;
Q
;
;
;============================================================
;
; DELETE EXTANT COMMENTS FROM SUBFILE
;
;============================================================
;
CLRCMNT(LRNDE,LRFIL) ;
N LRFDA,LRIED,LRMSG
S LRIEN=LRNO_","_LRIDT_","_LRDFN_","
S LRFDA(LRNODE,LRFILE,LRIEN,.01)="@"
D FILE^DIE("","LRFDA(LRNODE)","LRMSG")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRVRMI5 3025 printed Oct 16, 2024@18:23:39 Page 2
LRVRMI5 ;DALOI/STAFF - LAB MICRO LEDI INTERFACE ;Jun 26, 2008
+1 ;;5.2;LAB SERVICE;**350**;Sep 27, 1994;Build 230
+2 ;
SETTMP ; Setup TMP global with accession to resend.
+1 ;
+2 NEW LA763,LA764,LA768,LA7CNT,LA7I,LA7NLT,LA7NLTN,LA7UID,LA7VDB,LA7X,LA7Y,LR60,LR61,X,ZFIL,ZFLD,ZPTR,ZEDTYP
+3 ;
+4 SET LRSS=$PIECE(^LRO(68,LRAA,0),"^",2)
+5 FOR LA7I=0,.2,.3,3
SET LA768(LA7I)=$GET(^LRO(68,LRAA,1,LRAD,1,LRAN,LA7I))
+6 SET LA7UID=$PIECE(LA768(.3),"^")
+7 ;
+8 ; Not a LEDI specimen
+9 ;
+10 IF '$PIECE($GET(LA768(.3)),"^",3)
QUIT
+11 ;
+12 ; Check file #63 for order codes and results
+13 ; If no order NLT code found then use default NLT
+14 ; Check if test has been added to order then report results using NLT code of the added test.
+15 ;
+16 SET LRDFN=$PIECE(LA768(0),"^")
SET LRODT=$PIECE(LA768(0),"^",4)
SET LRIDT=$PIECE(LA768(3),"^",5)
+17 ;
+18 ; Check for date report completed.
+19 ;
+20 IF '$$OK2SEND^LA7SRR
Begin DoDot:1
+21 QUIT
+22 NEW LA7X
+23 SET LA7X="No date report completed - Accession "_$PIECE(LA768(.2),"^")_" ("_LA7UID_") skipped"
+24 DO EN^DDIOL(LA7X,"","!")
End DoDot:1
QUIT
+25 ;
+26 KILL ^TMP("LA7S-RTM",$JOB)
+27 ;
+28 IF LRSS="MI"
Begin DoDot:1
+29 SET LR60=0
+30 FOR
SET LR60=$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LR60))
if 'LR60
QUIT
Begin DoDot:2
+31 SET LA764=$PIECE($GET(^LAB(60,LR60,64)),"^")
+32 SET LA7NLT=$$GET1^DIQ(64,LA764_",",1)
+33 SET LRDB=$$GET1^DIQ(64,LA764_",",63)
+34 IF LA7NLT'=""
Begin DoDot:3
+35 SET LA7Y(LA7NLT)=""
+36 IF LRDB'=""
SET LA7Y(LA7NLT,LRDB)=""
End DoDot:3
End DoDot:2
End DoDot:1
+37 ;
+38 IF LA7UID'=""
IF $DATA(LA7Y)
Begin DoDot:1
+39 SET LA7CNT=$GET(LA7CNT)+1
+40 SET X=$PIECE(LA768(.3),"^",1)_"^"_$PIECE(LA768(.3),"^",2)_"^"_$PIECE(LA768(.3),"^",5)_"^"_$PIECE(LA768(.3),"^",3)_"^"_LRIDT_"^"_LRSS_"^"_LRDFN_"^"_LRODT
+41 SET ^TMP("LA7S-RTM",$JOB,LA7UID)=X
+42 SET LA7I=""
+43 FOR
SET LA7I=$ORDER(LA7Y(LA7I))
if LA7I=""
QUIT
MERGE ^TMP("LA7S-RTM",$JOB,LA7UID,LA7I)=LA7Y(LA7I)
End DoDot:1
+44 SET LA7CNT=0
SET LA7UID=""
+45 FOR
SET LA7UID=$ORDER(^TMP("LA7S-RTM",$JOB,LA7UID))
if LA7UID=""
QUIT
Begin DoDot:1
+46 KILL LA7X
+47 SET LA7X=^TMP("LA7S-RTM",$JOB,LA7UID)
+48 SET LA7NLT=""
SET LA7CNT=LA7CNT+1
+49 FOR
SET LA7NLT=$ORDER(^TMP("LA7S-RTM",$JOB,LA7UID,LA7NLT))
if LA7NLT=""
QUIT
Begin DoDot:2
+50 SET LA764=$$FIND1^DIC(64,"","MX",LA7NLT,"C")
+51 IF 'LA764
QUIT
+52 SET LA7NLTN=$$GET1^DIQ(64,LA764_",",.01)
+53 KILL LA7Y
+54 MERGE LA7Y=^TMP("LA7S-RTM",$JOB,LA7UID,LA7NLT)
+55 ;
+56 ; Now send the message to LEDI for transmission to remote site
+57 ;
+58 SET ZPTR=0
+59 ;
+60 ; this is the TYPE: 1=NORMAL, 2=SUPPLEMENTAL, 3=CORRECTED
+61 SET ZEDTYP=""
+62 SET ZEDTYP=$ORDER(^LR(LRDFN,"MI",LRIDT,32,ZEDTYP))
+63 if $GET(ZEDTYP)
SET ZEDTYP=$PIECE($GET(^LR(LRDFN,"MI",LRIDT,32,ZEDTYP)),"^",4)
+64 ;
+65 IF ZEDTYP=3
SET LA7VDB(LA7NLT,ZPTR)="C"
+66 IF 'ZEDTYP
SET LA7VDB(LA7NLT,ZPTR)=""
+67 DO SET^LA7VMSG($PIECE(LA7X,"^"),$PIECE(LA7X,"^",2),$PIECE(LA7X,"^",3),$PIECE(LA7X,"^",4),LA7NLTN,LA7NLT,$PIECE(LA7X,"^",5),$PIECE(LA7X,"^",6),$PIECE(LA7X,"^",7),$PIECE(LA7X,"^",8),.LA7VDB,"ORU")
End DoDot:2
End DoDot:1
+68 ;
+69 KILL ^TMP("LA7S-RTM",$JOB)
+70 ;
+71 QUIT
+72 ;
+73 ;
+74 ;============================================================
+75 ;
+76 ; DELETE EXTANT COMMENTS FROM SUBFILE
+77 ;
+78 ;============================================================
+79 ;
CLRCMNT(LRNDE,LRFIL) ;
+1 NEW LRFDA,LRIED,LRMSG
+2 SET LRIEN=LRNO_","_LRIDT_","_LRDFN_","
+3 SET LRFDA(LRNODE,LRFILE,LRIEN,.01)="@"
+4 DO FILE^DIE("","LRFDA(LRNODE)","LRMSG")
+5 QUIT
