- 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 Feb 18, 2025@23:35 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
