Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DVBCHLUT

DVBCHLUT.m

Go to the documentation of this file.
  1. DVBCHLUT ;ALB/JLU-Utility routine for the HL7 interface ;1/28/93
  1. ;;2.7;AMIE;;Apr 10, 1995
  1. ;
  1. OBR ;sets up the OBR segment
  1. ;called by DVBCHLQ and DVBCHLOR
  1. S $P(DVBC1,HLFS,23)=""
  1. S $P(DVBC1,HLFS,1)="OBR"
  1. S $P(DVBC1,HLFS,5)=DVBCRDFN_$E(HLECH)_DVBCEXAM_$E(HLECH)_"L" ;ifn of request^ifn of exam^L
  1. S $P(DVBC1,HLFS,8)=$$HLDATE^HLFNC(DVBCRQDT) ;request date
  1. S $P(DVBC1,HLFS,9)=HLQ ;unused required
  1. S $P(DVBC1,HLFS,10)=HLQ ;unused required
  1. S $P(DVBC1,HLFS,15)=HLQ ;unused required
  1. S $P(DVBC1,HLFS,$S($D(DVBCPLCR):19,1:21))=DVBCEXTY ;exam type
  1. S $P(DVBC1,HLFS,23)=HLDT1 ;time results reported
  1. S HLSDATA(DVBCSEG)=DVBC1
  1. S DVBCSEG=DVBCSEG+1
  1. K DVBC1
  1. Q
  1. ;
  1. PID ;setting up PID segment
  1. ;called by DVBCHLQ and DVBCHLOR
  1. S $P(DVBC1,HLFS,20)=""
  1. S $P(DVBC1,HLFS,1)="PID"
  1. S $P(DVBC1,HLFS,4)=$$M10^HLFNC(DVBCPDFN) ;internal patient id
  1. S $P(DVBC1,HLFS,6)=$$HLNAME^HLFNC(VADM(1)) ;patient name
  1. S $P(DVBC1,HLFS,8)=$$HLDATE^HLFNC(VADM(3)) ;dob
  1. S $P(DVBC1,HLFS,9)=$S(VADM(5)]"":$P(VADM(5),U,1),1:"U") ;sex
  1. 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
  1. S $P(DVBC1,HLFS,20)=$P(VADM(2),U,1) ;ssn
  1. S HLSDATA(DVBCSEG)=DVBC1
  1. S DVBCSEG=DVBCSEG+1
  1. K DVBC1
  1. Q
  1. ;
  1. ORC ;builds the ORC segment
  1. S $P(DVBC1,HLFS,10)=""
  1. S $P(DVBC1,HLFS,1)="ORC"
  1. S $P(DVBC1,HLFS,2)=DVBCOC ;control order for new orders
  1. S $P(DVBC1,HLFS,10)=HLDT1
  1. S HLSDATA(DVBCSEG)=DVBC1
  1. S DVBCSEG=DVBCSEG+1
  1. K DVBC1
  1. Q
  1. ;
  1. LOCK(A,B) ;
  1. ;this function tries to lock the 396.3 and 396.4 records
  1. L +^DVB(396.3,A):2
  1. I '$T S HLERR="Record currently accessed by another user" D UNLOCK(A,B) Q 0
  1. L +^DVB(396.4,B):2
  1. I '$T S HLERR="Exam currently being accessed by another user" D UNLOCK(A,B) Q 0
  1. Q 1
  1. ;
  1. UNLOCK(A,B) ;
  1. ;this subroutine unlocks the 396.3 and 396.4 records
  1. L -^DVB(396.3,A)
  1. L -^DVB(396.4,B)
  1. Q
  1. ;
  1. HASH ;hashes the electronic signature code
  1. Q:'$D(HLESIG)
  1. N X,X1,X2
  1. S X=HLESIG,X1=HLDUZ,X2=DVBCUEX
  1. D EN^XUSHSHP
  1. S DVBCELCT=X
  1. Q
  1. ;