- LA7DVM ;SFCIOFO/MJM/DALOI/PWC - EXTRACTION ROUTINE FOR VERIFIED "MI" LAB RESULTS TO CAREVUE&LIFELOG;01/14/2000
- ;;5.2;AUTOMATED LAB INSTRUMENTS;**53,58,62**;Sep 27, 1994
- ;
- ; Reference to ^DPT( supported by DBIA #10035
- ; Reference to ^%DTC supported by DBIA #10000
- ; Reference to ^DIC supported by DBIA #10006
- ; Reference to INIT^HLFNC2 supported by DBIA #2161
- ; Reference to GENERATE^HLMA supported by DBIA #2164
- ; Reference to DEM^VADPT supported by DBIA #10061
- ; Reference to $$EN^VAFHLPID supported by DBIA #263
- ; Reference to $$FMTHL7^XLFDT supported by DBIA #10103
- ; Reference to ^XMD supported by DBIA #10070
- ;
- EN ;ENTRY POINT FROM VERIFICATION PROCESS
- N I
- S DFN=$P(^LR(LRDFN,0),"^",3)
- S GMTS1=9999999-LRIDT,GMTS2=9999999-LRIDT,VFLAG=1 D DEM^VADPT
- D INIT,RR^LR7OR1(DFN,,GMTS1,GMTS2,"MI"),HL7
- K ^TMP("LRRR",$J),DFN,EXPAND,NXREC,MAX,SEX
- 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("LRRR",$J,DFN,"MI",LRIDT,"N",LA7DVTXT)) Q:LA7DVTXT="" D
- . S HLA("HLS",COUNT)="NTE"_HLFS_HLFS_"L"_HLFS_^TMP("LRRR",$J,DFN,"MI",LRIDT,"N",LA7DVTXT)
- . S COUNT=COUNT+1
- ; Start the OBX segment
- S (OBX,LA7DVSCR)=""
- F S OBX=$O(^TMP("LRRR",$J,DFN,"MI",LRIDT,OBX)) Q:+OBX=0 D
- . S LA7DVOBX=^TMP("LRRR",$J,DFN,"MI",LRIDT,OBX)
- . S LINE1="OBX"_HLFS_HLFS_"TX"_HLFS_"TX"_HLFS_HLFS_$P(LA7DVOBX,"^",2)_HLFS_HLFS
- . S HLA("HLS",COUNT)=LINE1_HLFS_HLFS_HLFS_HLFS
- . S COUNT=COUNT+1
- . K LINE1
- ; Start the OBR segment
- S LA7DVTMP=0,LA7DVTMP=$O(^LR(LRDFN,"MI",LA7DVTMP)) ; Get the first entry of this collection
- S SITE=$P(^LR(LRDFN,"MI",LA7DVTMP,0),"^",5),LA7DVSCR=$P(^LAB(61,SITE,0),"^",1)
- ; change all $$HLDATE^HLFNC calls to $$FMTHL7^XLFDT pwc-10/6/2000
- S LA7DVCOL=$$FMTHL7^XLFDT($P(^LR(LRDFN,"MI",LA7DVTMP,0),"^")) ; Get theCollection date/time
- S LA7DVRCV=$$FMTHL7^XLFDT($P(^LR(LRDFN,"MI",LA7DVTMP,0),"^",10)) ; Get the Specimen Received Date/time
- S LA7DVRCP=$$FMTHL7^XLFDT($P(^LR(LRDFN,"MI",LA7DVTMP,0),"^",3)) ; Get the Report Complete Date/time
- S LA7DVACC=$P(^LR(LRDFN,"MI",LA7DVTMP,0),"^",6) ; Get the Accession #
- S HLA("HLS",HOLD)="OBR"_HLFS_HLFS_HLFS_LA7DVACC_HLFS_"MI"
- S $P(HLA("HLS",HOLD),HLFS,8)=LA7DVCOL
- S $P(HLA("HLS",HOLD),HLFS,15,16)=LA7DVRCV_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,HLFS,HLP,HLRESLT
- K LA7DVRCV,LRSPEC,S,SITE,SPEC,TEXT,VADM,VAIN,VFLAG,XMDT
- K XMDUZ,XMSUB,XMTEXT,XMY,Z
- 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[HLA7DVM 4061 printed Mar 13, 2025@20:43:45 Page 2
- LA7DVM ;SFCIOFO/MJM/DALOI/PWC - EXTRACTION ROUTINE FOR VERIFIED "MI" LAB RESULTS TO CAREVUE&LIFELOG;01/14/2000
- +1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**53,58,62**;Sep 27, 1994
- +2 ;
- +3 ; Reference to ^DPT( supported by DBIA #10035
- +4 ; Reference to ^%DTC supported by DBIA #10000
- +5 ; Reference to ^DIC supported by DBIA #10006
- +6 ; Reference to INIT^HLFNC2 supported by DBIA #2161
- +7 ; Reference to GENERATE^HLMA supported by DBIA #2164
- +8 ; Reference to DEM^VADPT supported by DBIA #10061
- +9 ; Reference to $$EN^VAFHLPID supported by DBIA #263
- +10 ; Reference to $$FMTHL7^XLFDT supported by DBIA #10103
- +11 ; Reference to ^XMD supported by DBIA #10070
- +12 ;
- EN ;ENTRY POINT FROM VERIFICATION PROCESS
- +1 NEW I
- +2 SET DFN=$PIECE(^LR(LRDFN,0),"^",3)
- +3 SET GMTS1=9999999-LRIDT
- SET GMTS2=9999999-LRIDT
- SET VFLAG=1
- DO DEM^VADPT
- +4 DO INIT
- DO RR^LR7OR1(DFN,,GMTS1,GMTS2,"MI")
- DO HL7
- +5 KILL ^TMP("LRRR",$JOB),DFN,EXPAND,NXREC,MAX,SEX
- +6 QUIT
- +7 ;
- 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("LRRR",$JOB,DFN,"MI",LRIDT,"N",LA7DVTXT))
- if LA7DVTXT=""
- QUIT
- Begin DoDot:1
- +16 SET HLA("HLS",COUNT)="NTE"_HLFS_HLFS_"L"_HLFS_^TMP("LRRR",$JOB,DFN,"MI",LRIDT,"N",LA7DVTXT)
- +17 SET COUNT=COUNT+1
- End DoDot:1
- +18 ; Start the OBX segment
- +19 SET (OBX,LA7DVSCR)=""
- +20 FOR
- SET OBX=$ORDER(^TMP("LRRR",$JOB,DFN,"MI",LRIDT,OBX))
- if +OBX=0
- QUIT
- Begin DoDot:1
- +21 SET LA7DVOBX=^TMP("LRRR",$JOB,DFN,"MI",LRIDT,OBX)
- +22 SET LINE1="OBX"_HLFS_HLFS_"TX"_HLFS_"TX"_HLFS_HLFS_$PIECE(LA7DVOBX,"^",2)_HLFS_HLFS
- +23 SET HLA("HLS",COUNT)=LINE1_HLFS_HLFS_HLFS_HLFS
- +24 SET COUNT=COUNT+1
- +25 KILL LINE1
- End DoDot:1
- +26 ; Start the OBR segment
- +27 ; Get the first entry of this collection
- SET LA7DVTMP=0
- SET LA7DVTMP=$ORDER(^LR(LRDFN,"MI",LA7DVTMP))
- +28 SET SITE=$PIECE(^LR(LRDFN,"MI",LA7DVTMP,0),"^",5)
- SET LA7DVSCR=$PIECE(^LAB(61,SITE,0),"^",1)
- +29 ; change all $$HLDATE^HLFNC calls to $$FMTHL7^XLFDT pwc-10/6/2000
- +30 ; Get theCollection date/time
- SET LA7DVCOL=$$FMTHL7^XLFDT($PIECE(^LR(LRDFN,"MI",LA7DVTMP,0),"^"))
- +31 ; Get the Specimen Received Date/time
- SET LA7DVRCV=$$FMTHL7^XLFDT($PIECE(^LR(LRDFN,"MI",LA7DVTMP,0),"^",10))
- +32 ; Get the Report Complete Date/time
- SET LA7DVRCP=$$FMTHL7^XLFDT($PIECE(^LR(LRDFN,"MI",LA7DVTMP,0),"^",3))
- +33 ; Get the Accession #
- SET LA7DVACC=$PIECE(^LR(LRDFN,"MI",LA7DVTMP,0),"^",6)
- +34 SET HLA("HLS",HOLD)="OBR"_HLFS_HLFS_HLFS_LA7DVACC_HLFS_"MI"
- +35 SET $PIECE(HLA("HLS",HOLD),HLFS,8)=LA7DVCOL
- +36 SET $PIECE(HLA("HLS",HOLD),HLFS,15,16)=LA7DVRCV_HLFS_LA7DVSCR
- +37 SET $PIECE(HLA("HLS",HOLD),HLFS,23,29)=LA7DVRCP_S_S_"LAB"_S_S_S_S_LA7DVL
- +38 SET HLP("NAMESPACE")="LA"
- +39 DO GENERATE^HLMA(LA7DVEID,LA7DVTYP,LA7DVFMT,.HLRESLT,"",.HLP)
- +40 IF $PIECE(HLRESLT,"^",2)
- DO ERROR
- +41 KILL LA7DVRCP,LA7DVSCR,HOLD,LA7DVCOL,LA7DVACC,LA7DVTMP,LA7DVOBX,COUNT
- +42 KILL LA7DVTXT,LA7DVFMT,LA7DVEID,LA7DVTYP,OBX,GMTS1,GMTS2,HLFS,HLP,HLRESLT
- +43 KILL LA7DVRCV,LRSPEC,S,SITE,SPEC,TEXT,VADM,VAIN,VFLAG,XMDT
- +44 KILL XMDUZ,XMSUB,XMTEXT,XMY,Z
- +45 QUIT
- 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