MAGDRPCE ;WOIFO/PMK - Imaging RPCs ; Dec 06, 2021@10:54:46
;;3.0;IMAGING;**305**;Mar 19, 2002;Build 3
;; 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
;
; Called by SERVICES^MAGDIWBG to get the DICOM-enabled consult services
;
SERVICES(OUT) ; RPC = MAG DICOM GET CON SERVICES
N ALPHA,NOUT,SERVICE,SERVICENAME
K OUT
S SERVICE="" ; alpha sort services
F S SERVICE=$O(^MAG(2006.5831,"B",SERVICE)) Q:'SERVICE D
. S SERVICENAME=$$GET1^DIQ(123.5,SERVICE,.01,"E")
. S ALPHA(SERVICENAME)=SERVICE
. Q
S SERVICENAME="" ; put sorted services into OUT
F NOUT=1:1 S SERVICENAME=$O(ALPHA(SERVICENAME)) Q:SERVICENAME="" D
. S SERVICE=ALPHA(SERVICENAME)
. S OUT(NOUT)=SERVICENAME_"^"_SERVICE
. Q
I '$D(OUT(1)) S OUT(1)=NOUT-1 ; allow error messages to be passed back in OUT(1)
Q
;
GMRCDATE(OUT,SORTORDER,SERVICE,STATUS,DATE,GMRCIEN) ; RPC = MAG DICOM GET CON BY DATE
N DIRECTION,SERVICES
K OUT
I '$D(SORTORDER) S OUT="-1,SORTORDER required" Q
I SORTORDER="ASCENDING" S DIRECTION=1
E I SORTORDER="DESCENDING" S DIRECTION=-1
E S OUT="-2,SORTORDER must be either ASCENDING or DESCENDING, not """_SORTORDER_"""" Q
I '$D(SERVICE) S OUT="-3,SERVICE required" Q
; STATUS=2 for COMPLETE, 5=PENDING, 6=ACTIVE, 8=SCHEDULED, STATUS=9 for PARTIAL RESULTS
I '$D(STATUS) S OUT="-4,STATUS (2, 5, 6, 8 or 9) required" Q
I STATUS'=2,STATUS'=5,STATUS'=6,STATUS'=8,STATUS'=9 D Q
. S OUT="-5,STATUS (2, 5, 6, 8 or 9) required, not """_STATUS_""""
. Q
I '$D(DATE) S OUT="-6,DATE required (may be null)" Q
I DATE S DATE=$$DATEGMRC(DATE) ; convert to reverse date
I '$D(GMRCIEN) D Q
. S DATE=$O(^GMR(123,"AE",SERVICE,STATUS,DATE),-DIRECTION) ; reverse date
. S OUT=$$DATEGMRC(DATE) ; convert back to regular Fileman date
. Q
F S GMRCIEN=$O(^GMR(123,"AE",SERVICE,STATUS,DATE,GMRCIEN)) Q:GMRCIEN="" D Q:OUT ; normal direction
. S SERVICES(SERVICE)=1
. S OUT=$$CHKIMAGE(GMRCIEN,.SERVICES) ; only return consults with images
. Q
S OUT=GMRCIEN
Q
;
GMRCPAT(OUT,SORTORDER,DFN,DATE,GMRCIEN,SERVICES) ; RPC = MAG DICOM GET CON BY PATIENT
N DIRECTION
K OUT
I '$D(SORTORDER) S OUT="-1,SORTORDER required" Q
I SORTORDER="ASCENDING" S DIRECTION=1
E I SORTORDER="DESCENDING" S DIRECTION=-1
E S OUT="-2,SORTORDER must be either ASCENDING or DESCENDING, not """_SORTORDER_"""" Q
I '$G(DFN) S OUT="-3,DFN required and may not be null" Q
I '$D(DATE) S OUT="-4,DATE required and may not be null" Q
;
I DATE=0 S DATE=""
E S DATE=$$DATEGMRC(DATE) ; convert to reverse date
;
I '$D(GMRCIEN) D ; $O DATE
. S OUT=$O(^GMR(123,"AD",DFN,DATE),-DIRECTION) ; reverse date
. I OUT S OUT=$$DATEGMRC(OUT) ; convert back to regular Fileman date
. Q
E D ; $O GMRCIEN to find next consult for the service for this patient
. N HIT,TOSERVICE
. I '$D(SERVICES) S OUT="-4,SERVICES is required" Q
. I GMRCIEN=0 S GMRCIEN=""
. S HIT=0
. F S GMRCIEN=$O(^GMR(123,"AD",DFN,DATE,GMRCIEN),DIRECTION) Q:'GMRCIEN D Q:HIT
. . S TOSERVICE=$$GET1^DIQ(123,GMRCIEN,1,"I")
. . I $D(SERVICES(+TOSERVICE)) S HIT=1 ; found a consult for a requested TO SERVICE
. . S HIT=$$CHKIMAGE(GMRCIEN,.SERVICES)
. . Q
. S OUT=GMRCIEN
. Q
Q
;
GMRCIEN(OUT,DIRECTION,GMRCIEN,SERVICES) ; RPC = MAG DICOM GET CON BY GMRCIEN
K OUT
I '$D(DIRECTION) S OUT="-1,DIRECTION required" Q
I DIRECTION="ASCENDING" S DIRECTION=1
E I DIRECTION="DESCENDING" S DIRECTION=-1
E S OUT="-2,DIRECTION must be either ASCENDING or DESCENDING, not """_DIRECTION_"""" Q
I '$D(GMRCIEN) S OUT="-3,GMRCIEN is required (may be null)" Q
I '$D(SERVICES) S OUT="-4,SERVICES is required" Q
; find the next consult/procedure for the services
S OUT=0
F S GMRCIEN=$O(^GMR(123,GMRCIEN),DIRECTION) Q:'GMRCIEN D Q:OUT
. S OUT=$$CHKIMAGE(GMRCIEN,.SERVICES)
. Q
Q
;
DATEGMRC(GMRCDATE) ; convert a GMRC date to a FM date and vice versa
Q 9999999.999999-GMRCDATE ; unlike radiology which uses 9999999.9999
;
CHKIMAGE(GMRCIEN,SERVICES) ; check to see if there are images
N HIT,STATUS,TIUIEN,TOSERVICE
S HIT=0
;
; STATUS=2 for COMPLETE, 5=PENDING, 6=ACTIVE, 8=SCHEDULED, STATUS=9 for PARTIAL RESULTS
S STATUS=$$GET1^DIQ(123,GMRCIEN,8,"I")
I STATUS'=2,STATUS'=5,STATUS'=6,STATUS'=8,STATUS'=9 Q HIT
;
S TOSERVICE=$$GET1^DIQ(123,GMRCIEN,1,"I")
I $D(SERVICES(+TOSERVICE)) D ; consult has a requested TO SERVICE
. ; images can be assocated with the TIU External Data file (#8925.91),
. ; or DICOM GMRC TEMP LIST file (#2006.5839), or stored in the new
. ; SOP Class database IMAGE STUDY file (#2005.62) -- check all three
. S TIUIEN=$$GET1^DIQ(123,GMRCIEN,16,"I")
. I TIUIEN,$D(^TIU(8925.91,"B",TIUIEN)) S HIT=GMRCIEN
. I $D(^MAG(2006.5839,"C",123,GMRCIEN)) S HIT=GMRCIEN
. I $D(^MAGV(2005.62,"D",$$GMRCACN^MAGDFCNV(GMRCIEN))) S HIT=GMRCIEN
Q HIT
;
GMRCDATA(OUT,GMRCIEN,FIELD,FORMAT) ; RPC = MAG DICOM GET CON DATA
I '$D(GMRCIEN) S OUT="-1,GMRCIEN required" Q
I '$D(FIELD) S OUT="-2,FIELD required" Q
I $G(FORMAT)="" S FORMAT="E"
S OUT=$$GET1^DIQ(123,GMRCIEN,FIELD,FORMAT)
Q
;
;
GMRCMAG(OUT,GMRCIEN) ; RPC = MAG DICOM GET CON IMAGES
; return the image groups, if there are any
N I,MAG20065839IEN,MAGIEN,TIU892591IEN,MAG20065839ZERO,TIU892591ZERO,TIUIEN,RETURN
K OUT S I=1
S TIUIEN=$$GET1^DIQ(123,GMRCIEN,16,"I")
I TIUIEN,$D(^TIU(8925.91,"B",TIUIEN)) D
. S TIU892591IEN=""
. F S TIU892591IEN=$O(^TIU(8925.91,"B",TIUIEN,TIU892591IEN)) Q:TIU892591IEN="" D
. . S TIU892591ZERO=$G(^TIU(8925.91,TIU892591IEN,0))
. . S MAGIEN=$P(TIU892591ZERO,"^",2)
. . S I=I+1,OUT(I)=MAGIEN
. . Q
. Q
I $D(^MAG(2006.5839,"C",123,GMRCIEN)) D
. S MAG20065839IEN=""
. F S MAG20065839IEN=$O(^MAG(2006.5839,"C",123,GMRCIEN,MAG20065839IEN)) Q:MAG20065839IEN="" D
. . S MAG20065839ZERO=$G(^MAG(2006.5839,MAG20065839IEN,0))
. . S MAGIEN=$P(MAG20065839ZERO,"^",3)
. . S I=I+1,OUT(I)=MAGIEN
. . Q
. Q
I $D(^MAGV(2005.62,"D",$$GMRCACN^MAGDFCNV(GMRCIEN))) D
. S I=I+1,OUT(I)="New SOP Class DB"
. Q
S OUT(1)=I-1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDRPCE 6991 printed Sep 23, 2025@19:37:45 Page 2
MAGDRPCE ;WOIFO/PMK - Imaging RPCs ; Dec 06, 2021@10:54:46
+1 ;;3.0;IMAGING;**305**;Mar 19, 2002;Build 3
+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 ;
+19 ; Called by SERVICES^MAGDIWBG to get the DICOM-enabled consult services
+20 ;
SERVICES(OUT) ; RPC = MAG DICOM GET CON SERVICES
+1 NEW ALPHA,NOUT,SERVICE,SERVICENAME
+2 KILL OUT
+3 ; alpha sort services
SET SERVICE=""
+4 FOR
SET SERVICE=$ORDER(^MAG(2006.5831,"B",SERVICE))
if 'SERVICE
QUIT
Begin DoDot:1
+5 SET SERVICENAME=$$GET1^DIQ(123.5,SERVICE,.01,"E")
+6 SET ALPHA(SERVICENAME)=SERVICE
+7 QUIT
End DoDot:1
+8 ; put sorted services into OUT
SET SERVICENAME=""
+9 FOR NOUT=1:1
SET SERVICENAME=$ORDER(ALPHA(SERVICENAME))
if SERVICENAME=""
QUIT
Begin DoDot:1
+10 SET SERVICE=ALPHA(SERVICENAME)
+11 SET OUT(NOUT)=SERVICENAME_"^"_SERVICE
+12 QUIT
End DoDot:1
+13 ; allow error messages to be passed back in OUT(1)
IF '$DATA(OUT(1))
SET OUT(1)=NOUT-1
+14 QUIT
+15 ;
GMRCDATE(OUT,SORTORDER,SERVICE,STATUS,DATE,GMRCIEN) ; RPC = MAG DICOM GET CON BY DATE
+1 NEW DIRECTION,SERVICES
+2 KILL OUT
+3 IF '$DATA(SORTORDER)
SET OUT="-1,SORTORDER required"
QUIT
+4 IF SORTORDER="ASCENDING"
SET DIRECTION=1
+5 IF '$TEST
IF SORTORDER="DESCENDING"
SET DIRECTION=-1
+6 IF '$TEST
SET OUT="-2,SORTORDER must be either ASCENDING or DESCENDING, not """_SORTORDER_""""
QUIT
+7 IF '$DATA(SERVICE)
SET OUT="-3,SERVICE required"
QUIT
+8 ; STATUS=2 for COMPLETE, 5=PENDING, 6=ACTIVE, 8=SCHEDULED, STATUS=9 for PARTIAL RESULTS
+9 IF '$DATA(STATUS)
SET OUT="-4,STATUS (2, 5, 6, 8 or 9) required"
QUIT
+10 IF STATUS'=2
IF STATUS'=5
IF STATUS'=6
IF STATUS'=8
IF STATUS'=9
Begin DoDot:1
+11 SET OUT="-5,STATUS (2, 5, 6, 8 or 9) required, not """_STATUS_""""
+12 QUIT
End DoDot:1
QUIT
+13 IF '$DATA(DATE)
SET OUT="-6,DATE required (may be null)"
QUIT
+14 ; convert to reverse date
IF DATE
SET DATE=$$DATEGMRC(DATE)
+15 IF '$DATA(GMRCIEN)
Begin DoDot:1
+16 ; reverse date
SET DATE=$ORDER(^GMR(123,"AE",SERVICE,STATUS,DATE),-DIRECTION)
+17 ; convert back to regular Fileman date
SET OUT=$$DATEGMRC(DATE)
+18 QUIT
End DoDot:1
QUIT
+19 ; normal direction
FOR
SET GMRCIEN=$ORDER(^GMR(123,"AE",SERVICE,STATUS,DATE,GMRCIEN))
if GMRCIEN=""
QUIT
Begin DoDot:1
+20 SET SERVICES(SERVICE)=1
+21 ; only return consults with images
SET OUT=$$CHKIMAGE(GMRCIEN,.SERVICES)
+22 QUIT
End DoDot:1
if OUT
QUIT
+23 SET OUT=GMRCIEN
+24 QUIT
+25 ;
GMRCPAT(OUT,SORTORDER,DFN,DATE,GMRCIEN,SERVICES) ; RPC = MAG DICOM GET CON BY PATIENT
+1 NEW DIRECTION
+2 KILL OUT
+3 IF '$DATA(SORTORDER)
SET OUT="-1,SORTORDER required"
QUIT
+4 IF SORTORDER="ASCENDING"
SET DIRECTION=1
+5 IF '$TEST
IF SORTORDER="DESCENDING"
SET DIRECTION=-1
+6 IF '$TEST
SET OUT="-2,SORTORDER must be either ASCENDING or DESCENDING, not """_SORTORDER_""""
QUIT
+7 IF '$GET(DFN)
SET OUT="-3,DFN required and may not be null"
QUIT
+8 IF '$DATA(DATE)
SET OUT="-4,DATE required and may not be null"
QUIT
+9 ;
+10 IF DATE=0
SET DATE=""
+11 ; convert to reverse date
IF '$TEST
SET DATE=$$DATEGMRC(DATE)
+12 ;
+13 ; $O DATE
IF '$DATA(GMRCIEN)
Begin DoDot:1
+14 ; reverse date
SET OUT=$ORDER(^GMR(123,"AD",DFN,DATE),-DIRECTION)
+15 ; convert back to regular Fileman date
IF OUT
SET OUT=$$DATEGMRC(OUT)
+16 QUIT
End DoDot:1
+17 ; $O GMRCIEN to find next consult for the service for this patient
IF '$TEST
Begin DoDot:1
+18 NEW HIT,TOSERVICE
+19 IF '$DATA(SERVICES)
SET OUT="-4,SERVICES is required"
QUIT
+20 IF GMRCIEN=0
SET GMRCIEN=""
+21 SET HIT=0
+22 FOR
SET GMRCIEN=$ORDER(^GMR(123,"AD",DFN,DATE,GMRCIEN),DIRECTION)
if 'GMRCIEN
QUIT
Begin DoDot:2
+23 SET TOSERVICE=$$GET1^DIQ(123,GMRCIEN,1,"I")
+24 ; found a consult for a requested TO SERVICE
IF $DATA(SERVICES(+TOSERVICE))
SET HIT=1
+25 SET HIT=$$CHKIMAGE(GMRCIEN,.SERVICES)
+26 QUIT
End DoDot:2
if HIT
QUIT
+27 SET OUT=GMRCIEN
+28 QUIT
End DoDot:1
+29 QUIT
+30 ;
GMRCIEN(OUT,DIRECTION,GMRCIEN,SERVICES) ; RPC = MAG DICOM GET CON BY GMRCIEN
+1 KILL OUT
+2 IF '$DATA(DIRECTION)
SET OUT="-1,DIRECTION required"
QUIT
+3 IF DIRECTION="ASCENDING"
SET DIRECTION=1
+4 IF '$TEST
IF DIRECTION="DESCENDING"
SET DIRECTION=-1
+5 IF '$TEST
SET OUT="-2,DIRECTION must be either ASCENDING or DESCENDING, not """_DIRECTION_""""
QUIT
+6 IF '$DATA(GMRCIEN)
SET OUT="-3,GMRCIEN is required (may be null)"
QUIT
+7 IF '$DATA(SERVICES)
SET OUT="-4,SERVICES is required"
QUIT
+8 ; find the next consult/procedure for the services
+9 SET OUT=0
+10 FOR
SET GMRCIEN=$ORDER(^GMR(123,GMRCIEN),DIRECTION)
if 'GMRCIEN
QUIT
Begin DoDot:1
+11 SET OUT=$$CHKIMAGE(GMRCIEN,.SERVICES)
+12 QUIT
End DoDot:1
if OUT
QUIT
+13 QUIT
+14 ;
DATEGMRC(GMRCDATE) ; convert a GMRC date to a FM date and vice versa
+1 ; unlike radiology which uses 9999999.9999
QUIT 9999999.999999-GMRCDATE
+2 ;
CHKIMAGE(GMRCIEN,SERVICES) ; check to see if there are images
+1 NEW HIT,STATUS,TIUIEN,TOSERVICE
+2 SET HIT=0
+3 ;
+4 ; STATUS=2 for COMPLETE, 5=PENDING, 6=ACTIVE, 8=SCHEDULED, STATUS=9 for PARTIAL RESULTS
+5 SET STATUS=$$GET1^DIQ(123,GMRCIEN,8,"I")
+6 IF STATUS'=2
IF STATUS'=5
IF STATUS'=6
IF STATUS'=8
IF STATUS'=9
QUIT HIT
+7 ;
+8 SET TOSERVICE=$$GET1^DIQ(123,GMRCIEN,1,"I")
+9 ; consult has a requested TO SERVICE
IF $DATA(SERVICES(+TOSERVICE))
Begin DoDot:1
+10 ; images can be assocated with the TIU External Data file (#8925.91),
+11 ; or DICOM GMRC TEMP LIST file (#2006.5839), or stored in the new
+12 ; SOP Class database IMAGE STUDY file (#2005.62) -- check all three
+13 SET TIUIEN=$$GET1^DIQ(123,GMRCIEN,16,"I")
+14 IF TIUIEN
IF $DATA(^TIU(8925.91,"B",TIUIEN))
SET HIT=GMRCIEN
+15 IF $DATA(^MAG(2006.5839,"C",123,GMRCIEN))
SET HIT=GMRCIEN
+16 IF $DATA(^MAGV(2005.62,"D",$$GMRCACN^MAGDFCNV(GMRCIEN)))
SET HIT=GMRCIEN
End DoDot:1
+17 QUIT HIT
+18 ;
GMRCDATA(OUT,GMRCIEN,FIELD,FORMAT) ; RPC = MAG DICOM GET CON DATA
+1 IF '$DATA(GMRCIEN)
SET OUT="-1,GMRCIEN required"
QUIT
+2 IF '$DATA(FIELD)
SET OUT="-2,FIELD required"
QUIT
+3 IF $GET(FORMAT)=""
SET FORMAT="E"
+4 SET OUT=$$GET1^DIQ(123,GMRCIEN,FIELD,FORMAT)
+5 QUIT
+6 ;
+7 ;
GMRCMAG(OUT,GMRCIEN) ; RPC = MAG DICOM GET CON IMAGES
+1 ; return the image groups, if there are any
+2 NEW I,MAG20065839IEN,MAGIEN,TIU892591IEN,MAG20065839ZERO,TIU892591ZERO,TIUIEN,RETURN
+3 KILL OUT
SET I=1
+4 SET TIUIEN=$$GET1^DIQ(123,GMRCIEN,16,"I")
+5 IF TIUIEN
IF $DATA(^TIU(8925.91,"B",TIUIEN))
Begin DoDot:1
+6 SET TIU892591IEN=""
+7 FOR
SET TIU892591IEN=$ORDER(^TIU(8925.91,"B",TIUIEN,TIU892591IEN))
if TIU892591IEN=""
QUIT
Begin DoDot:2
+8 SET TIU892591ZERO=$GET(^TIU(8925.91,TIU892591IEN,0))
+9 SET MAGIEN=$PIECE(TIU892591ZERO,"^",2)
+10 SET I=I+1
SET OUT(I)=MAGIEN
+11 QUIT
End DoDot:2
+12 QUIT
End DoDot:1
+13 IF $DATA(^MAG(2006.5839,"C",123,GMRCIEN))
Begin DoDot:1
+14 SET MAG20065839IEN=""
+15 FOR
SET MAG20065839IEN=$ORDER(^MAG(2006.5839,"C",123,GMRCIEN,MAG20065839IEN))
if MAG20065839IEN=""
QUIT
Begin DoDot:2
+16 SET MAG20065839ZERO=$GET(^MAG(2006.5839,MAG20065839IEN,0))
+17 SET MAGIEN=$PIECE(MAG20065839ZERO,"^",3)
+18 SET I=I+1
SET OUT(I)=MAGIEN
+19 QUIT
End DoDot:2
+20 QUIT
End DoDot:1
+21 IF $DATA(^MAGV(2005.62,"D",$$GMRCACN^MAGDFCNV(GMRCIEN)))
Begin DoDot:1
+22 SET I=I+1
SET OUT(I)="New SOP Class DB"
+23 QUIT
End DoDot:1
+24 SET OUT(1)=I-1
+25 QUIT
