DVBCHLUT ;ALB/JLU-Utility routine for the HL7 interface ;1/28/93
;;2.7;AMIE;;Apr 10, 1995
;
OBR ;sets up the OBR segment
;called by DVBCHLQ and DVBCHLOR
S $P(DVBC1,HLFS,23)=""
S $P(DVBC1,HLFS,1)="OBR"
S $P(DVBC1,HLFS,5)=DVBCRDFN_$E(HLECH)_DVBCEXAM_$E(HLECH)_"L" ;ifn of request^ifn of exam^L
S $P(DVBC1,HLFS,8)=$$HLDATE^HLFNC(DVBCRQDT) ;request date
S $P(DVBC1,HLFS,9)=HLQ ;unused required
S $P(DVBC1,HLFS,10)=HLQ ;unused required
S $P(DVBC1,HLFS,15)=HLQ ;unused required
S $P(DVBC1,HLFS,$S($D(DVBCPLCR):19,1:21))=DVBCEXTY ;exam type
S $P(DVBC1,HLFS,23)=HLDT1 ;time results reported
S HLSDATA(DVBCSEG)=DVBC1
S DVBCSEG=DVBCSEG+1
K DVBC1
Q
;
PID ;setting up PID segment
;called by DVBCHLQ and DVBCHLOR
S $P(DVBC1,HLFS,20)=""
S $P(DVBC1,HLFS,1)="PID"
S $P(DVBC1,HLFS,4)=$$M10^HLFNC(DVBCPDFN) ;internal patient id
S $P(DVBC1,HLFS,6)=$$HLNAME^HLFNC(VADM(1)) ;patient name
S $P(DVBC1,HLFS,8)=$$HLDATE^HLFNC(VADM(3)) ;dob
S $P(DVBC1,HLFS,9)=$S(VADM(5)]"":$P(VADM(5),U,1),1:"U") ;sex
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
S $P(DVBC1,HLFS,20)=$P(VADM(2),U,1) ;ssn
S HLSDATA(DVBCSEG)=DVBC1
S DVBCSEG=DVBCSEG+1
K DVBC1
Q
;
ORC ;builds the ORC segment
S $P(DVBC1,HLFS,10)=""
S $P(DVBC1,HLFS,1)="ORC"
S $P(DVBC1,HLFS,2)=DVBCOC ;control order for new orders
S $P(DVBC1,HLFS,10)=HLDT1
S HLSDATA(DVBCSEG)=DVBC1
S DVBCSEG=DVBCSEG+1
K DVBC1
Q
;
LOCK(A,B) ;
;this function tries to lock the 396.3 and 396.4 records
L +^DVB(396.3,A):2
I '$T S HLERR="Record currently accessed by another user" D UNLOCK(A,B) Q 0
L +^DVB(396.4,B):2
I '$T S HLERR="Exam currently being accessed by another user" D UNLOCK(A,B) Q 0
Q 1
;
UNLOCK(A,B) ;
;this subroutine unlocks the 396.3 and 396.4 records
L -^DVB(396.3,A)
L -^DVB(396.4,B)
Q
;
HASH ;hashes the electronic signature code
Q:'$D(HLESIG)
N X,X1,X2
S X=HLESIG,X1=HLDUZ,X2=DVBCUEX
D EN^XUSHSHP
S DVBCELCT=X
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBCHLUT 2056 printed Dec 13, 2024@01:44:21 Page 2
DVBCHLUT ;ALB/JLU-Utility routine for the HL7 interface ;1/28/93
+1 ;;2.7;AMIE;;Apr 10, 1995
+2 ;
OBR ;sets up the OBR segment
+1 ;called by DVBCHLQ and DVBCHLOR
+2 SET $PIECE(DVBC1,HLFS,23)=""
+3 SET $PIECE(DVBC1,HLFS,1)="OBR"
+4 ;ifn of request^ifn of exam^L
SET $PIECE(DVBC1,HLFS,5)=DVBCRDFN_$EXTRACT(HLECH)_DVBCEXAM_$EXTRACT(HLECH)_"L"
+5 ;request date
SET $PIECE(DVBC1,HLFS,8)=$$HLDATE^HLFNC(DVBCRQDT)
+6 ;unused required
SET $PIECE(DVBC1,HLFS,9)=HLQ
+7 ;unused required
SET $PIECE(DVBC1,HLFS,10)=HLQ
+8 ;unused required
SET $PIECE(DVBC1,HLFS,15)=HLQ
+9 ;exam type
SET $PIECE(DVBC1,HLFS,$SELECT($DATA(DVBCPLCR):19,1:21))=DVBCEXTY
+10 ;time results reported
SET $PIECE(DVBC1,HLFS,23)=HLDT1
+11 SET HLSDATA(DVBCSEG)=DVBC1
+12 SET DVBCSEG=DVBCSEG+1
+13 KILL DVBC1
+14 QUIT
+15 ;
PID ;setting up PID segment
+1 ;called by DVBCHLQ and DVBCHLOR
+2 SET $PIECE(DVBC1,HLFS,20)=""
+3 SET $PIECE(DVBC1,HLFS,1)="PID"
+4 ;internal patient id
SET $PIECE(DVBC1,HLFS,4)=$$M10^HLFNC(DVBCPDFN)
+5 ;patient name
SET $PIECE(DVBC1,HLFS,6)=$$HLNAME^HLFNC(VADM(1))
+6 ;dob
SET $PIECE(DVBC1,HLFS,8)=$$HLDATE^HLFNC(VADM(3))
+7 ;sex
SET $PIECE(DVBC1,HLFS,9)=$SELECT(VADM(5)]"":$PIECE(VADM(5),U,1),1:"U")
+8 ;setting ethnic group
SET $PIECE(DVBC1,HLFS,11)=$SELECT(+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)
+9 ;ssn
SET $PIECE(DVBC1,HLFS,20)=$PIECE(VADM(2),U,1)
+10 SET HLSDATA(DVBCSEG)=DVBC1
+11 SET DVBCSEG=DVBCSEG+1
+12 KILL DVBC1
+13 QUIT
+14 ;
ORC ;builds the ORC segment
+1 SET $PIECE(DVBC1,HLFS,10)=""
+2 SET $PIECE(DVBC1,HLFS,1)="ORC"
+3 ;control order for new orders
SET $PIECE(DVBC1,HLFS,2)=DVBCOC
+4 SET $PIECE(DVBC1,HLFS,10)=HLDT1
+5 SET HLSDATA(DVBCSEG)=DVBC1
+6 SET DVBCSEG=DVBCSEG+1
+7 KILL DVBC1
+8 QUIT
+9 ;
LOCK(A,B) ;
+1 ;this function tries to lock the 396.3 and 396.4 records
+2 LOCK +^DVB(396.3,A):2
+3 IF '$TEST
SET HLERR="Record currently accessed by another user"
DO UNLOCK(A,B)
QUIT 0
+4 LOCK +^DVB(396.4,B):2
+5 IF '$TEST
SET HLERR="Exam currently being accessed by another user"
DO UNLOCK(A,B)
QUIT 0
+6 QUIT 1
+7 ;
UNLOCK(A,B) ;
+1 ;this subroutine unlocks the 396.3 and 396.4 records
+2 LOCK -^DVB(396.3,A)
+3 LOCK -^DVB(396.4,B)
+4 QUIT
+5 ;
HASH ;hashes the electronic signature code
+1 if '$DATA(HLESIG)
QUIT
+2 NEW X,X1,X2
+3 SET X=HLESIG
SET X1=HLDUZ
SET X2=DVBCUEX
+4 DO EN^XUSHSHP
+5 SET DVBCELCT=X
+6 QUIT
+7 ;
