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

MAGDRPC2.m

Go to the documentation of this file.
  1. MAGDRPC2 ;WOIFO/EDM/PMK - Imaging RPCs ; Feb 15, 2022@10:47:46
  1. ;;3.0;IMAGING;**11,30,51,50,54,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. SERVICE(OUT) ; RPC = MAG DICOM GET SERVICE INFO
  1. N D0,X
  1. S D0=$O(^MAG(2006.1,0)),OUT="-1,No Imaging Site Parameters defined" Q:'D0
  1. S X=$G(^MAG(2006.1,D0,"GW"))
  1. S OUT=$$ENCRYP^ROUTINE($$DECRYP($P(X,"^",1))_";"_$$DECRYP($P(X,"^",2)))
  1. Q
  1. ;
  1. SAME(SET,D0,NODE,PIECE,X) ; Called from FileMan ^DD
  1. N L0
  1. S L0=0 F S L0=$O(^MAG(2006.1,L0)) Q:'L0 D:L0'=D0
  1. . S $P(^MAG(2006.1,L0,NODE),"^",PIECE)=$S(SET:X,1:"")
  1. . Q
  1. Q
  1. ;
  1. IMAGE(OUT,D0) ; RPC = MAG DICOM GET BASIC IMAGE
  1. N I,MSG,TARGET,V,VE,VI,X
  1. K OUT S I=1
  1. I '$G(D0) S OUT(1)="-1,Invalid IEN ("_$G(D0)_")" Q
  1. I $D(^MAG(2005.1,D0,0)) S OUT(1)="-3,Image #"_D0_" has been deleted." Q
  1. I '$D(^MAG(2005,D0,0)) S OUT(1)="-2,No data for """_D0_"""." Q
  1. ;
  1. D GETS^DIQ(2005,D0_",","*","REIN","TARGET","MSG")
  1. S X="" F S X=$O(TARGET(2005,D0_",",X)) Q:X="" D
  1. . S VI=$G(TARGET(2005,D0_",",X,"I"))
  1. . S VE=$G(TARGET(2005,D0_",",X,"E"))
  1. . S I=I+1,OUT(I)=X_"^"_VI S:VI'=VE OUT(I)=OUT(I)_"^"_VE
  1. . Q
  1. ;
  1. D FILEFIND^MAGDFB(D0,"FULL",0,0,.X,.V)
  1. S:X'<0 I=I+1,OUT(I)="Full FileName^"_X
  1. S:V'<0 I=I+1,OUT(I)="Full Path+FileName^"_V
  1. ;
  1. D FILEFIND^MAGDFB(D0,"BIG",0,0,.X,.V)
  1. S:X'<0 I=I+1,OUT(I)="Big FileName^"_X
  1. S:V'<0 I=I+1,OUT(I)="Big Path+FileName^"_V
  1. ;
  1. D FILEFIND^MAGDFB(D0,"ABSTRACT",0,0,.X,.V)
  1. S:X'<0 I=I+1,OUT(I)="Abstract FileName^"_X
  1. S:V'<0 I=I+1,OUT(I)="Abstract Path+FileName^"_V
  1. ;
  1. S (V,X)=0 F S X=$O(^MAG(2005,D0,1,X)) Q:'X S V=V+1
  1. S:V I=I+1,OUT(I)="# Images^"_V
  1. ;
  1. S OUT(1)=I-1
  1. Q
  1. ;
  1. GRPIMG(OUT,D0) ; RPC = MAG DICOM GET IMAGE GROUP
  1. N I,D1,X
  1. D CHK^MAGGSQI(.OUT,D0) I +$G(OUT(0))'=1 Q ; patient safety
  1. K OUT S I=1
  1. S D1=0 F S D1=$O(^MAG(2005,D0,1,D1)) Q:'D1 D
  1. . S X=$P($G(^MAG(2005,D0,1,D1,0)),"^",1) Q:'X
  1. . S I=I+1,OUT(I)=X
  1. . Q
  1. S OUT(1)=I-1
  1. Q
  1. ;
  1. IMAGNEW(OUT,ARTIFACTIX) ; RPC = MAG DICOM GET NEW SOP DB IMAGE - P305 PMK 12/02/2021
  1. N ARTIFACTINSTIX,DISKVOLUME,FILEREF,FILEPATH,I,PHYSICALREF
  1. I '$G(ARTIFACTIX) S OUT="-1,Invalid IEN ("_$G(ARTIFACTIX)_")" Q
  1. S ARTIFACTINSTIX=$O(^MAGV(2006.918,"B",ARTIFACTIX,"")) ; get first Artifact Instance pointer
  1. I ARTIFACTINSTIX="" S OUT="-2,No data for """_ARTIFACTIX_"""." Q
  1. S FILEREF=$$UP^MAGDFCNV($$GET1^DIQ(2006.918,ARTIFACTINSTIX,6)) ; FILEREF (filename)
  1. S DISKVOLUME=$$GET1^DIQ(2006.918,ARTIFACTINSTIX,7,"I") ; DISK VOLUME
  1. S PHYSICALREF=$$GET1^DIQ(2005.2,DISKVOLUME,1) ; PHYSICAL REFERENCE
  1. S FILEPATH=$$GET1^DIQ(2006.918,ARTIFACTINSTIX,8) ; FILEPATH
  1. S OUT=PHYSICALREF_FILEPATH_FILEREF
  1. Q
  1. ;
  1. DECRYP(X) Q $S(X="":"",1:$$DECRYP^ROUTINE(X))
  1. ;
  1. IMGVER(OUT) ; RPC = MAG DICOM GET VERSION
  1. N D0,DATINS,FME,FML,I,L,N,P,PATCH,X
  1. D FIND^DIC(9.7,"",".01;2I;51I","QU","MAG*3.0","*","B","","","FML","FME")
  1. S I="" F S I=$O(FML("DILIST","ID",I)) Q:I="" D
  1. . S N=$G(FML("DILIST","ID",I,.01)) Q:$P(N,"*",2)'="3.0"
  1. . S PATCH=$P(N,"*",3) Q:'PATCH
  1. . S PATCH(PATCH)=1
  1. . S DATINS=$G(FML("DILIST","ID",I,2)) Q:DATINS=""
  1. . S P=$G(FML("DILIST","ID",I,51)) Q:P=""
  1. . S L(DATINS,PATCH_"-"_P)=""
  1. . Q
  1. ;
  1. S (DATINS,L,OUT)="" F S DATINS=$O(L(DATINS),-1) Q:DATINS="" D
  1. . S PATCH="" F S PATCH=$O(L(DATINS,PATCH)) Q:PATCH="" D
  1. . . S:OUT="" OUT=PATCH
  1. . . S:$G(PATCH(+PATCH)) PATCH(+PATCH)=0,L=(+PATCH)_","_L
  1. . . Q
  1. . Q
  1. S OUT=L_OUT
  1. Q
  1. ;
  1. PLACE(LOCATION) N D0,FST,LST
  1. S FST=+$O(^MAG(2006.1,0)),LST=+$O(^MAG(2006.1," "),-1) Q:LST=FST FST
  1. S D0=$O(^MAG(2006.1,"B",+$G(LOCATION),"")) Q:D0 D0
  1. Q FST
  1. ;
  1. ROUTEDAY ; Scan for Routing Activity
  1. N BUCKET ;- Daily tallies
  1. N D0 ;----- Image pointer for child of current parent
  1. N D1 ;----- Pointer to multiple in image file
  1. N D4 ;----- Loop counter
  1. N DAY ;---- Current FileMan date
  1. N DAYTIM ;- Current FileMan timestamp
  1. N DEST ;--- Destination
  1. N FIRST ;-- First date for scan
  1. N FSTX ;--- First transmission for current study
  1. N IMAGE ;-- Image Pointer for current image
  1. N LAST ;--- Last date for scan
  1. N LSTQ ;--- Timestamp for last queue entry in current study
  1. N P3 ;----- Highest IEN in statistics file
  1. N P4 ;----- Number of entries in statistics file
  1. N PARENT ;- Image Pointer for parent of current image
  1. N R ;------ Retention Period
  1. N X ;------ Scratch
  1. N XMIT ;--- Total duration of transmissions for current study
  1. ;
  1. K ^TMP("MAG",$J,"RTD1")
  1. K ^TMP("MAG",$J,"RTD2")
  1. K ^TMP("MAG",$J,"RTD3")
  1. S FIRST=$$HTFM^XLFDT($H-4)
  1. S LAST=$$HTFM^XLFDT($H+2)
  1. ;
  1. S DEST="" F S DEST=$O(^MAG(2005,"ROUTE",DEST)) Q:DEST="" D
  1. . S NAME(DEST)=$P($G(^MAG(2005.2,DEST,0)," ? "_DEST),"^",1)
  1. . S DAYTIM=FIRST F D S DAYTIM=$O(^MAG(2005,"ROUTE",DEST,DAYTIM)) Q:DAYTIM="" Q:DAYTIM'<LAST
  1. . . S DAY=DAYTIM\1
  1. . . S IMAGE="" F S IMAGE=$O(^MAG(2005,"ROUTE",DEST,DAYTIM,IMAGE)) Q:IMAGE="" D
  1. . . . S PARENT=$P($G(^MAG(2005,IMAGE,0)),"^",10)
  1. . . . I PARENT,$G(^TMP("MAG",$J,"RTD3",PARENT)) S PARENT=0
  1. . . . S:PARENT ^TMP("MAG",$J,"RTD3",PARENT)=1
  1. . . . S (XMIT,LSTQ)=0,FSTX=1E9
  1. . . . S D0=IMAGE,D1=0 D I PARENT F S D1=$O(^MAG(2005,PARENT,1,D1)) Q:'D1 S D0=+$P($G(^MAG(2005,PARENT,1,D1,0)),"^",1) D
  1. . . . . Q:'D0
  1. . . . . Q:$D(^TMP("MAG",$J,"RTD1",D0,D1))
  1. . . . . S ^TMP("MAG",$J,"RTD1",D0,D1)=""
  1. . . . . S D4=0 F S D4=$O(^MAG(2005,D0,4,D4)) Q:'D4 D
  1. . . . . . S X=$G(^MAG(2005,D0,4,D4,0))
  1. . . . . . Q:$P($P(X,"^",1),".",1)'=DAY
  1. . . . . . Q:$P(X,"^",2)'=DEST
  1. . . . . . S:$P(X,"^",6)>LSTQ LSTQ=$P(X,"^",6)
  1. . . . . . S:$P(X,"^",5)<FSTX FSTX=$P(X,"^",5)
  1. . . . . . S XMIT=XMIT+$$DELTA($P(X,"^",5),$P(X,"^",1))
  1. . . . . . Q
  1. . . . . Q
  1. . . . S X=$$DELTA(LSTQ,FSTX)
  1. . . . S:X>$G(BUCKET(DAY,DEST,1)) BUCKET(DAY,DEST,1)=X
  1. . . . S X=$S(X<300:1,X<900:2,X<3600:3,1:4)
  1. . . . S BUCKET(DAY,DEST,1,X)=$G(BUCKET(DAY,DEST,1,X))+1
  1. . . . S:XMIT>$G(BUCKET(DAY,DEST,2)) BUCKET(DAY,DEST,2)=XMIT
  1. . . . S X=$S(XMIT<300:1,XMIT<900:2,XMIT<3600:3,1:4)
  1. . . . S BUCKET(DAY,DEST,2,X)=$G(BUCKET(DAY,DEST,2,X))+1
  1. . . . Q
  1. . . Q
  1. . Q
  1. ;
  1. S X=$G(^TMP("MAG",$J,"RTD2",0)),P3=+$P(X,"^",3),P4=+$P(X,"^",4)
  1. S DAY="" F S DAY=$O(BUCKET(DAY)) Q:DAY="" D
  1. . S:'$D(^TMP("MAG",$J,"RTD2",DAY)) P4=P4+1,^TMP("MAG",$J,"RTD2",DAY,0)=DAY
  1. . S D1=0,DEST="" F S DEST=$O(BUCKET(DAY,DEST)) Q:DEST="" D
  1. . . S D1=D1+1
  1. . . S X=$G(BUCKET(DAY,DEST,2,1)) ; Less than 5 minutes
  1. . . S X=X_"^"_$G(BUCKET(DAY,DEST,2,2)) ; Less than 15 minutes
  1. . . S X=X_"^"_$G(BUCKET(DAY,DEST,2,3)) ; Less than 1 hour
  1. . . S X=X_"^"_$G(BUCKET(DAY,DEST,2,4)) ; 1 hour or more
  1. . . S X=X_"^"_$G(BUCKET(DAY,DEST,2)) ; Longest
  1. . . S X=X_"^Duration ("_NAME(DEST)_")"
  1. . . S ^TMP("MAG",$J,"RTD2",DAY,1,D1,0)=X
  1. . . S D1=D1+1
  1. . . S X=$G(BUCKET(DAY,DEST,1,1)) ; Less than 5 minutes
  1. . . S X=X_"^"_$G(BUCKET(DAY,DEST,1,2)) ; Less than 15 minutes
  1. . . S X=X_"^"_$G(BUCKET(DAY,DEST,1,3)) ; Less than 1 hour
  1. . . S X=X_"^"_$G(BUCKET(DAY,DEST,1,4)) ; 1 hour or more
  1. . . S X=X_"^"_$G(BUCKET(DAY,DEST,1)) ; Longest
  1. . . S X=X_"^Lag ("_NAME(DEST)_")"
  1. . . S ^TMP("MAG",$J,"RTD2",DAY,1,D1,0)=X
  1. . . Q
  1. . S:DAY>P3 P3=DAY
  1. . Q
  1. ; Purge old entries
  1. S R=$G(^MAGDICOM(2006.563,1,"RETAIN ROUTING STATISTICS")) S:R<1 R=30
  1. S DAY=$$HTFM^XLFDT($H-R)
  1. S D0=0 F S D0=$O(^TMP("MAG",$J,"RTD2",D0)) Q:'D0 Q:D0'<DAY D
  1. . K ^TMP("MAG",$J,"RTD2",D0) S P4=P4-1
  1. . Q
  1. ;
  1. D ; Get routing statistics
  1. . N A,W
  1. . S (A,DAY)=0 F S DAY=$O(^TMP("MAG",$J,"RTD2",DAY)) Q:'DAY D
  1. . . S:'A N=N+1,OUT(N)="Route",A=1
  1. . . S N=N+1,OUT(N)="RDT="_DAY
  1. . . S W=0 F S W=$O(^TMP("MAG",$J,"RTD2",DAY,1,W)) Q:'W D
  1. . . . S X=$G(^TMP("MAG",$J,"RTD2",DAY,1,W,0))
  1. . . . S N=N+1,OUT(N)="DST="_$P($P($P(X,"^",6),"(",2),")",1)
  1. . . . S W=W+1,$P(X,"^",6,10)=$P($G(^TMP("MAG",$J,"RTD2",DAY,1,W,0)),"^",1,5)
  1. . . . S N=N+1,OUT(N)="RST="_X
  1. . . . Q
  1. . . Q
  1. . S:A N=N+1,OUT(N)="RouteEnd"
  1. . Q
  1. K ^TMP("MAG",$J,"RTD1")
  1. K ^TMP("MAG",$J,"RTD2")
  1. K ^TMP("MAG",$J,"RTD3")
  1. Q
  1. ;
  1. DELTA(START,STOP) N D,D1,D2,T1,T2
  1. S D1=$P(START,".",1),D2=$P(STOP,".",1)
  1. S T1=START*1E6#1E6,T2=STOP*1E6#1E6
  1. S T1=T1\10000*60+(T1\100#100)*60+(T1#100)
  1. S T2=T2\10000*60+(T2\100#100)*60+(T2#100)
  1. S D=0 S:D1'=D2 D=$$FMTH^XLFDT(D2)-$$FMTH^XLFDT(D1)
  1. Q D*86400+T2-T1
  1. ;