MAGT7SO ;WOIFO/MLH/PMK/JSL - telepathology - create HL7 message to DPS - segment build - ORC ; 3 Jan 2015 4:15 PM
;;3.0;IMAGING;**138,156**;Mar 19, 2002;Build 10;Jan 3, 2015
;; 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
;
ORCSEG(SEGELTS,FILE,STATE,IENS,ACNUMB) ; FUNCTION - main entry point - create an ORC segment
N I ; scratch loop index
N X ; scratch return from extrinsic functions
N ENTBY ; entered by name
N ORDPVDRNO ; ordering provider number
N MAGNAMLKUPELTS ; attribute array for new person name retrieval call to $$HLNAME^XLFNAME
N ORDPVDRNAM ; ordering provider name
N DIQRET ; return array from GETS^DIQ
N ENTORG ; entering organization
N FLDORCTRLCD S FLDORCTRLCD=1 ; order control code field
N FLDPLORDNO S FLDPLORDNO=2 ; placer order number field
N FLDORSTATUS S FLDORSTATUS=5 ; order status code field
N FLDDTXACT S FLDDTXACT=9 ; date/time of transaction field
N FLDENTBY S FLDENTBY=10 ; entered by field
N FLDORDPVDR S FLDORDPVDR=12 ; ordering provider field
N FLDCALBKPHN S FLDCALBKPHN=14 ; call back phone number field
N FLDORCTRLRSN S FLDORCTRLRSN=16 ; order control code reason field
N FLDENTORG S FLDENTORG=17 ; entering organization field
N FLDORDFACNAM S FLDORDFACNAM=21 ; ordering facility name field
N ORCTRL,ORSTATUS,ORREASON ; order control, status, and reason fields
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,"ORC",0) ; segment type
I STATE="NEW" S ORCTRL="NW",ORREASON="NEWORDR" ; "NW" = new order
E I STATE="EDIT" S ORCTRL="XO",ORSTATUS="IP",ORREASON="CHANGEORDR"
E I STATE="COMPLETED" S ORCTRL="SC",ORSTATUS="CM",ORREASON="INTCMPLT"
E I STATE="CANCELLED" S ORCTRL="CA",ORSTATUS="CA",ORREASON="CANCELLED"
D
. D Q:ERRSTAT ; ORC-1-order control code
. . D SET^HLOAPI(.SEGELTS,ORCTRL,FLDORCTRLCD) ; IA #4716
. . Q
. D Q:ERRSTAT ; ORC-2-placer order number
. . D SET^HLOAPI(.SEGELTS,ACNUMB,FLDPLORDNO) ; IA #4716
. . Q
. I $D(ORSTATUS) D Q:ERRSTAT ; ORC-5-order status code
. . D SET^HLOAPI(.SEGELTS,ORSTATUS,FLDORSTATUS) ; IA #4716
. . Q
. D Q:ERRSTAT ; ORC-9-date/time of transaction
. . D SETTS^HLOAPI4(.SEGELTS,$$NOW^XLFDT,FLDDTXACT) ; IA #4853
. . Q
. D Q:ERRSTAT ; ORC-10-entered by
. . S ERRSTAT=$$NPNAME^MAG7UNM(.ENTBY,DUZ)
. . D:'ERRSTAT
. . . D SET^HLOAPI(.SEGELTS,DUZ,FLDENTBY,1) ; IA #4716
. . . D SET^HLOAPI(.SEGELTS,$G(ENTBY("FAMILY")),FLDENTBY,2) ; IA #4716
. . . D SET^HLOAPI(.SEGELTS,$G(ENTBY("GIVEN")),FLDENTBY,3) ; IA #4716
. . . D SET^HLOAPI(.SEGELTS,$G(ENTBY("MIDDLE")),FLDENTBY,4) ; IA #4716
. . . Q
. . Q
. D Q:ERRSTAT ; ORC-12-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) ; IA #4716
. . . D SET^HLOAPI(.SEGELTS,$G(ORDPVDRNAM("FAMILY")),FLDORDPVDR,2) ; IA #4716
. . . D SET^HLOAPI(.SEGELTS,$G(ORDPVDRNAM("GIVEN")),FLDORDPVDR,3) ; IA #4716
. . . D SET^HLOAPI(.SEGELTS,$G(ORDPVDRNAM("MIDDLE")),FLDORDPVDR,4) ; IA #4716
. . . Q
. . Q
. D Q:ERRSTAT ; ORC-14-call back phone number
. . S ERRSTAT=$$CALLBACK^MAGT7SO(.SEGELTS,ORDPVDRNO,FLDCALBKPHN)
. . Q
. I $D(ORREASON) D Q:ERRSTAT ; ORC-16-order control code reason> <-- SUGGEST DROPPING
. . D SET^HLOAPI(.SEGELTS,ORREASON,FLDORCTRLRSN)
. . Q
. D Q:ERRSTAT ; ORC-17-entering organization ; ICR # 10060
. . K ERRMSG
. . D GETS^DIQ(200,$G(DUZ)_",",29,"EI","DIQRET","ERRMSG")
. . D:$G(ERRMSG) ; error in GETS^DIQ call
. . . S ERRSTAT="-21`FileMan error ("_$G(ERRMSG(1))_":"_$G(ERRMSG(1,"TEXT",1))_")"
. . . Q
. . D:'ERRSTAT
. . . S ENTORG("ID")=$G(DIQRET(200,$G(DUZ)_",",29,"I"))
. . . S ENTORG("TEXT")=$G(DIQRET(200,$G(DUZ)_",",29,"E"))
. . . S ENTORG("SYSTEM")="VISTA49"
. . . D SETCE^HLOAPI4(.SEGELTS,.ENTORG,FLDENTORG)
. . . Q
. . Q
. D Q:ERRSTAT ; ORC-21-ordering facility name
. . N LOCATION,NAME
. . S LOCATION=$$KSP^XUPARAM("INST")
. . S NAME=$$GET1^DIQ(4,LOCATION,.01)
. . D SET^HLOAPI(.SEGELTS,NAME,FLDORDFACNAM,1) ; organization name - IA #4716
. . D SET^HLOAPI(.SEGELTS,LOCATION,FLDORDFACNAM,3) ; organization identifier (DIVISION ien) - IA #4716
. . D SET^HLOAPI(.SEGELTS,"FI",FLDORDFACNAM,7) ; abbreviation for facility id - IA #4716
. . D SET^HLOAPI(.SEGELTS,$$STATNUMB^MAGDFCNV(),FLDORDFACNAM,10) ; organization identifier (Station Number) - IA #4716
. . Q
. Q
Q ERRSTAT
;
CALLBACK(SEGELTS,ORDPVDRNO,FLDCALBKPHN) ; call back phone number (in both ORC and OBR segments)
N CALBAKFON ; call back phone array
N IREP
;
N ERRSTAT S ERRSTAT=0 ; error status - assume nothing to report
;
Q:'ORDPVDRNO ERRSTAT ; ignore situations where the ordering provider is unknown
;
S ERRSTAT=$$NPFON^MAG7UFO("CALBAKFON",ORDPVDRNO)
F IREP=1:1:8 D:$D(CALBAKFON(IREP)) ; allow up to 8 phone numbers
. D SET^HLOAPI(.SEGELTS,CALBAKFON(IREP,2,1),FLDCALBKPHN,2,1,IREP) ; IA #4716
. D SET^HLOAPI(.SEGELTS,CALBAKFON(IREP,3,1),FLDCALBKPHN,3,1,IREP) ; IA #4716
. D SET^HLOAPI(.SEGELTS,CALBAKFON(IREP,1,1),FLDCALBKPHN,12,1,IREP) ; IA #4716
. Q
Q ERRSTAT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGT7SO 6283 printed Oct 16, 2024@18:09:13 Page 2
MAGT7SO ;WOIFO/MLH/PMK/JSL - telepathology - create HL7 message to DPS - segment build - ORC ; 3 Jan 2015 4:15 PM
+1 ;;3.0;IMAGING;**138,156**;Mar 19, 2002;Build 10;Jan 3, 2015
+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 ;
ORCSEG(SEGELTS,FILE,STATE,IENS,ACNUMB) ; FUNCTION - main entry point - create an ORC segment
+1 ; scratch loop index
NEW I
+2 ; scratch return from extrinsic functions
NEW X
+3 ; entered by name
NEW ENTBY
+4 ; ordering provider number
NEW ORDPVDRNO
+5 ; attribute array for new person name retrieval call to $$HLNAME^XLFNAME
NEW MAGNAMLKUPELTS
+6 ; ordering provider name
NEW ORDPVDRNAM
+7 ; return array from GETS^DIQ
NEW DIQRET
+8 ; entering organization
NEW ENTORG
+9 ; order control code field
NEW FLDORCTRLCD
SET FLDORCTRLCD=1
+10 ; placer order number field
NEW FLDPLORDNO
SET FLDPLORDNO=2
+11 ; order status code field
NEW FLDORSTATUS
SET FLDORSTATUS=5
+12 ; date/time of transaction field
NEW FLDDTXACT
SET FLDDTXACT=9
+13 ; entered by field
NEW FLDENTBY
SET FLDENTBY=10
+14 ; ordering provider field
NEW FLDORDPVDR
SET FLDORDPVDR=12
+15 ; call back phone number field
NEW FLDCALBKPHN
SET FLDCALBKPHN=14
+16 ; order control code reason field
NEW FLDORCTRLRSN
SET FLDORCTRLRSN=16
+17 ; entering organization field
NEW FLDENTORG
SET FLDENTORG=17
+18 ; ordering facility name field
NEW FLDORDFACNAM
SET FLDORDFACNAM=21
+19 ; order control, status, and reason fields
NEW ORCTRL,ORSTATUS,ORREASON
+20 ; error status - assume nothing to report
NEW ERRSTAT
SET ERRSTAT=0
+21 ;
+22 ; always refresh *segment* array (not message array) on entry
KILL SEGELTS
+23 ;
+24 ; segment type
DO SET^HLOAPI(.SEGELTS,"ORC",0)
+25 ; "NW" = new order
IF STATE="NEW"
SET ORCTRL="NW"
SET ORREASON="NEWORDR"
+26 IF '$TEST
IF STATE="EDIT"
SET ORCTRL="XO"
SET ORSTATUS="IP"
SET ORREASON="CHANGEORDR"
+27 IF '$TEST
IF STATE="COMPLETED"
SET ORCTRL="SC"
SET ORSTATUS="CM"
SET ORREASON="INTCMPLT"
+28 IF '$TEST
IF STATE="CANCELLED"
SET ORCTRL="CA"
SET ORSTATUS="CA"
SET ORREASON="CANCELLED"
+29 Begin DoDot:1
+30 ; ORC-1-order control code
Begin DoDot:2
+31 ; IA #4716
DO SET^HLOAPI(.SEGELTS,ORCTRL,FLDORCTRLCD)
+32 QUIT
End DoDot:2
if ERRSTAT
QUIT
+33 ; ORC-2-placer order number
Begin DoDot:2
+34 ; IA #4716
DO SET^HLOAPI(.SEGELTS,ACNUMB,FLDPLORDNO)
+35 QUIT
End DoDot:2
if ERRSTAT
QUIT
+36 ; ORC-5-order status code
IF $DATA(ORSTATUS)
Begin DoDot:2
+37 ; IA #4716
DO SET^HLOAPI(.SEGELTS,ORSTATUS,FLDORSTATUS)
+38 QUIT
End DoDot:2
if ERRSTAT
QUIT
+39 ; ORC-9-date/time of transaction
Begin DoDot:2
+40 ; IA #4853
DO SETTS^HLOAPI4(.SEGELTS,$$NOW^XLFDT,FLDDTXACT)
+41 QUIT
End DoDot:2
if ERRSTAT
QUIT
+42 ; ORC-10-entered by
Begin DoDot:2
+43 SET ERRSTAT=$$NPNAME^MAG7UNM(.ENTBY,DUZ)
+44 if 'ERRSTAT
Begin DoDot:3
+45 ; IA #4716
DO SET^HLOAPI(.SEGELTS,DUZ,FLDENTBY,1)
+46 ; IA #4716
DO SET^HLOAPI(.SEGELTS,$GET(ENTBY("FAMILY")),FLDENTBY,2)
+47 ; IA #4716
DO SET^HLOAPI(.SEGELTS,$GET(ENTBY("GIVEN")),FLDENTBY,3)
+48 ; IA #4716
DO SET^HLOAPI(.SEGELTS,$GET(ENTBY("MIDDLE")),FLDENTBY,4)
+49 QUIT
End DoDot:3
+50 QUIT
End DoDot:2
if ERRSTAT
QUIT
+51 ; ORC-12-ordering provider
Begin DoDot:2
+52 SET ORDPVDRNO=$$GET1^DIQ(FILE(0),IENS,.07,"I")
+53 ; no ordering provider
IF 'ORDPVDRNO
DO SET^HLOAPI(.SEGELTS,"""""",FLDORDPVDR,1)
QUIT
+54 SET ERRSTAT=$$NPNAME^MAG7UNM(.ORDPVDRNAM,ORDPVDRNO)
+55 if 'ERRSTAT
Begin DoDot:3
+56 ; IA #4716
DO SET^HLOAPI(.SEGELTS,ORDPVDRNO,FLDORDPVDR,1)
+57 ; IA #4716
DO SET^HLOAPI(.SEGELTS,$GET(ORDPVDRNAM("FAMILY")),FLDORDPVDR,2)
+58 ; IA #4716
DO SET^HLOAPI(.SEGELTS,$GET(ORDPVDRNAM("GIVEN")),FLDORDPVDR,3)
+59 ; IA #4716
DO SET^HLOAPI(.SEGELTS,$GET(ORDPVDRNAM("MIDDLE")),FLDORDPVDR,4)
+60 QUIT
End DoDot:3
+61 QUIT
End DoDot:2
if ERRSTAT
QUIT
+62 ; ORC-14-call back phone number
Begin DoDot:2
+63 SET ERRSTAT=$$CALLBACK^MAGT7SO(.SEGELTS,ORDPVDRNO,FLDCALBKPHN)
+64 QUIT
End DoDot:2
if ERRSTAT
QUIT
+65 ; ORC-16-order control code reason> <-- SUGGEST DROPPING
IF $DATA(ORREASON)
Begin DoDot:2
+66 DO SET^HLOAPI(.SEGELTS,ORREASON,FLDORCTRLRSN)
+67 QUIT
End DoDot:2
if ERRSTAT
QUIT
+68 ; ORC-17-entering organization ; ICR # 10060
Begin DoDot:2
+69 KILL ERRMSG
+70 DO GETS^DIQ(200,$GET(DUZ)_",",29,"EI","DIQRET","ERRMSG")
+71 ; error in GETS^DIQ call
if $GET(ERRMSG)
Begin DoDot:3
+72 SET ERRSTAT="-21`FileMan error ("_$GET(ERRMSG(1))_":"_$GET(ERRMSG(1,"TEXT",1))_")"
+73 QUIT
End DoDot:3
+74 if 'ERRSTAT
Begin DoDot:3
+75 SET ENTORG("ID")=$GET(DIQRET(200,$GET(DUZ)_",",29,"I"))
+76 SET ENTORG("TEXT")=$GET(DIQRET(200,$GET(DUZ)_",",29,"E"))
+77 SET ENTORG("SYSTEM")="VISTA49"
+78 DO SETCE^HLOAPI4(.SEGELTS,.ENTORG,FLDENTORG)
+79 QUIT
End DoDot:3
+80 QUIT
End DoDot:2
if ERRSTAT
QUIT
+81 ; ORC-21-ordering facility name
Begin DoDot:2
+82 NEW LOCATION,NAME
+83 SET LOCATION=$$KSP^XUPARAM("INST")
+84 SET NAME=$$GET1^DIQ(4,LOCATION,.01)
+85 ; organization name - IA #4716
DO SET^HLOAPI(.SEGELTS,NAME,FLDORDFACNAM,1)
+86 ; organization identifier (DIVISION ien) - IA #4716
DO SET^HLOAPI(.SEGELTS,LOCATION,FLDORDFACNAM,3)
+87 ; abbreviation for facility id - IA #4716
DO SET^HLOAPI(.SEGELTS,"FI",FLDORDFACNAM,7)
+88 ; organization identifier (Station Number) - IA #4716
DO SET^HLOAPI(.SEGELTS,$$STATNUMB^MAGDFCNV(),FLDORDFACNAM,10)
+89 QUIT
End DoDot:2
if ERRSTAT
QUIT
+90 QUIT
End DoDot:1
+91 QUIT ERRSTAT
+92 ;
CALLBACK(SEGELTS,ORDPVDRNO,FLDCALBKPHN) ; call back phone number (in both ORC and OBR segments)
+1 ; call back phone array
NEW CALBAKFON
+2 NEW IREP
+3 ;
+4 ; error status - assume nothing to report
NEW ERRSTAT
SET ERRSTAT=0
+5 ;
+6 ; ignore situations where the ordering provider is unknown
if 'ORDPVDRNO
QUIT ERRSTAT
+7 ;
+8 SET ERRSTAT=$$NPFON^MAG7UFO("CALBAKFON",ORDPVDRNO)
+9 ; allow up to 8 phone numbers
FOR IREP=1:1:8
if $DATA(CALBAKFON(IREP))
Begin DoDot:1
+10 ; IA #4716
DO SET^HLOAPI(.SEGELTS,CALBAKFON(IREP,2,1),FLDCALBKPHN,2,1,IREP)
+11 ; IA #4716
DO SET^HLOAPI(.SEGELTS,CALBAKFON(IREP,3,1),FLDCALBKPHN,3,1,IREP)
+12 ; IA #4716
DO SET^HLOAPI(.SEGELTS,CALBAKFON(IREP,1,1),FLDCALBKPHN,12,1,IREP)
+13 QUIT
End DoDot:1
+14 QUIT ERRSTAT
