| 1 | DVBCHLUT ;ALB/JLU-Utility routine for the HL7 interface ;1/28/93
|
|---|
| 2 | ;;2.7;AMIE;;Apr 10, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | OBR ;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 | ;
|
|---|
| 20 | PID ;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 | ;
|
|---|
| 35 | ORC ;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 | ;
|
|---|
| 45 | LOCK(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 | ;
|
|---|
| 53 | UNLOCK(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 | ;
|
|---|
| 59 | HASH ;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 | ;
|
|---|
