MAGDHOW5 ;WOIFO/PMK - Capture Consult/GMRC data ; 12 Mar 2013 7:09 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. |
;; +---------------------------------------------------------------+
;;
;
;
ZDS(HLMSTATE,GMRCIEN) ; build the ZDS segment
N STUDYUID,SUCCESS,ZDSSEG
S STUDYUID=^MAGD(2006.15,1,"UID ROOT")_".1.4."_$$STATNUMB^MAGDFCNV()_".1."_GMRCIEN
D SET^HLOAPI(.ZDSSEG,"ZDS",0)
D SET^HLOAPI(.ZDSSEG,STUDYUID,1,1)
D SET^HLOAPI(.ZDSSEG,"VISTA",1,2)
D SET^HLOAPI(.ZDSSEG,"Application",1,3)
D SET^HLOAPI(.ZDSSEG,"DICOM",1,4)
S SUCCESS=$$ADDSEG^HLOAPI(.HLMSTATE,.ZDSSEG,.ERROR)
I 'SUCCESS D
. N MSG,SUBJECT,VARIABLES
. S SUBJECT="VistA Imaging Clinical Specialty (CPRS) HL7 Generation"
. S MSG(1)="An error occurred in "_$T(+0)_" where the ADDSEG^HLOAPI invocation"
. S MSG(2)="for the ZDS segment failed. The error message is as follows:"
. S MSG(3)=""""_SUCCESS_""""
. S VARIABLES("HLMSTATE")=""
. S VARIABLES("ZDSSEG")=""
. S VARIABLES("ERROR")=""
. D ERROR^MAGDHOWA(SUBJECT,.MSG,.VARIABLES)
. Q
Q
;
OBX(HLMSTATE,GMRCIEN) ; build one or more OBX segments (see OBX^GMRCHL72)
N CODE,I,MEANING,OBXSEG,OBXSEGNO,VALUE,VALUETYPE
S OBXSEGNO=0
;
; output reason for request
S I=0 F S I=$O(^GMR(123,GMRCIEN,20,I)) Q:'I S VALUE=$G(^(I,0)) D
. D OUTPUT("TX","RFR","REASON FOR REQUEST",VALUE,"F",.ERROR)
. Q
;
; output provisional diagnosis
S VALUE=$$GET1^DIQ(123,GMRCIEN,30)
S CODE=$$GET1^DIQ(123,GMRCIEN,30.1)
I VALUE'="" D
. I CODE'="" D ; send using the coded element format
. . S VALUETYPE="CE"
. . S VALUE("Identifier")=CODE
. . S VALUE("Text")=$P(VALUE,(" ("_CODE))
. . S VALUE("Name of Coding System")="I9" ; ICD-9
. . Q
. E S VALUETYPE="TX" ; send using the free text format
. D OUTPUT(VALUETYPE,"PDX","PROVISIONAL DIAGNOSIS",.VALUE,"F",.ERROR)
. K VALUE
. Q
;
; output tech comment - ORCOM is defined by CPRS Consult Request Tracking
S I=0 F S I=$O(ORCOM(I)) Q:'I S VALUE=ORCOM(I) D
. D OUTPUT("TX","TCM","TECH COMMENT",VALUE,"F",.ERROR)
. Q
;
; output significant finding flag
S VALUE=$$GET1^DIQ(123,GMRCIEN,15)
I VALUE'="" D
. D OUTPUT("TX","SF","SIGNIFICANT FINDINGS",VALUE,"F",.ERROR)
. Q
;
; output allergies, if any
D ALLERGY
;
; output posting, if any
D POSTINGS
;
; output results
I MSGTYPE="ORU" D RESULTS
;
Q
;
RESULTS ; output results
N DASH,I,J,VALUE,STATUS,TITLE,TIUIEN,TIUTEXT,X,Y
S $E(DASH,80)=" ",DASH=$TR(DASH," ","-") ; 80 dashes
S STATUS=$S(ORSTATUS="CM":"F",1:"R")
S I=0 F S I=$O(@TIUDOC@(I)) Q:'I S X=@TIUDOC@(I) D
. N I
. S TIUIEN=$P(X,"^",1),TITLE=$P(X,"^",2)
. I TITLE?1"Addendum".E Q
. D RESULT1(DASH,STATUS)
. D TGET^TIUSRVR1(.TIUTEXT,TIUIEN)
. S J=0 F S J=$O(@TIUTEXT@(J)) Q:'J D
. . S VALUE=@TIUTEXT@(J)
. . D RESULT1(VALUE,STATUS)
. . Q
. Q
D RESULT1(DASH,STATUS)
Q
;
RESULT1(VALUE,STATUS) ; output one line of text
D OUTPUT("TX","R","REPORT",VALUE,STATUS,.ERROR)
Q
;
ALLERGY ; check to see if patient has any allergies
N GMRAL,I,VALUE
D EN1^GMRADPT
S I=0 F S I=$O(GMRAL(I)) Q:'I D ; include each allergy string as an HL7 OBX segment
. S VALUE=$P(GMRAL(I),"^",2)
. D OUTPUT("TX","A","ALLERGIES",VALUE,"F",.ERROR)
. Q
Q
;
POSTINGS ; check if the patient has any other postings
N I,HIT,MSG
D ENCOVER^TIUPP3(DFN) I MSG Q ; MSG="0^Patient posting found"
S (I,HIT)=0
F S I=$O(^TMP("TIUPPCV",$J,I)) Q:'I I $P(^(I),"^",2)'="A" S HIT=1 Q
I HIT D
. S VALUE="Please see CPRS for additional information about Postings."
. D OUTPUT("TX","PO","POSTINGS",VALUE,"F",.ERROR)
. Q
Q
;
;
;
OUTPUT(VALUETYPE,ID,MEANING,VALUE,STATUS,ERROR) ; output an OBX segment with one line of text
N SUCCESS
S OBXSEGNO=OBXSEGNO+1
D SET^HLOAPI(.OBXSEG,"OBX",0)
D SET^HLOAPI(.OBXSEG,OBXSEGNO,1)
D SET^HLOAPI(.OBXSEG,VALUETYPE,2)
D SET^HLOAPI(.OBXSEG,ID,3,1)
D SET^HLOAPI(.OBXSEG,MEANING,3,2)
D SET^HLOAPI(.OBXSEG,"L",3,3)
I VALUETYPE="CE",$D(VALUE)>=10 D ; coded element
. D SET^HLOAPI(.OBXSEG,VALUE("Identifier"),5,1)
. D SET^HLOAPI(.OBXSEG,VALUE("Text"),5,2)
. D SET^HLOAPI(.OBXSEG,VALUE("Name of Coding System"),5,3)
. Q
E D SET^HLOAPI(.OBXSEG,VALUE,5)
D SET^HLOAPI(.OBXSEG,STATUS,11)
S SUCCESS=$$ADDSEG^HLOAPI(.HLMSTATE,.OBXSEG,.ERROR)
I 'SUCCESS D
. N MSG,SUBJECT,VARIABLES
. S SUBJECT="VistA Imaging Clinical Specialty (CPRS) HL7 Generation"
. S MSG(1)="An error occurred in OUTPUT^"_$T(+0)_" where the ADDSEG^HLOAPI invocation"
. S MSG(2)="for the OBX segment for "_MEANING_" failed."
. S MSG(3)="The error message is as follows:"
. S MSG(4)=""""_SUCCESS_""""
. S VARIABLES("VALUETYPE")=""
. S VARIABLES("ID")=""
. S VARIABLES("MEANING")=""
. S VARIABLES("VALUE")=""
. S VARIABLES("STATUS")=""
. S VARIABLES("HLMSTATE")=""
. S VARIABLES("OBXSEG")=""
. S VARIABLES("ERROR")=""
. D ERROR^MAGDHOWA(SUBJECT,.MSG,.VARIABLES)
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDHOW5 5877 printed Sep 23, 2025@19:36:21 Page 2
MAGDHOW5 ;WOIFO/PMK - Capture Consult/GMRC data ; 12 Mar 2013 7:09 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 ;
+18 ;
ZDS(HLMSTATE,GMRCIEN) ; build the ZDS segment
+1 NEW STUDYUID,SUCCESS,ZDSSEG
+2 SET STUDYUID=^MAGD(2006.15,1,"UID ROOT")_".1.4."_$$STATNUMB^MAGDFCNV()_".1."_GMRCIEN
+3 DO SET^HLOAPI(.ZDSSEG,"ZDS",0)
+4 DO SET^HLOAPI(.ZDSSEG,STUDYUID,1,1)
+5 DO SET^HLOAPI(.ZDSSEG,"VISTA",1,2)
+6 DO SET^HLOAPI(.ZDSSEG,"Application",1,3)
+7 DO SET^HLOAPI(.ZDSSEG,"DICOM",1,4)
+8 SET SUCCESS=$$ADDSEG^HLOAPI(.HLMSTATE,.ZDSSEG,.ERROR)
+9 IF 'SUCCESS
Begin DoDot:1
+10 NEW MSG,SUBJECT,VARIABLES
+11 SET SUBJECT="VistA Imaging Clinical Specialty (CPRS) HL7 Generation"
+12 SET MSG(1)="An error occurred in "_$TEXT(+0)_" where the ADDSEG^HLOAPI invocation"
+13 SET MSG(2)="for the ZDS segment failed. The error message is as follows:"
+14 SET MSG(3)=""""_SUCCESS_""""
+15 SET VARIABLES("HLMSTATE")=""
+16 SET VARIABLES("ZDSSEG")=""
+17 SET VARIABLES("ERROR")=""
+18 DO ERROR^MAGDHOWA(SUBJECT,.MSG,.VARIABLES)
+19 QUIT
End DoDot:1
+20 QUIT
+21 ;
OBX(HLMSTATE,GMRCIEN) ; build one or more OBX segments (see OBX^GMRCHL72)
+1 NEW CODE,I,MEANING,OBXSEG,OBXSEGNO,VALUE,VALUETYPE
+2 SET OBXSEGNO=0
+3 ;
+4 ; output reason for request
+5 SET I=0
FOR
SET I=$ORDER(^GMR(123,GMRCIEN,20,I))
if 'I
QUIT
SET VALUE=$GET(^(I,0))
Begin DoDot:1
+6 DO OUTPUT("TX","RFR","REASON FOR REQUEST",VALUE,"F",.ERROR)
+7 QUIT
End DoDot:1
+8 ;
+9 ; output provisional diagnosis
+10 SET VALUE=$$GET1^DIQ(123,GMRCIEN,30)
+11 SET CODE=$$GET1^DIQ(123,GMRCIEN,30.1)
+12 IF VALUE'=""
Begin DoDot:1
+13 ; send using the coded element format
IF CODE'=""
Begin DoDot:2
+14 SET VALUETYPE="CE"
+15 SET VALUE("Identifier")=CODE
+16 SET VALUE("Text")=$PIECE(VALUE,(" ("_CODE))
+17 ; ICD-9
SET VALUE("Name of Coding System")="I9"
+18 QUIT
End DoDot:2
+19 ; send using the free text format
IF '$TEST
SET VALUETYPE="TX"
+20 DO OUTPUT(VALUETYPE,"PDX","PROVISIONAL DIAGNOSIS",.VALUE,"F",.ERROR)
+21 KILL VALUE
+22 QUIT
End DoDot:1
+23 ;
+24 ; output tech comment - ORCOM is defined by CPRS Consult Request Tracking
+25 SET I=0
FOR
SET I=$ORDER(ORCOM(I))
if 'I
QUIT
SET VALUE=ORCOM(I)
Begin DoDot:1
+26 DO OUTPUT("TX","TCM","TECH COMMENT",VALUE,"F",.ERROR)
+27 QUIT
End DoDot:1
+28 ;
+29 ; output significant finding flag
+30 SET VALUE=$$GET1^DIQ(123,GMRCIEN,15)
+31 IF VALUE'=""
Begin DoDot:1
+32 DO OUTPUT("TX","SF","SIGNIFICANT FINDINGS",VALUE,"F",.ERROR)
+33 QUIT
End DoDot:1
+34 ;
+35 ; output allergies, if any
+36 DO ALLERGY
+37 ;
+38 ; output posting, if any
+39 DO POSTINGS
+40 ;
+41 ; output results
+42 IF MSGTYPE="ORU"
DO RESULTS
+43 ;
+44 QUIT
+45 ;
RESULTS ; output results
+1 NEW DASH,I,J,VALUE,STATUS,TITLE,TIUIEN,TIUTEXT,X,Y
+2 ; 80 dashes
SET $EXTRACT(DASH,80)=" "
SET DASH=$TRANSLATE(DASH," ","-")
+3 SET STATUS=$SELECT(ORSTATUS="CM":"F",1:"R")
+4 SET I=0
FOR
SET I=$ORDER(@TIUDOC@(I))
if 'I
QUIT
SET X=@TIUDOC@(I)
Begin DoDot:1
+5 NEW I
+6 SET TIUIEN=$PIECE(X,"^",1)
SET TITLE=$PIECE(X,"^",2)
+7 IF TITLE?1"Addendum".E
QUIT
+8 DO RESULT1(DASH,STATUS)
+9 DO TGET^TIUSRVR1(.TIUTEXT,TIUIEN)
+10 SET J=0
FOR
SET J=$ORDER(@TIUTEXT@(J))
if 'J
QUIT
Begin DoDot:2
+11 SET VALUE=@TIUTEXT@(J)
+12 DO RESULT1(VALUE,STATUS)
+13 QUIT
End DoDot:2
+14 QUIT
End DoDot:1
+15 DO RESULT1(DASH,STATUS)
+16 QUIT
+17 ;
RESULT1(VALUE,STATUS) ; output one line of text
+1 DO OUTPUT("TX","R","REPORT",VALUE,STATUS,.ERROR)
+2 QUIT
+3 ;
ALLERGY ; check to see if patient has any allergies
+1 NEW GMRAL,I,VALUE
+2 DO EN1^GMRADPT
+3 ; include each allergy string as an HL7 OBX segment
SET I=0
FOR
SET I=$ORDER(GMRAL(I))
if 'I
QUIT
Begin DoDot:1
+4 SET VALUE=$PIECE(GMRAL(I),"^",2)
+5 DO OUTPUT("TX","A","ALLERGIES",VALUE,"F",.ERROR)
+6 QUIT
End DoDot:1
+7 QUIT
+8 ;
POSTINGS ; check if the patient has any other postings
+1 NEW I,HIT,MSG
+2 ; MSG="0^Patient posting found"
DO ENCOVER^TIUPP3(DFN)
IF MSG
QUIT
+3 SET (I,HIT)=0
+4 FOR
SET I=$ORDER(^TMP("TIUPPCV",$JOB,I))
if 'I
QUIT
IF $PIECE(^(I),"^",2)'="A"
SET HIT=1
QUIT
+5 IF HIT
Begin DoDot:1
+6 SET VALUE="Please see CPRS for additional information about Postings."
+7 DO OUTPUT("TX","PO","POSTINGS",VALUE,"F",.ERROR)
+8 QUIT
End DoDot:1
+9 QUIT
+10 ;
+11 ;
+12 ;
OUTPUT(VALUETYPE,ID,MEANING,VALUE,STATUS,ERROR) ; output an OBX segment with one line of text
+1 NEW SUCCESS
+2 SET OBXSEGNO=OBXSEGNO+1
+3 DO SET^HLOAPI(.OBXSEG,"OBX",0)
+4 DO SET^HLOAPI(.OBXSEG,OBXSEGNO,1)
+5 DO SET^HLOAPI(.OBXSEG,VALUETYPE,2)
+6 DO SET^HLOAPI(.OBXSEG,ID,3,1)
+7 DO SET^HLOAPI(.OBXSEG,MEANING,3,2)
+8 DO SET^HLOAPI(.OBXSEG,"L",3,3)
+9 ; coded element
IF VALUETYPE="CE"
IF $DATA(VALUE)>=10
Begin DoDot:1
+10 DO SET^HLOAPI(.OBXSEG,VALUE("Identifier"),5,1)
+11 DO SET^HLOAPI(.OBXSEG,VALUE("Text"),5,2)
+12 DO SET^HLOAPI(.OBXSEG,VALUE("Name of Coding System"),5,3)
+13 QUIT
End DoDot:1
+14 IF '$TEST
DO SET^HLOAPI(.OBXSEG,VALUE,5)
+15 DO SET^HLOAPI(.OBXSEG,STATUS,11)
+16 SET SUCCESS=$$ADDSEG^HLOAPI(.HLMSTATE,.OBXSEG,.ERROR)
+17 IF 'SUCCESS
Begin DoDot:1
+18 NEW MSG,SUBJECT,VARIABLES
+19 SET SUBJECT="VistA Imaging Clinical Specialty (CPRS) HL7 Generation"
+20 SET MSG(1)="An error occurred in OUTPUT^"_$TEXT(+0)_" where the ADDSEG^HLOAPI invocation"
+21 SET MSG(2)="for the OBX segment for "_MEANING_" failed."
+22 SET MSG(3)="The error message is as follows:"
+23 SET MSG(4)=""""_SUCCESS_""""
+24 SET VARIABLES("VALUETYPE")=""
+25 SET VARIABLES("ID")=""
+26 SET VARIABLES("MEANING")=""
+27 SET VARIABLES("VALUE")=""
+28 SET VARIABLES("STATUS")=""
+29 SET VARIABLES("HLMSTATE")=""
+30 SET VARIABLES("OBXSEG")=""
+31 SET VARIABLES("ERROR")=""
+32 DO ERROR^MAGDHOWA(SUBJECT,.MSG,.VARIABLES)
+33 QUIT
End DoDot:1
+34 QUIT
