- 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 Feb 18, 2025@23:10:46 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 ;