MAGDHOW3 ;WOIFO/PMK,DWM,DAC,GXT - Capture Consult/GMRC data ; Mar 12, 2020@14:08:32
;;3.0;IMAGING;**138,180,203,208,231**;Mar 19, 2002;Build 9
;; 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. |
;; +---------------------------------------------------------------+
;;
;
; Supported IA #2051 reference $$FIND1^DIC function call
; Supported IA #2056 reference $$GET1^DIQ function call
; Supported IA #2056 reference GETS^DIQ subroutine call
; Supported IA #4716 reference SET^HLOAPI and $$ADDSEG^HLOAPI calls
; Supported IA #10103 reference $$FMTHL7^XLFDT function call
; Supported IA #3065 reference $$HLNAME^XLFNAME function call
; Controlled IA #4110 to read REQUEST/CONSULTATION file (#123)
; Private IA #2698 to read URGENCY FILE (#101.42)
; Supported IA #10060 to read phone numbers from NEW PERSON file (#200)
;
ORC(HLMSTATE,GMRCIEN,SAVEORCSEG) ; build the ORC segment (see ORC^GMRCHL7)
N ACNUMB,ERROR,ORCSEG,ORDERENTERER,ORDERNUMBER,ORDERPLACER,PRIORITY,SUCCESS,X
D SET^HLOAPI(.ORCSEG,"ORC",0)
D SET^HLOAPI(.ORCSEG,ORCTRL,1) ; ORC-1 order control
S ORDERNUMBER=$$GET1^DIQ(123,GMRCIEN,.03,"I") ; oe/rr file number
; D SET^HLOAPI(.ORCSEG,$$STATNUMB^MAGDFCNV()_"-OR-"_ORDERNUMBER,2) ; ORC-2 placer order number
S ACNUMB=$$GMRCACN^MAGDFCNV(GMRCIEN)
D SET^HLOAPI(.ORCSEG,ACNUMB,2) ; ORC-2 placer order number (to be compatible with CP) P208 PMK 4/26/18
D SET^HLOAPI(.ORCSEG,ACNUMB,3) ; ORC-3 filler order number
;
D SET^HLOAPI(.ORCSEG,ORSTATUS,5) ; ORC-5 order status
; ORC-6 not used
;
; store date and time of scheduled appointment for order messages, not results
I MSGTYPE="ORM",$D(APTSCHED("FM DATETIME")) D
. D SET^HLOAPI(.ORCSEG,$$FMTHL7^XLFDT(APTSCHED("FM DATETIME")),7,4) ; ORC-7 start date/time
. Q
S PRIORITY=$$GET1^DIQ(123,GMRCIEN,5),PRIORITY=$P(PRIORITY," - ",2) ; urgency
S PRIORITY=$S(PRIORITY="EMERGENCY":"STAT",PRIORITY="NOW":"STAT",PRIORITY="OUTPATIENT":"ROUTINE",1:PRIORITY)
I PRIORITY'="" D ; convert to HL7 priority
. N URGENCY
. S URGENCY=$$FIND1^DIC(101.42,,"B",PRIORITY)
. S PRIORITY=$S(URGENCY:$$GET1^DIQ(101.42,URGENCY,2,"E"),1:"")
. Q
D SET^HLOAPI(.ORCSEG,PRIORITY,7,6) ; ORC-7 priority
; ORC-8 not used
D SET^HLOAPI(.ORCSEG,$$FMTHL7^XLFDT(FMDATETM),9) ; ORC-9 date/time of transaction
S ORDERENTERER=$$GET1^DIQ(100,ORDERNUMBER,3,"I") ; Order file - who entered
D NAME^MAGDHOW3(ORDERENTERER,10,.ORCSEG) ; ORC-10 entered by
; ORC-11 not used
S ORDERPLACER=$$GET1^DIQ(123,GMRCIEN,10,"I") ; sending provider
D NAME^MAGDHOW3(ORDERPLACER,12,.ORCSEG) ; ORC-12 ordering provider
S X=$$GET1^DIQ(200,ORDERENTERER,29) ; service/section
D SET^HLOAPI(.ORCSEG,X,13) ; ORC-13 enterer's location
D PHONE^MAGDHOW3(ORDERPLACER,14,.ORCSEG) ; ORC-14 call back phone number(s)
S X=$$GET1^DIQ(123,GMRCIEN,3,"I") ; date of request
D SET^HLOAPI(.ORCSEG,$$FMTHL7^XLFDT(X),15) ; ORC-15 order effective date/time
; ORC-16 not used
S X=$$GET1^DIQ(200,ORDERPLACER,29,"I") ; ordering provider's service/section
; entering organization (abbreviation, name, coding system)
D SET^HLOAPI(.ORCSEG,$$GET1^DIQ(49,X,1),17,1)
D SET^HLOAPI(.ORCSEG,$$GET1^DIQ(49,X,.01),17,2)
D SET^HLOAPI(.ORCSEG,"VISTA49",17,3)
;
M SAVEORCSEG=ORCSEG ; save some of the ORC fields for the OBR segment
S SUCCESS=$$ADDSEG^HLOAPI(.HLMSTATE,.ORCSEG,.ERROR)
I 'SUCCESS D
. N MSG,SUBJECT,VARIABLES
. S SUBJECT="VistA Imaging Clinical Specialty (CPRS) HL7 Generation"
. S MSG(1)="An error occurred in ORC^"_$T(+0)_" where the ADDSEG^HLOAPI invocation"
. S MSG(2)="for the ORC segment failed. The error message is as follows:"
. S MSG(3)=""""_SUCCESS_""""
. S VARIABLES("HLMSTATE")=""
. S VARIABLES("ORCSEG")=""
. S VARIABLES("ERROR")=""
. D ERROR^MAGDHOWA(SUBJECT,.MSG,.VARIABLES)
. Q
Q
;
NAME(IEN,FIELD,ORCSEG) ; return person's name in HL7 format
N DGNAME,I,X
S DGNAME("FILE")=200,DGNAME("IENS")=IEN,DGNAME("FIELD")=.01
S X=$$HLNAME^XLFNAME(.DGNAME,"","^")
D SET^HLOAPI(.ORCSEG,IEN,FIELD,1)
F I=1:1:$L(X,"^") D SET^HLOAPI(.ORCSEG,$P(X,"^",I),FIELD,I+1)
Q
;
PHONE(IEN,FIELD,SEGMENT) ; call back phone number(s)
N FNUMBER,EQTYPE,I,MAGOUT,MAGERR,NUMBER,USECODE,X,REP,J,VAIEN,J,NUM
I IEN="" Q ; P203 DAC - Quit if no order placer. Fixes P180 bug.
S REP=0 ; HL7 repetition
F I=1:1 S X=$T(PHONES+I) Q:"END"[$P(X,";;",2) D
. S FNUMBER=$P(X,";",4),USECODE=$P(X,";",5),EQTYPE=$P(X,";",6)
. S NUMBER=$$GET1^DIQ(200,IEN,FNUMBER)
. D PHONE1(.REP,FIELD,.SEGMENT,NUMBER,USECODE,EQTYPE)
. Q
;
; P231 DAC - Removed Visited from Phone Numbers - Phone numbers not used, can cause errors.
;
Q
;
PHONE1(REP,FIELD,SEGMENT,NUMBER,USECODE,EQTYPE) ; store phone info
I NUMBER'="" D
. S REP=REP+1
. D SET^HLOAPI(.SEGMENT,NUMBER,FIELD,1,1,REP)
. D SET^HLOAPI(.SEGMENT,USECODE,FIELD,2,1,REP)
. D SET^HLOAPI(.SEGMENT,EQTYPE,FIELD,3,1,REP)
. Q
Q
;
PHONES ;; field name ; field number ; HL7 Use Code ; HL7 Equipment Type
;;PHONE (HOME);.131;PRN;PH
;;OFFICE PHONE;.132;WPN;PH
;;PHONE #3;.133;WPN;PN
;;PHONE #4;.134;WPN;PN
;;COMMERCIAL PHONE;.135;WPN;PN
;;FAX NUMBER;.136;WPN;FX
;;VOICE PAGER;.137;WPN;BP
;;DIGITAL PAGER;.138;BPM;BP
;;END
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDHOW3 6074 printed Sep 23, 2025@19:36:19 Page 2
MAGDHOW3 ;WOIFO/PMK,DWM,DAC,GXT - Capture Consult/GMRC data ; Mar 12, 2020@14:08:32
+1 ;;3.0;IMAGING;**138,180,203,208,231**;Mar 19, 2002;Build 9
+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 ;
+18 ; Supported IA #2051 reference $$FIND1^DIC function call
+19 ; Supported IA #2056 reference $$GET1^DIQ function call
+20 ; Supported IA #2056 reference GETS^DIQ subroutine call
+21 ; Supported IA #4716 reference SET^HLOAPI and $$ADDSEG^HLOAPI calls
+22 ; Supported IA #10103 reference $$FMTHL7^XLFDT function call
+23 ; Supported IA #3065 reference $$HLNAME^XLFNAME function call
+24 ; Controlled IA #4110 to read REQUEST/CONSULTATION file (#123)
+25 ; Private IA #2698 to read URGENCY FILE (#101.42)
+26 ; Supported IA #10060 to read phone numbers from NEW PERSON file (#200)
+27 ;
ORC(HLMSTATE,GMRCIEN,SAVEORCSEG) ; build the ORC segment (see ORC^GMRCHL7)
+1 NEW ACNUMB,ERROR,ORCSEG,ORDERENTERER,ORDERNUMBER,ORDERPLACER,PRIORITY,SUCCESS,X
+2 DO SET^HLOAPI(.ORCSEG,"ORC",0)
+3 ; ORC-1 order control
DO SET^HLOAPI(.ORCSEG,ORCTRL,1)
+4 ; oe/rr file number
SET ORDERNUMBER=$$GET1^DIQ(123,GMRCIEN,.03,"I")
+5 ; D SET^HLOAPI(.ORCSEG,$$STATNUMB^MAGDFCNV()_"-OR-"_ORDERNUMBER,2) ; ORC-2 placer order number
+6 SET ACNUMB=$$GMRCACN^MAGDFCNV(GMRCIEN)
+7 ; ORC-2 placer order number (to be compatible with CP) P208 PMK 4/26/18
DO SET^HLOAPI(.ORCSEG,ACNUMB,2)
+8 ; ORC-3 filler order number
DO SET^HLOAPI(.ORCSEG,ACNUMB,3)
+9 ;
+10 ; ORC-5 order status
DO SET^HLOAPI(.ORCSEG,ORSTATUS,5)
+11 ; ORC-6 not used
+12 ;
+13 ; store date and time of scheduled appointment for order messages, not results
+14 IF MSGTYPE="ORM"
IF $DATA(APTSCHED("FM DATETIME"))
Begin DoDot:1
+15 ; ORC-7 start date/time
DO SET^HLOAPI(.ORCSEG,$$FMTHL7^XLFDT(APTSCHED("FM DATETIME")),7,4)
+16 QUIT
End DoDot:1
+17 ; urgency
SET PRIORITY=$$GET1^DIQ(123,GMRCIEN,5)
SET PRIORITY=$PIECE(PRIORITY," - ",2)
+18 SET PRIORITY=$SELECT(PRIORITY="EMERGENCY":"STAT",PRIORITY="NOW":"STAT",PRIORITY="OUTPATIENT":"ROUTINE",1:PRIORITY)
+19 ; convert to HL7 priority
IF PRIORITY'=""
Begin DoDot:1
+20 NEW URGENCY
+21 SET URGENCY=$$FIND1^DIC(101.42,,"B",PRIORITY)
+22 SET PRIORITY=$SELECT(URGENCY:$$GET1^DIQ(101.42,URGENCY,2,"E"),1:"")
+23 QUIT
End DoDot:1
+24 ; ORC-7 priority
DO SET^HLOAPI(.ORCSEG,PRIORITY,7,6)
+25 ; ORC-8 not used
+26 ; ORC-9 date/time of transaction
DO SET^HLOAPI(.ORCSEG,$$FMTHL7^XLFDT(FMDATETM),9)
+27 ; Order file - who entered
SET ORDERENTERER=$$GET1^DIQ(100,ORDERNUMBER,3,"I")
+28 ; ORC-10 entered by
DO NAME^MAGDHOW3(ORDERENTERER,10,.ORCSEG)
+29 ; ORC-11 not used
+30 ; sending provider
SET ORDERPLACER=$$GET1^DIQ(123,GMRCIEN,10,"I")
+31 ; ORC-12 ordering provider
DO NAME^MAGDHOW3(ORDERPLACER,12,.ORCSEG)
+32 ; service/section
SET X=$$GET1^DIQ(200,ORDERENTERER,29)
+33 ; ORC-13 enterer's location
DO SET^HLOAPI(.ORCSEG,X,13)
+34 ; ORC-14 call back phone number(s)
DO PHONE^MAGDHOW3(ORDERPLACER,14,.ORCSEG)
+35 ; date of request
SET X=$$GET1^DIQ(123,GMRCIEN,3,"I")
+36 ; ORC-15 order effective date/time
DO SET^HLOAPI(.ORCSEG,$$FMTHL7^XLFDT(X),15)
+37 ; ORC-16 not used
+38 ; ordering provider's service/section
SET X=$$GET1^DIQ(200,ORDERPLACER,29,"I")
+39 ; entering organization (abbreviation, name, coding system)
+40 DO SET^HLOAPI(.ORCSEG,$$GET1^DIQ(49,X,1),17,1)
+41 DO SET^HLOAPI(.ORCSEG,$$GET1^DIQ(49,X,.01),17,2)
+42 DO SET^HLOAPI(.ORCSEG,"VISTA49",17,3)
+43 ;
+44 ; save some of the ORC fields for the OBR segment
MERGE SAVEORCSEG=ORCSEG
+45 SET SUCCESS=$$ADDSEG^HLOAPI(.HLMSTATE,.ORCSEG,.ERROR)
+46 IF 'SUCCESS
Begin DoDot:1
+47 NEW MSG,SUBJECT,VARIABLES
+48 SET SUBJECT="VistA Imaging Clinical Specialty (CPRS) HL7 Generation"
+49 SET MSG(1)="An error occurred in ORC^"_$TEXT(+0)_" where the ADDSEG^HLOAPI invocation"
+50 SET MSG(2)="for the ORC segment failed. The error message is as follows:"
+51 SET MSG(3)=""""_SUCCESS_""""
+52 SET VARIABLES("HLMSTATE")=""
+53 SET VARIABLES("ORCSEG")=""
+54 SET VARIABLES("ERROR")=""
+55 DO ERROR^MAGDHOWA(SUBJECT,.MSG,.VARIABLES)
+56 QUIT
End DoDot:1
+57 QUIT
+58 ;
NAME(IEN,FIELD,ORCSEG) ; return person's name in HL7 format
+1 NEW DGNAME,I,X
+2 SET DGNAME("FILE")=200
SET DGNAME("IENS")=IEN
SET DGNAME("FIELD")=.01
+3 SET X=$$HLNAME^XLFNAME(.DGNAME,"","^")
+4 DO SET^HLOAPI(.ORCSEG,IEN,FIELD,1)
+5 FOR I=1:1:$LENGTH(X,"^")
DO SET^HLOAPI(.ORCSEG,$PIECE(X,"^",I),FIELD,I+1)
+6 QUIT
+7 ;
PHONE(IEN,FIELD,SEGMENT) ; call back phone number(s)
+1 NEW FNUMBER,EQTYPE,I,MAGOUT,MAGERR,NUMBER,USECODE,X,REP,J,VAIEN,J,NUM
+2 ; P203 DAC - Quit if no order placer. Fixes P180 bug.
IF IEN=""
QUIT
+3 ; HL7 repetition
SET REP=0
+4 FOR I=1:1
SET X=$TEXT(PHONES+I)
if "END"[$PIECE(X,";;",2)
QUIT
Begin DoDot:1
+5 SET FNUMBER=$PIECE(X,";",4)
SET USECODE=$PIECE(X,";",5)
SET EQTYPE=$PIECE(X,";",6)
+6 SET NUMBER=$$GET1^DIQ(200,IEN,FNUMBER)
+7 DO PHONE1(.REP,FIELD,.SEGMENT,NUMBER,USECODE,EQTYPE)
+8 QUIT
End DoDot:1
+9 ;
+10 ; P231 DAC - Removed Visited from Phone Numbers - Phone numbers not used, can cause errors.
+11 ;
+12 QUIT
+13 ;
PHONE1(REP,FIELD,SEGMENT,NUMBER,USECODE,EQTYPE) ; store phone info
+1 IF NUMBER'=""
Begin DoDot:1
+2 SET REP=REP+1
+3 DO SET^HLOAPI(.SEGMENT,NUMBER,FIELD,1,1,REP)
+4 DO SET^HLOAPI(.SEGMENT,USECODE,FIELD,2,1,REP)
+5 DO SET^HLOAPI(.SEGMENT,EQTYPE,FIELD,3,1,REP)
+6 QUIT
End DoDot:1
+7 QUIT
+8 ;
PHONES ;; field name ; field number ; HL7 Use Code ; HL7 Equipment Type
+1 ;;PHONE (HOME);.131;PRN;PH
+2 ;;OFFICE PHONE;.132;WPN;PH
+3 ;;PHONE #3;.133;WPN;PN
+4 ;;PHONE #4;.134;WPN;PN
+5 ;;COMMERCIAL PHONE;.135;WPN;PN
+6 ;;FAX NUMBER;.136;WPN;FX
+7 ;;VOICE PAGER;.137;WPN;BP
+8 ;;DIGITAL PAGER;.138;BPM;BP
+9 ;;END
+10 ;
