source: FOIAVistA/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7DVC.m@ 1806

Last change on this file since 1806 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 3.4 KB
Line 
1LA7DVC ;SFCIOFO/MJM/DALOI/PWC - EXTRACTION ROUTINE FOR VERIFIED "CH" LAB RESULTS TO CAREVUE&LIFELOG ;01/14/2000
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**53,62**;Sep 27, 1994
3 ;
4 ; Reference to ^DPT( supported by DBIA #10035
5 ;
6EN ;ENTRY POINT FROM VERIFICATION PROCESS
7 S DFN=$P(^LR(LRDFN,0),"^",3)
8 S GMTS1=LRIDT-.00001,GMTS2=LRIDT,VFLAG=1 D DEM^VADPT
9 D INIT,^LA7DVEXT,HL7
10 K ^TMP("LRC",$J),LA7DVL,MAX,NXREC,EXPAND,SEX,DFN
11 Q
12 ;
13INIT ;Set up needed variables
14 S NXREC=0,MAX=75,EXPAND=1,SEX=$P(VADM(5),"^",1)
15 Q
16 ;
17HL7 ; Build the HL7 message and send to the Ward.
18 K HL,HLA,HLP,HLRESLT ; Clean the enviroment
19 S DIC="^ORD(101,",DIC(0)="MNOZ",X="LA7D CARELIFE SERVER" D ^DIC
20 I Y=-1 S TEXT="Unable to send out test result to CAREVUE, Protocol Server is not setup" K Y,DIC D ERROR Q
21 S LA7DVEID=+Y ; Server Protocol IEN
22 K Y,DIC
23 D INIT^HLFNC2(LA7DVEID,.HL)
24 I $G(HL) S TEXT="Unable to send out test result to CAREVUE, Protocol Server is downed" D ERROR Q
25 N COUNT
26 S LA7DVTYP="LM",LA7DVFMT=1
27 S HLFS=$E(HL("FS")),Z=$E(HL("ECH"),1),COUNT=1,S=HLFS
28 S HLA("HLS",COUNT)=$$EN^VAFHLPID(DFN,"2,3,5,7,8,19")
29 S HOLD=COUNT+1 ; Hold the space for OBR segment
30 S COUNT=COUNT+2,LA7DVTXT=""
31 ; Start the NTE segment
32 F S LA7DVTXT=$O(^TMP("LRC",$J,LRIDT,"C",LA7DVTXT)) Q:LA7DVTXT="" D
33 . S HLA("HLS",COUNT)="NTE"_HLFS_HLFS_"L"_HLFS_$TR(^TMP("LRC",$J,LRIDT,"C",LA7DVTXT),"~")
34 . S COUNT=COUNT+1
35 ; Start the OBX segment
36 S (OBX,LA7DVSCR)=""
37 F S OBX=$O(^TMP("LRC",$J,LRIDT,OBX)) Q:+OBX=0 D
38 . S LA7DVOBX=^TMP("LRC",$J,LRIDT,OBX)
39 . 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
40 . 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")
41 . S COUNT=COUNT+1
42 . S LA7DVSCR=$P(LA7DVOBX,"^",2)_Z ; Save for Specimen source
43 . K LINE1
44 ; Start the OBR segment
45 S LA7DVTMP="",LA7DVTMP=$O(^TMP("LRC",$J,LRIDT,LA7DVTMP)) ; Get the first entry of this collection
46 S LA7DVCOL=$P(^TMP("LRC",$J,LRIDT,LA7DVTMP),"^",1) ; Get the Collection date/time
47 S LA7DVRCP=$P(^TMP("LRC",$J,LRIDT,LA7DVTMP),"^",10) ; Get the Report Complete Date/time
48 S LA7DVACC=$P(^TMP("LRC",$J,LRIDT,LA7DVTMP),"^",9) ; Get the Accession #
49 S HLA("HLS",HOLD)="OBR"_HLFS_HLFS_HLFS_LA7DVACC_HLFS_"CH"
50 S $P(HLA("HLS",HOLD),HLFS,8)=LA7DVCOL
51 S $P(HLA("HLS",HOLD),HLFS,15,16)=LA7DVCOL_HLFS_LA7DVSCR
52 S $P(HLA("HLS",HOLD),HLFS,23,29)=LA7DVRCP_S_S_"LAB"_S_S_S_S_LA7DVL
53 S HLP("NAMESPACE")="LA"
54 D GENERATE^HLMA(LA7DVEID,LA7DVTYP,LA7DVFMT,.HLRESLT,"",.HLP)
55 I $P(HLRESLT,"^",2) D ERROR
56 K LA7DVRCP,LA7DVSCR,HOLD,LA7DVCOL,LA7DVACC,LA7DVTMP,LA7DVOBX,COUNT
57 K LA7DVTXT,LA7DVFMT,LA7DVEID,LA7DVTYP,OBX,GMTS1,GMTS2,S
58 K HLRESLT,HLFS,HLP,XMSUB,XMTEXT,XMDUZ,XMDT,XMY,VFLAG,VAIN,VADM,TEXT
59 Q
60 ;
61ERROR ; Send out error message when HL7 fail to build the message
62 D INP^VADPT
63 S XMSUB="ERROR IN SENDING LAB RESULTS TO "_$P(VAIN(4),"^",2)_" WARD"
64 D NOW^%DTC S XMDT=X K X
65 S XMDUZ=.5,XMY("G.CARELIFE RESULT ERROR")=""
66 S A(1)="There was an error in building an HL7 Lab Result Message for accession"
67 I LA7DVACC'="" D
68 . S A(2)=" # "_LA7DVACC_"of patient name: "_$P(^DPT(DFN,0),"^")_" at "_$P(VAIN(4),"^",2)_" Ward."
69 . S A(3)="The error was "_$P(HLRESLT,"^",3)_"."
70 E D
71 . S A(2)="The error was "_TEXT_"."
72 . S A(3)=""
73 S A(4)="Please make a note of it and take any actions that necessary"
74 S XMTEXT="A(" D ^XMD
75 K A
76 Q
Note: See TracBrowser for help on using the repository browser.