Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MAGDRPCE

MAGDRPCE.m

Go to the documentation of this file. 
  1. MAGDRPCE ;WOIFO/PMK - Imaging RPCs ; Dec 06, 2021@10:54:46
  1.  ;;3.0;IMAGING;**305**;Mar 19, 2002;Build 3
  1.  ;; Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;; +---------------------------------------------------------------+
  1.  ;; | Property of the US Government.                                |
  1.  ;; | No permission to copy or redistribute this software is given. |
  1.  ;; | Use of unreleased versions of this software requires the user |
  1.  ;; | to execute a written test agreement with the VistA Imaging    |
  1.  ;; | Development Office of the Department of Veterans Affairs,     |
  1.  ;; | telephone (301) 734-0100.                                     |
  1.  ;; | The Food and Drug Administration classifies this software as  |
  1.  ;; | a medical device.  As such, it may not be changed in any way. |
  1.  ;; | Modifications to this software may result in an adulterated   |
  1.  ;; | medical device under 21CFR820, the use of which is considered |
  1.  ;; | to be a violation of US Federal Statutes.                     |
  1.  ;; +---------------------------------------------------------------+
  1.  ;;
  1.  Q
  1.  ;
  1.  ; Called by SERVICES^MAGDIWBG to get the DICOM-enabled consult services
  1.  ;
  1. SERVICES(OUT) ; RPC = MAG DICOM GET CON SERVICES
  1.  N ALPHA,NOUT,SERVICE,SERVICENAME
  1.  K OUT
  1.  S SERVICE="" ; alpha sort services
  1.  F  S SERVICE=$O(^MAG(2006.5831,"B",SERVICE)) Q:'SERVICE  D
  1.  . S SERVICENAME=$$GET1^DIQ(123.5,SERVICE,.01,"E")
  1.  . S ALPHA(SERVICENAME)=SERVICE
  1.  . Q
  1.  S SERVICENAME="" ; put sorted services into OUT
  1.  F NOUT=1:1 S SERVICENAME=$O(ALPHA(SERVICENAME)) Q:SERVICENAME=""  D
  1.  . S SERVICE=ALPHA(SERVICENAME)
  1.  . S OUT(NOUT)=SERVICENAME_"^"_SERVICE
  1.  . Q
  1.  I '$D(OUT(1)) S OUT(1)=NOUT-1 ; allow error messages to be passed back in OUT(1)
  1.  Q
  1.  ;
  1. GMRCDATE(OUT,SORTORDER,SERVICE,STATUS,DATE,GMRCIEN) ; RPC = MAG DICOM GET CON BY DATE
  1.  N DIRECTION,SERVICES
  1.  K OUT
  1.  I '$D(SORTORDER) S OUT="-1,SORTORDER required" Q
  1.  I SORTORDER="ASCENDING" S DIRECTION=1
  1.  E  I SORTORDER="DESCENDING" S DIRECTION=-1
  1.  E  S OUT="-2,SORTORDER must be either ASCENDING or DESCENDING, not """_SORTORDER_"""" Q
  1.  I '$D(SERVICE) S OUT="-3,SERVICE required" Q
  1.  ; STATUS=2 for COMPLETE, 5=PENDING, 6=ACTIVE, 8=SCHEDULED, STATUS=9 for PARTIAL RESULTS
  1.  I '$D(STATUS) S OUT="-4,STATUS (2, 5, 6, 8 or 9) required" Q
  1.  I STATUS'=2,STATUS'=5,STATUS'=6,STATUS'=8,STATUS'=9 D  Q
  1.  . S OUT="-5,STATUS (2, 5, 6, 8 or 9) required, not """_STATUS_""""
  1.  . Q 
  1.  I '$D(DATE) S OUT="-6,DATE required (may be null)" Q
  1.  I DATE S DATE=$$DATEGMRC(DATE) ; convert to reverse date
  1.  I '$D(GMRCIEN) D  Q
  1.  . S DATE=$O(^GMR(123,"AE",SERVICE,STATUS,DATE),-DIRECTION) ; reverse date
  1.  . S OUT=$$DATEGMRC(DATE) ; convert back to regular Fileman date
  1.  . Q
  1.  F  S GMRCIEN=$O(^GMR(123,"AE",SERVICE,STATUS,DATE,GMRCIEN)) Q:GMRCIEN=""  D  Q:OUT  ; normal direction
  1.  . S SERVICES(SERVICE)=1
  1.  . S OUT=$$CHKIMAGE(GMRCIEN,.SERVICES) ; only return consults with images
  1.  . Q
  1.  S OUT=GMRCIEN
  1.  Q
  1.  ;
  1. GMRCPAT(OUT,SORTORDER,DFN,DATE,GMRCIEN,SERVICES) ; RPC = MAG DICOM GET CON BY PATIENT
  1.  N DIRECTION
  1.  K OUT
  1.  I '$D(SORTORDER) S OUT="-1,SORTORDER required" Q
  1.  I SORTORDER="ASCENDING" S DIRECTION=1
  1.  E  I SORTORDER="DESCENDING" S DIRECTION=-1
  1.  E  S OUT="-2,SORTORDER must be either ASCENDING or DESCENDING, not """_SORTORDER_"""" Q
  1.  I '$G(DFN) S OUT="-3,DFN required and may not be null" Q
  1.  I '$D(DATE) S OUT="-4,DATE required and may not be null" Q
  1.  ;
  1.  I DATE=0 S DATE=""
  1.  E  S DATE=$$DATEGMRC(DATE) ; convert to reverse date
  1.  ;
  1.  I '$D(GMRCIEN) D  ; $O DATE
  1.  . S OUT=$O(^GMR(123,"AD",DFN,DATE),-DIRECTION) ; reverse date
  1.  . I OUT S OUT=$$DATEGMRC(OUT) ; convert back to regular Fileman date
  1.  . Q
  1.  E  D  ; $O GMRCIEN to find next consult for the service for this patient
  1.  . N HIT,TOSERVICE
  1.  . I '$D(SERVICES) S OUT="-4,SERVICES is required" Q
  1.  . I GMRCIEN=0 S GMRCIEN=""
  1.  . S HIT=0
  1.  . F  S GMRCIEN=$O(^GMR(123,"AD",DFN,DATE,GMRCIEN),DIRECTION) Q:'GMRCIEN  D  Q:HIT
  1.  . . S TOSERVICE=$$GET1^DIQ(123,GMRCIEN,1,"I")
  1.  . . I $D(SERVICES(+TOSERVICE)) S HIT=1 ; found a consult for a requested TO SERVICE
  1.  . . S HIT=$$CHKIMAGE(GMRCIEN,.SERVICES)
  1.  . . Q
  1.  . S OUT=GMRCIEN
  1.  . Q
  1.  Q
  1.  ;
  1. GMRCIEN(OUT,DIRECTION,GMRCIEN,SERVICES) ; RPC = MAG DICOM GET CON BY GMRCIEN
  1.  K OUT
  1.  I '$D(DIRECTION) S OUT="-1,DIRECTION required" Q
  1.  I DIRECTION="ASCENDING" S DIRECTION=1
  1.  E  I DIRECTION="DESCENDING" S DIRECTION=-1
  1.  E  S OUT="-2,DIRECTION must be either ASCENDING or DESCENDING, not """_DIRECTION_"""" Q
  1.  I '$D(GMRCIEN) S OUT="-3,GMRCIEN is required (may be null)" Q
  1.  I '$D(SERVICES) S OUT="-4,SERVICES is required" Q
  1.  ; find the next consult/procedure for the services
  1.  S OUT=0
  1.  F  S GMRCIEN=$O(^GMR(123,GMRCIEN),DIRECTION)  Q:'GMRCIEN  D  Q:OUT
  1.  . S OUT=$$CHKIMAGE(GMRCIEN,.SERVICES)
  1.  . Q
  1.  Q
  1.  ;
  1. DATEGMRC(GMRCDATE) ; convert a GMRC date to a FM date and vice versa
  1.  Q 9999999.999999-GMRCDATE ; unlike radiology which uses 9999999.9999
  1.  ;
  1. CHKIMAGE(GMRCIEN,SERVICES) ; check to see if there are images
  1.  N HIT,STATUS,TIUIEN,TOSERVICE
  1.  S HIT=0
  1.  ;
  1.  ; STATUS=2 for COMPLETE, 5=PENDING, 6=ACTIVE, 8=SCHEDULED, STATUS=9 for PARTIAL RESULTS
  1.  S STATUS=$$GET1^DIQ(123,GMRCIEN,8,"I")
  1.  I STATUS'=2,STATUS'=5,STATUS'=6,STATUS'=8,STATUS'=9 Q HIT
  1.  ;
  1.  S TOSERVICE=$$GET1^DIQ(123,GMRCIEN,1,"I")
  1.  I $D(SERVICES(+TOSERVICE)) D  ; consult has a requested TO SERVICE
  1.  . ; images can be assocated with the TIU External Data file (#8925.91),
  1.  . ; or DICOM GMRC TEMP LIST file (#2006.5839), or stored in the new
  1.  . ; SOP Class database IMAGE STUDY file (#2005.62) -- check all three
  1.  . S TIUIEN=$$GET1^DIQ(123,GMRCIEN,16,"I")
  1.  . I TIUIEN,$D(^TIU(8925.91,"B",TIUIEN)) S HIT=GMRCIEN
  1.  . I $D(^MAG(2006.5839,"C",123,GMRCIEN)) S HIT=GMRCIEN
  1.  . I $D(^MAGV(2005.62,"D",$$GMRCACN^MAGDFCNV(GMRCIEN))) S HIT=GMRCIEN
  1.  Q HIT
  1.  ;
  1. GMRCDATA(OUT,GMRCIEN,FIELD,FORMAT) ; RPC = MAG DICOM GET CON DATA
  1.  I '$D(GMRCIEN) S OUT="-1,GMRCIEN required" Q
  1.  I '$D(FIELD) S OUT="-2,FIELD required" Q
  1.  I $G(FORMAT)="" S FORMAT="E"
  1.  S OUT=$$GET1^DIQ(123,GMRCIEN,FIELD,FORMAT)
  1.  Q
  1.  ;
  1.  ;
  1. GMRCMAG(OUT,GMRCIEN) ; RPC = MAG DICOM GET CON IMAGES
  1.  ; return the image groups, if there are any
  1.  N I,MAG20065839IEN,MAGIEN,TIU892591IEN,MAG20065839ZERO,TIU892591ZERO,TIUIEN,RETURN
  1.  K OUT S I=1
  1.  S TIUIEN=$$GET1^DIQ(123,GMRCIEN,16,"I")
  1.  I TIUIEN,$D(^TIU(8925.91,"B",TIUIEN)) D
  1.  . S TIU892591IEN=""
  1.  . F  S TIU892591IEN=$O(^TIU(8925.91,"B",TIUIEN,TIU892591IEN)) Q:TIU892591IEN=""  D
  1.  . . S TIU892591ZERO=$G(^TIU(8925.91,TIU892591IEN,0))
  1.  . . S MAGIEN=$P(TIU892591ZERO,"^",2)
  1.  . . S I=I+1,OUT(I)=MAGIEN
  1.  . . Q
  1.  . Q
  1.  I $D(^MAG(2006.5839,"C",123,GMRCIEN)) D
  1.  . S MAG20065839IEN=""
  1.  . F  S MAG20065839IEN=$O(^MAG(2006.5839,"C",123,GMRCIEN,MAG20065839IEN)) Q:MAG20065839IEN=""  D
  1.  . . S MAG20065839ZERO=$G(^MAG(2006.5839,MAG20065839IEN,0))
  1.  . . S MAGIEN=$P(MAG20065839ZERO,"^",3)
  1.  . . S I=I+1,OUT(I)=MAGIEN
  1.  . . Q
  1.  . Q
  1.  I $D(^MAGV(2005.62,"D",$$GMRCACN^MAGDFCNV(GMRCIEN))) D
  1.  . S I=I+1,OUT(I)="New SOP Class DB"
  1.  . Q
  1.  S OUT(1)=I-1
  1.  Q