source: FOIAVistA/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBCHLUT.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 1.9 KB
Line 
1DVBCHLUT ;ALB/JLU-Utility routine for the HL7 interface ;1/28/93
2 ;;2.7;AMIE;;Apr 10, 1995
3 ;
4OBR ;sets up the OBR segment
5 ;called by DVBCHLQ and DVBCHLOR
6 S $P(DVBC1,HLFS,23)=""
7 S $P(DVBC1,HLFS,1)="OBR"
8 S $P(DVBC1,HLFS,5)=DVBCRDFN_$E(HLECH)_DVBCEXAM_$E(HLECH)_"L" ;ifn of request^ifn of exam^L
9 S $P(DVBC1,HLFS,8)=$$HLDATE^HLFNC(DVBCRQDT) ;request date
10 S $P(DVBC1,HLFS,9)=HLQ ;unused required
11 S $P(DVBC1,HLFS,10)=HLQ ;unused required
12 S $P(DVBC1,HLFS,15)=HLQ ;unused required
13 S $P(DVBC1,HLFS,$S($D(DVBCPLCR):19,1:21))=DVBCEXTY ;exam type
14 S $P(DVBC1,HLFS,23)=HLDT1 ;time results reported
15 S HLSDATA(DVBCSEG)=DVBC1
16 S DVBCSEG=DVBCSEG+1
17 K DVBC1
18 Q
19 ;
20PID ;setting up PID segment
21 ;called by DVBCHLQ and DVBCHLOR
22 S $P(DVBC1,HLFS,20)=""
23 S $P(DVBC1,HLFS,1)="PID"
24 S $P(DVBC1,HLFS,4)=$$M10^HLFNC(DVBCPDFN) ;internal patient id
25 S $P(DVBC1,HLFS,6)=$$HLNAME^HLFNC(VADM(1)) ;patient name
26 S $P(DVBC1,HLFS,8)=$$HLDATE^HLFNC(VADM(3)) ;dob
27 S $P(DVBC1,HLFS,9)=$S(VADM(5)]"":$P(VADM(5),U,1),1:"U") ;sex
28 S $P(DVBC1,HLFS,11)=$S(+VADM(8)=1!(+VADM(8)=2):"H",+VADM(8)=3:"A",+VADM(8)=4:"B",+VADM(8)=5:"R",+VADM(8)=6:"C",1:HLQ) ;setting ethnic group
29 S $P(DVBC1,HLFS,20)=$P(VADM(2),U,1) ;ssn
30 S HLSDATA(DVBCSEG)=DVBC1
31 S DVBCSEG=DVBCSEG+1
32 K DVBC1
33 Q
34 ;
35ORC ;builds the ORC segment
36 S $P(DVBC1,HLFS,10)=""
37 S $P(DVBC1,HLFS,1)="ORC"
38 S $P(DVBC1,HLFS,2)=DVBCOC ;control order for new orders
39 S $P(DVBC1,HLFS,10)=HLDT1
40 S HLSDATA(DVBCSEG)=DVBC1
41 S DVBCSEG=DVBCSEG+1
42 K DVBC1
43 Q
44 ;
45LOCK(A,B) ;
46 ;this function tries to lock the 396.3 and 396.4 records
47 L +^DVB(396.3,A):2
48 I '$T S HLERR="Record currently accessed by another user" D UNLOCK(A,B) Q 0
49 L +^DVB(396.4,B):2
50 I '$T S HLERR="Exam currently being accessed by another user" D UNLOCK(A,B) Q 0
51 Q 1
52 ;
53UNLOCK(A,B) ;
54 ;this subroutine unlocks the 396.3 and 396.4 records
55 L -^DVB(396.3,A)
56 L -^DVB(396.4,B)
57 Q
58 ;
59HASH ;hashes the electronic signature code
60 Q:'$D(HLESIG)
61 N X,X1,X2
62 S X=HLESIG,X1=HLDUZ,X2=DVBCUEX
63 D EN^XUSHSHP
64 S DVBCELCT=X
65 Q
66 ;
Note: See TracBrowser for help on using the repository browser.