MAGT7SB ;WOIFO/MLH/PMK - telepathology - create HL7 message to DPS - segment build - OBR ; 24 Jul 2013 8:23 PM
;;3.0;IMAGING;**138**;Mar 19, 2002;Build 5380;Sep 03, 2013
;; Per VHA Directive 2004-038, this routine should not be modified.
;; +---------------------------------------------------------------+
;; | Property of the US Government. |
;; | No permission to copy or redistribute this software is given. |
;; | Use of unreleased versions of this software requires the user |
;; | to execute a written test agreement with the VistA Imaging |
;; | Development Office of the Department of Veterans Affairs, |
;; | telephone (301) 734-0100. |
;; | The Food and Drug Administration classifies this software as |
;; | a medical device. As such, it may not be changed in any way. |
;; | Modifications to this software may result in an adulterated |
;; | medical device under 21CFR820, the use of which is considered |
;; | to be a violation of US Federal Statutes. |
;; +---------------------------------------------------------------+
;;
Q
;
OBRSEG(SEGELTS,FILE,LRSS,IENS,ACNUMB) ; FUNCTION - main entry point - create an OBR segment
N LABTEST ; name of lab test
N SETID S SETID=1 ; set ID value for OBR segment
N FLDSETID S FLDSETID=1 ; set ID field number
N FLDPLORDNO S FLDPLORDNO=2 ; placer order number field number
N FLDUNIVSVCID S FLDUNIVSVCID=4 ; universal service ID field number
N FLDCOLLECTOR S FLDCOLLECTOR=10 ; name of person who collected the specimen
N FLDORDPVDR S FLDORDPVDR=16 ; ordering provider field number
N FLDCALBKPHN S FLDCALBKPHN=17 ; call back phone number field number
N FLDDXSERVID S FLDDXSERVID=24 ; diagnostic service section id
N ORDPVDRNO ; ordering provider number
N ORDPVDRNAM ; ordering provider name
N ERRSTAT S ERRSTAT=0 ; error status - assume nothing to report
;
K SEGELTS ; always refresh *segment* array (not message array) on entry
;
D SET^HLOAPI(.SEGELTS,"OBR",0) ; segment type
D ; set up fields, check exit flag after each
. D Q:ERRSTAT ; OBR-1-set ID
. . D SET^HLOAPI(.SEGELTS,SETID,FLDSETID)
. . Q
. D Q:ERRSTAT ; OBR-2-placer order number
. . D SET^HLOAPI(.SEGELTS,ACNUMB,FLDPLORDNO)
. . Q
. D Q:ERRSTAT ; OBR-4-universal service ID
. . D TESTLKUP(LABDATA,.LABTEST)
. . S LABTEST("SYSTEM")="VISTA60"
. . D SETCE^HLOAPI4(.SEGELTS,.LABTEST,FLDUNIVSVCID)
. . Q
. D Q:ERRSTAT ; OBR-10-collector ID
. . N COLLECTOR ; person who collected the specimen
. . ; the data type of this field is XCN (extended composite name)
. . ; unfortunately, the lab package only records it as free text,
. . ; so it is output in sequence 2 as "Family Name"
. . S COLLECTOR=$G(@LABDATA@(FILE("0"),IENS,.011,"I"))
. . D SET^HLOAPI(.SEGELTS,COLLECTOR,FLDCOLLECTOR,2)
. . Q
. D Q:ERRSTAT ; OBR-16-ordering provider
. . S ORDPVDRNO=$$GET1^DIQ(FILE(0),IENS,.07,"I")
. . I 'ORDPVDRNO D SET^HLOAPI(.SEGELTS,"""""",FLDORDPVDR,1) Q ; no ordering provider
. . S ERRSTAT=$$NPNAME^MAG7UNM(.ORDPVDRNAM,ORDPVDRNO)
. . D:'ERRSTAT
. . . D SET^HLOAPI(.SEGELTS,ORDPVDRNO,FLDORDPVDR,1)
. . . D SET^HLOAPI(.SEGELTS,$G(ORDPVDRNAM("FAMILY"),""),FLDORDPVDR,2)
. . . D SET^HLOAPI(.SEGELTS,$G(ORDPVDRNAM("GIVEN"),""),FLDORDPVDR,3)
. . . D SET^HLOAPI(.SEGELTS,$G(ORDPVDRNAM("MIDDLE"),""),FLDORDPVDR,4)
. . . Q
. . Q
. D Q:ERRSTAT ; OBR-17-call back phone number
. . S ERRSTAT=$$CALLBACK^MAGT7SO(.SEGELTS,ORDPVDRNO,FLDCALBKPHN)
. . Q
. D Q:ERRSTAT ; OBR-24-diagnostic service section id
. . N ID
. . S ID=$P(ACNUMB," ",1) ; VA lab service from file #62.2
. . ; Note that for cytology (cytopathology) the abbreviation should be CP and not CY
. . ; We are ignoring that difference because it makes it more complicated for the worklist
. . ; S ID=$S(ID="CY":"CP",1:ID) ; see HL7 2.5.1 Ch 4 section 4.5.3.24
. . D SET^HLOAPI(.SEGELTS,ID,FLDDXSERVID)
. . Q
. Q
;
Q ERRSTAT
;
TESTLKUP(LABDATA,LABTEST) ; lookup the test - called by MAGVIM02 as well
N IENS
S IENS=$O(@LABDATA@(FILE("ORDERED TEST"),""))
I IENS'="" D
. S LABTEST=$G(@LABDATA@(FILE("ORDERED TEST"),IENS,13,"I"))
. I LABTEST D
. . S LABTEST("ID")=LABTEST
. . S LABTEST("TEXT")=$$GET1^DIQ(60,LABTEST,.01,"E")
. . Q
. Q
I '$D(LABTEST("ID")) D ; use default test
. S LABTEST("ID")=FILE("PROCEDURE IEN")
. S LABTEST("TEXT")=FILE("PROCEDURE NAME")
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGT7SB 4510 printed Apr 09, 2024@21:11:34 Page 2
MAGT7SB ;WOIFO/MLH/PMK - telepathology - create HL7 message to DPS - segment build - OBR ; 24 Jul 2013 8:23 PM
+1 ;;3.0;IMAGING;**138**;Mar 19, 2002;Build 5380;Sep 03, 2013
+2 ;; Per VHA Directive 2004-038, this routine should not be modified.
+3 ;; +---------------------------------------------------------------+
+4 ;; | Property of the US Government. |
+5 ;; | No permission to copy or redistribute this software is given. |
+6 ;; | Use of unreleased versions of this software requires the user |
+7 ;; | to execute a written test agreement with the VistA Imaging |
+8 ;; | Development Office of the Department of Veterans Affairs, |
+9 ;; | telephone (301) 734-0100. |
+10 ;; | The Food and Drug Administration classifies this software as |
+11 ;; | a medical device. As such, it may not be changed in any way. |
+12 ;; | Modifications to this software may result in an adulterated |
+13 ;; | medical device under 21CFR820, the use of which is considered |
+14 ;; | to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
+17 QUIT
+18 ;
OBRSEG(SEGELTS,FILE,LRSS,IENS,ACNUMB) ; FUNCTION - main entry point - create an OBR segment
+1 ; name of lab test
NEW LABTEST
+2 ; set ID value for OBR segment
NEW SETID
SET SETID=1
+3 ; set ID field number
NEW FLDSETID
SET FLDSETID=1
+4 ; placer order number field number
NEW FLDPLORDNO
SET FLDPLORDNO=2
+5 ; universal service ID field number
NEW FLDUNIVSVCID
SET FLDUNIVSVCID=4
+6 ; name of person who collected the specimen
NEW FLDCOLLECTOR
SET FLDCOLLECTOR=10
+7 ; ordering provider field number
NEW FLDORDPVDR
SET FLDORDPVDR=16
+8 ; call back phone number field number
NEW FLDCALBKPHN
SET FLDCALBKPHN=17
+9 ; diagnostic service section id
NEW FLDDXSERVID
SET FLDDXSERVID=24
+10 ; ordering provider number
NEW ORDPVDRNO
+11 ; ordering provider name
NEW ORDPVDRNAM
+12 ; error status - assume nothing to report
NEW ERRSTAT
SET ERRSTAT=0
+13 ;
+14 ; always refresh *segment* array (not message array) on entry
KILL SEGELTS
+15 ;
+16 ; segment type
DO SET^HLOAPI(.SEGELTS,"OBR",0)
+17 ; set up fields, check exit flag after each
Begin DoDot:1
+18 ; OBR-1-set ID
Begin DoDot:2
+19 DO SET^HLOAPI(.SEGELTS,SETID,FLDSETID)
+20 QUIT
End DoDot:2
if ERRSTAT
QUIT
+21 ; OBR-2-placer order number
Begin DoDot:2
+22 DO SET^HLOAPI(.SEGELTS,ACNUMB,FLDPLORDNO)
+23 QUIT
End DoDot:2
if ERRSTAT
QUIT
+24 ; OBR-4-universal service ID
Begin DoDot:2
+25 DO TESTLKUP(LABDATA,.LABTEST)
+26 SET LABTEST("SYSTEM")="VISTA60"
+27 DO SETCE^HLOAPI4(.SEGELTS,.LABTEST,FLDUNIVSVCID)
+28 QUIT
End DoDot:2
if ERRSTAT
QUIT
+29 ; OBR-10-collector ID
Begin DoDot:2
+30 ; person who collected the specimen
NEW COLLECTOR
+31 ; the data type of this field is XCN (extended composite name)
+32 ; unfortunately, the lab package only records it as free text,
+33 ; so it is output in sequence 2 as "Family Name"
+34 SET COLLECTOR=$GET(@LABDATA@(FILE("0"),IENS,.011,"I"))
+35 DO SET^HLOAPI(.SEGELTS,COLLECTOR,FLDCOLLECTOR,2)
+36 QUIT
End DoDot:2
if ERRSTAT
QUIT
+37 ; OBR-16-ordering provider
Begin DoDot:2
+38 SET ORDPVDRNO=$$GET1^DIQ(FILE(0),IENS,.07,"I")
+39 ; no ordering provider
IF 'ORDPVDRNO
DO SET^HLOAPI(.SEGELTS,"""""",FLDORDPVDR,1)
QUIT
+40 SET ERRSTAT=$$NPNAME^MAG7UNM(.ORDPVDRNAM,ORDPVDRNO)
+41 if 'ERRSTAT
Begin DoDot:3
+42 DO SET^HLOAPI(.SEGELTS,ORDPVDRNO,FLDORDPVDR,1)
+43 DO SET^HLOAPI(.SEGELTS,$GET(ORDPVDRNAM("FAMILY"),""),FLDORDPVDR,2)
+44 DO SET^HLOAPI(.SEGELTS,$GET(ORDPVDRNAM("GIVEN"),""),FLDORDPVDR,3)
+45 DO SET^HLOAPI(.SEGELTS,$GET(ORDPVDRNAM("MIDDLE"),""),FLDORDPVDR,4)
+46 QUIT
End DoDot:3
+47 QUIT
End DoDot:2
if ERRSTAT
QUIT
+48 ; OBR-17-call back phone number
Begin DoDot:2
+49 SET ERRSTAT=$$CALLBACK^MAGT7SO(.SEGELTS,ORDPVDRNO,FLDCALBKPHN)
+50 QUIT
End DoDot:2
if ERRSTAT
QUIT
+51 ; OBR-24-diagnostic service section id
Begin DoDot:2
+52 NEW ID
+53 ; VA lab service from file #62.2
SET ID=$PIECE(ACNUMB," ",1)
+54 ; Note that for cytology (cytopathology) the abbreviation should be CP and not CY
+55 ; We are ignoring that difference because it makes it more complicated for the worklist
+56 ; S ID=$S(ID="CY":"CP",1:ID) ; see HL7 2.5.1 Ch 4 section 4.5.3.24
+57 DO SET^HLOAPI(.SEGELTS,ID,FLDDXSERVID)
+58 QUIT
End DoDot:2
if ERRSTAT
QUIT
+59 QUIT
End DoDot:1
+60 ;
+61 QUIT ERRSTAT
+62 ;
TESTLKUP(LABDATA,LABTEST) ; lookup the test - called by MAGVIM02 as well
+1 NEW IENS
+2 SET IENS=$ORDER(@LABDATA@(FILE("ORDERED TEST"),""))
+3 IF IENS'=""
Begin DoDot:1
+4 SET LABTEST=$GET(@LABDATA@(FILE("ORDERED TEST"),IENS,13,"I"))
+5 IF LABTEST
Begin DoDot:2
+6 SET LABTEST("ID")=LABTEST
+7 SET LABTEST("TEXT")=$$GET1^DIQ(60,LABTEST,.01,"E")
+8 QUIT
End DoDot:2
+9 QUIT
End DoDot:1
+10 ; use default test
IF '$DATA(LABTEST("ID"))
Begin DoDot:1
+11 SET LABTEST("ID")=FILE("PROCEDURE IEN")
+12 SET LABTEST("TEXT")=FILE("PROCEDURE NAME")
+13 QUIT
End DoDot:1
+14 QUIT
