LA7DVC ;SFCIOFO/MJM/DALOI/PWC - EXTRACTION ROUTINE FOR VERIFIED "CH" LAB RESULTS TO CAREVUE&LIFELOG ;01/14/2000
;;5.2;AUTOMATED LAB INSTRUMENTS;**53,62**;Sep 27, 1994
;
; Reference to ^DPT( supported by DBIA #10035
;
EN ;ENTRY POINT FROM VERIFICATION PROCESS
S DFN=$P(^LR(LRDFN,0),"^",3)
S GMTS1=LRIDT-.00001,GMTS2=LRIDT,VFLAG=1 D DEM^VADPT
D INIT,^LA7DVEXT,HL7
K ^TMP("LRC",$J),LA7DVL,MAX,NXREC,EXPAND,SEX,DFN
Q
;
INIT ;Set up needed variables
S NXREC=0,MAX=75,EXPAND=1,SEX=$P(VADM(5),"^",1)
Q
;
HL7 ; Build the HL7 message and send to the Ward.
K HL,HLA,HLP,HLRESLT ; Clean the enviroment
S DIC="^ORD(101,",DIC(0)="MNOZ",X="LA7D CARELIFE SERVER" D ^DIC
I Y=-1 S TEXT="Unable to send out test result to CAREVUE, Protocol Server is not setup" K Y,DIC D ERROR Q
S LA7DVEID=+Y ; Server Protocol IEN
K Y,DIC
D INIT^HLFNC2(LA7DVEID,.HL)
I $G(HL) S TEXT="Unable to send out test result to CAREVUE, Protocol Server is downed" D ERROR Q
N COUNT
S LA7DVTYP="LM",LA7DVFMT=1
S HLFS=$E(HL("FS")),Z=$E(HL("ECH"),1),COUNT=1,S=HLFS
S HLA("HLS",COUNT)=$$EN^VAFHLPID(DFN,"2,3,5,7,8,19")
S HOLD=COUNT+1 ; Hold the space for OBR segment
S COUNT=COUNT+2,LA7DVTXT=""
; Start the NTE segment
F S LA7DVTXT=$O(^TMP("LRC",$J,LRIDT,"C",LA7DVTXT)) Q:LA7DVTXT="" D
. S HLA("HLS",COUNT)="NTE"_HLFS_HLFS_"L"_HLFS_$TR(^TMP("LRC",$J,LRIDT,"C",LA7DVTXT),"~")
. S COUNT=COUNT+1
; Start the OBX segment
S (OBX,LA7DVSCR)=""
F S OBX=$O(^TMP("LRC",$J,LRIDT,OBX)) Q:+OBX=0 D
. S LA7DVOBX=^TMP("LRC",$J,LRIDT,OBX)
. S LINE1="OBX"_HLFS_HLFS_HLFS_$P($P(LA7DVOBX,"^",3),";")_Z_$P($P(LA7DVOBX,"^",3),";",2)_HLFS_HLFS_$P(LA7DVOBX,"^",4)_HLFS_$P(LA7DVOBX,"^",6)_HLFS
. S HLA("HLS",COUNT)=LINE1_$P(LA7DVOBX,"^",7)_"-"_$P(LA7DVOBX,"^",8)_HLFS_$P(LA7DVOBX,"^",5)_HLFS_HLFS_HLFS_$S($P(LA7DVOBX,"^",4)="pending":"I",1:"F")
. S COUNT=COUNT+1
. S LA7DVSCR=$P(LA7DVOBX,"^",2)_Z ; Save for Specimen source
. K LINE1
; Start the OBR segment
S LA7DVTMP="",LA7DVTMP=$O(^TMP("LRC",$J,LRIDT,LA7DVTMP)) ; Get the first entry of this collection
S LA7DVCOL=$P(^TMP("LRC",$J,LRIDT,LA7DVTMP),"^",1) ; Get the Collection date/time
S LA7DVRCP=$P(^TMP("LRC",$J,LRIDT,LA7DVTMP),"^",10) ; Get the Report Complete Date/time
S LA7DVACC=$P(^TMP("LRC",$J,LRIDT,LA7DVTMP),"^",9) ; Get the Accession #
S HLA("HLS",HOLD)="OBR"_HLFS_HLFS_HLFS_LA7DVACC_HLFS_"CH"
S $P(HLA("HLS",HOLD),HLFS,8)=LA7DVCOL
S $P(HLA("HLS",HOLD),HLFS,15,16)=LA7DVCOL_HLFS_LA7DVSCR
S $P(HLA("HLS",HOLD),HLFS,23,29)=LA7DVRCP_S_S_"LAB"_S_S_S_S_LA7DVL
S HLP("NAMESPACE")="LA"
D GENERATE^HLMA(LA7DVEID,LA7DVTYP,LA7DVFMT,.HLRESLT,"",.HLP)
I $P(HLRESLT,"^",2) D ERROR
K LA7DVRCP,LA7DVSCR,HOLD,LA7DVCOL,LA7DVACC,LA7DVTMP,LA7DVOBX,COUNT
K LA7DVTXT,LA7DVFMT,LA7DVEID,LA7DVTYP,OBX,GMTS1,GMTS2,S
K HLRESLT,HLFS,HLP,XMSUB,XMTEXT,XMDUZ,XMDT,XMY,VFLAG,VAIN,VADM,TEXT
Q
;
ERROR ; Send out error message when HL7 fail to build the message
D INP^VADPT
S XMSUB="ERROR IN SENDING LAB RESULTS TO "_$P(VAIN(4),"^",2)_" WARD"
D NOW^%DTC S XMDT=X K X
S XMDUZ=.5,XMY("G.CARELIFE RESULT ERROR")=""
S A(1)="There was an error in building an HL7 Lab Result Message for accession"
I LA7DVACC'="" D
. S A(2)=" # "_LA7DVACC_"of patient name: "_$P(^DPT(DFN,0),"^")_" at "_$P(VAIN(4),"^",2)_" Ward."
. S A(3)="The error was "_$P(HLRESLT,"^",3)_"."
E D
. S A(2)="The error was "_TEXT_"."
. S A(3)=""
S A(4)="Please make a note of it and take any actions that necessary"
S XMTEXT="A(" D ^XMD
K A
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA7DVC 3521 printed Sep 23, 2025@19:15:04 Page 2
LA7DVC ;SFCIOFO/MJM/DALOI/PWC - EXTRACTION ROUTINE FOR VERIFIED "CH" LAB RESULTS TO CAREVUE&LIFELOG ;01/14/2000
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**53,62**;Sep 27, 1994
+2 ;
+3 ; Reference to ^DPT( supported by DBIA #10035
+4 ;
EN ;ENTRY POINT FROM VERIFICATION PROCESS
+1 SET DFN=$PIECE(^LR(LRDFN,0),"^",3)
+2 SET GMTS1=LRIDT-.00001
SET GMTS2=LRIDT
SET VFLAG=1
DO DEM^VADPT
+3 DO INIT
DO ^LA7DVEXT
DO HL7
+4 KILL ^TMP("LRC",$JOB),LA7DVL,MAX,NXREC,EXPAND,SEX,DFN
+5 QUIT
+6 ;
INIT ;Set up needed variables
+1 SET NXREC=0
SET MAX=75
SET EXPAND=1
SET SEX=$PIECE(VADM(5),"^",1)
+2 QUIT
+3 ;
HL7 ; Build the HL7 message and send to the Ward.
+1 ; Clean the enviroment
KILL HL,HLA,HLP,HLRESLT
+2 SET DIC="^ORD(101,"
SET DIC(0)="MNOZ"
SET X="LA7D CARELIFE SERVER"
DO ^DIC
+3 IF Y=-1
SET TEXT="Unable to send out test result to CAREVUE, Protocol Server is not setup"
KILL Y,DIC
DO ERROR
QUIT
+4 ; Server Protocol IEN
SET LA7DVEID=+Y
+5 KILL Y,DIC
+6 DO INIT^HLFNC2(LA7DVEID,.HL)
+7 IF $GET(HL)
SET TEXT="Unable to send out test result to CAREVUE, Protocol Server is downed"
DO ERROR
QUIT
+8 NEW COUNT
+9 SET LA7DVTYP="LM"
SET LA7DVFMT=1
+10 SET HLFS=$EXTRACT(HL("FS"))
SET Z=$EXTRACT(HL("ECH"),1)
SET COUNT=1
SET S=HLFS
+11 SET HLA("HLS",COUNT)=$$EN^VAFHLPID(DFN,"2,3,5,7,8,19")
+12 ; Hold the space for OBR segment
SET HOLD=COUNT+1
+13 SET COUNT=COUNT+2
SET LA7DVTXT=""
+14 ; Start the NTE segment
+15 FOR
SET LA7DVTXT=$ORDER(^TMP("LRC",$JOB,LRIDT,"C",LA7DVTXT))
if LA7DVTXT=""
QUIT
Begin DoDot:1
+16 SET HLA("HLS",COUNT)="NTE"_HLFS_HLFS_"L"_HLFS_$TRANSLATE(^TMP("LRC",$JOB,LRIDT,"C",LA7DVTXT),"~")
+17 SET COUNT=COUNT+1
End DoDot:1
+18 ; Start the OBX segment
+19 SET (OBX,LA7DVSCR)=""
+20 FOR
SET OBX=$ORDER(^TMP("LRC",$JOB,LRIDT,OBX))
if +OBX=0
QUIT
Begin DoDot:1
+21 SET LA7DVOBX=^TMP("LRC",$JOB,LRIDT,OBX)
+22 SET LINE1="OBX"_HLFS_HLFS_HLFS_$PIECE($PIECE(LA7DVOBX,"^",3),";")_Z_$PIECE($PIECE(LA7DVOBX,"^",3),";",2)_HLFS_HLFS_$PIECE(LA7DVOBX,"^",4)_HLFS_$PIECE(LA7DVOBX,"^",6)_HLFS
+23 SET HLA("HLS",COUNT)=LINE1_$PIECE(LA7DVOBX,"^",7)_"-"_$PIECE(LA7DVOBX,"^",8)_HLFS_$PIECE(LA7DVOBX,"^",5)_HLFS_HLFS_HLFS_$SELECT($PIECE(LA7DVOBX,"^",4)="pending":"I",1:"F")
+24 SET COUNT=COUNT+1
+25 ; Save for Specimen source
SET LA7DVSCR=$PIECE(LA7DVOBX,"^",2)_Z
+26 KILL LINE1
End DoDot:1
+27 ; Start the OBR segment
+28 ; Get the first entry of this collection
SET LA7DVTMP=""
SET LA7DVTMP=$ORDER(^TMP("LRC",$JOB,LRIDT,LA7DVTMP))
+29 ; Get the Collection date/time
SET LA7DVCOL=$PIECE(^TMP("LRC",$JOB,LRIDT,LA7DVTMP),"^",1)
+30 ; Get the Report Complete Date/time
SET LA7DVRCP=$PIECE(^TMP("LRC",$JOB,LRIDT,LA7DVTMP),"^",10)
+31 ; Get the Accession #
SET LA7DVACC=$PIECE(^TMP("LRC",$JOB,LRIDT,LA7DVTMP),"^",9)
+32 SET HLA("HLS",HOLD)="OBR"_HLFS_HLFS_HLFS_LA7DVACC_HLFS_"CH"
+33 SET $PIECE(HLA("HLS",HOLD),HLFS,8)=LA7DVCOL
+34 SET $PIECE(HLA("HLS",HOLD),HLFS,15,16)=LA7DVCOL_HLFS_LA7DVSCR
+35 SET $PIECE(HLA("HLS",HOLD),HLFS,23,29)=LA7DVRCP_S_S_"LAB"_S_S_S_S_LA7DVL
+36 SET HLP("NAMESPACE")="LA"
+37 DO GENERATE^HLMA(LA7DVEID,LA7DVTYP,LA7DVFMT,.HLRESLT,"",.HLP)
+38 IF $PIECE(HLRESLT,"^",2)
DO ERROR
+39 KILL LA7DVRCP,LA7DVSCR,HOLD,LA7DVCOL,LA7DVACC,LA7DVTMP,LA7DVOBX,COUNT
+40 KILL LA7DVTXT,LA7DVFMT,LA7DVEID,LA7DVTYP,OBX,GMTS1,GMTS2,S
+41 KILL HLRESLT,HLFS,HLP,XMSUB,XMTEXT,XMDUZ,XMDT,XMY,VFLAG,VAIN,VADM,TEXT
+42 QUIT
+43 ;
ERROR ; Send out error message when HL7 fail to build the message
+1 DO INP^VADPT
+2 SET XMSUB="ERROR IN SENDING LAB RESULTS TO "_$PIECE(VAIN(4),"^",2)_" WARD"
+3 DO NOW^%DTC
SET XMDT=X
KILL X
+4 SET XMDUZ=.5
SET XMY("G.CARELIFE RESULT ERROR")=""
+5 SET A(1)="There was an error in building an HL7 Lab Result Message for accession"
+6 IF LA7DVACC'=""
Begin DoDot:1
+7 SET A(2)=" # "_LA7DVACC_"of patient name: "_$PIECE(^DPT(DFN,0),"^")_" at "_$PIECE(VAIN(4),"^",2)_" Ward."
+8 SET A(3)="The error was "_$PIECE(HLRESLT,"^",3)_"."
End DoDot:1
+9 IF '$TEST
Begin DoDot:1
+10 SET A(2)="The error was "_TEXT_"."
+11 SET A(3)=""
End DoDot:1
+12 SET A(4)="Please make a note of it and take any actions that necessary"
+13 SET XMTEXT="A("
DO ^XMD
+14 KILL A
+15 QUIT
