MAGDRPC7 ;WOIFO/EdM - RPC to fetch a Audit Info ; 10/30/2008 09:20
;;3.0;IMAGING;**11,51,54**;03-July-2009;;Build 1424
;; 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
;
GET1(OUT,LOCATION,TODAY) ; RPC = MAG DICOM TEXT AUDIT GET
; Get the numbers of text-messages per day per purpose
N COUNT,D2,DATE,I,MSG,N,X
D:'$D(DT) DT^DICRW
K OUT S (OUT(1),N)=1,I=100
S TODAY=+$G(TODAY),DATE=DT
D:TODAY I 'TODAY S DATE=0 F S DATE=$O(^MAGDAUDT(2006.5761,DATE)) Q:'DATE D
. Q:'$D(^MAGDAUDT(2006.5761,DATE,1,LOCATION))
. ; Retrieve one day's statistics
. S MSG="" F S MSG=$O(^MAGDAUDT(2006.5761,DATE,1,LOCATION,1,"B",MSG)) Q:MSG="" D
. . S D2=$O(^MAGDAUDT(2006.5761,DATE,1,LOCATION,1,"B",MSG,"")) Q:'D2
. . S X=$G(^MAGDAUDT(2006.5761,DATE,1,LOCATION,1,D2,0))
. . S COUNT=$P(X,"^",2) Q:'COUNT
. . S LAST=$P(X,"^",3)
. . S I=I+1,N=N+1,OUT(I)=DATE_"^"_COUNT_"^"_MSG_"^"_LAST,MSG(MSG)=""
. . Q
. Q
S I=1,MSG="" F S MSG=$O(MSG(MSG)) Q:MSG="" D
. S I=I+1,N=N+1,OUT(I)="^^"_MSG
. Q
S OUT(1)=N-1
Q
;
GET2(OUT,LOCATION,START,STOP,MAX,OFFSET) ; RPC = MAG DICOM IMAGE AUDIT GET
; Get the numbers of messages per day per instrument
N COUNT,D2,DATE,F1,F2,I,INSTR,LAST,N,X
D:'$D(DT) DT^DICRW
S MAX=+$G(MAX),OFFSET=+$G(OFFSET),(F1,F2,LAST)=0 S:'MAX MAX=100
K OUT S (OUT(1),N)=1,I=1000
S START=+$G(START)-1,STOP=+$G(STOP)
S:START<0 START=0
S:'STOP STOP=9999999
S DATE=START F S DATE=$O(^MAGDAUDT(2006.5762,DATE)) Q:'DATE Q:DATE>STOP D
. Q:'$D(^MAGDAUDT(2006.5762,DATE,1,LOCATION))
. ; Retrieve one day's statistics
. S INSTR="" F S INSTR=$O(^MAGDAUDT(2006.5762,DATE,1,LOCATION,1,"B",INSTR)) Q:INSTR="" D
. . S D2=$O(^MAGDAUDT(2006.5762,DATE,1,LOCATION,1,"B",INSTR,"")) Q:'D2
. . S X=$G(^MAGDAUDT(2006.5762,DATE,1,LOCATION,1,D2,0))
. . S COUNT=$P(X,"^",2) S:$P(X,"^",4)>COUNT COUNT=$P(X,"^",4)
. . Q:'COUNT
. . S INSTR(INSTR)=""
. . S F1=F1+1 Q:F1'>OFFSET
. . S F2=F2+1 Q:F2>MAX
. . S LAST=F1
. . S I=I+1,N=N+1,OUT(I)=DATE_"^"_$P(X,"^",2)_"^"_INSTR_"^"_$P(X,"^",3,5)
. . Q
. Q
S I=1,INSTR="" F S INSTR=$O(INSTR(INSTR)) Q:INSTR="" D
. S I=I+1,N=N+1,OUT(I)="^^"_INSTR
. Q
S OUT(1)=(N-1)_","_LAST
Q
;
RANGE(OUT) ; RPC = MAG DICOM AUDIT RANGE
; Get the date-ranges for the various audit files
N DF,DL,FM,N
K OUT S N=1
F FM=2006.5761,2006.5762 D
. S DF=$O(^MAGDAUDT(FM,0)) S:'DF DF=""
. S DL=$O(^MAGDAUDT(FM," "),-1) S:'DL DL=""
. S N=N+1,OUT(N)=FM_"^"_DF_"^"_DL
. Q
S N=N+1,OUT(N)="-END-"
Q
;
PURGE(OUT,FM,DATE) ; RPC = MAG DICOM AUDIT PURGE
; Purge Audit FIle
N D0,DAYS,X
L +^MAGDAUDT(FM):1E9 ; Background job MUST wait
S DAYS=$P($G(^MAGDAUDT(FM,0)),"^",4),OUT=0
S X=0 F S X=$O(^MAGDAUDT(FM,X)) Q:'X Q:X'<DATE D
. K ^MAGDAUDT(FM,X)
. S DAYS=DAYS-1,OUT=OUT+1
. Q
S:DAYS<1 DAYS=0
S $P(^MAGDAUDT(FM,0),"^",4)=DAYS
L -^MAGDAUDT(FM)
S OUT=OUT_" day"_$S(OUT=1:"",1:"s")_" purged."
Q
;
COUNT(OUT,LOCATION,MESSAGE) ; RPC = MAG DICOM AUDIT COUNT
; update today's count
N D2,TODAY,NOW,X
I '$G(LOCATION) S OUT="-1,No Location Specified" Q
I $G(MESSAGE)="" S OUT="-2,No Message Specified" Q
;
S NOW=$$NOW^XLFDT(),TODAY=NOW\1
S D2=$O(^MAGDAUDT(2006.5761,TODAY,1,LOCATION,1,"B",MESSAGE,""))
D:'D2
. L +^MAGDAUDT(2006.5761,TODAY):1E9 ; Background job MUST wait
. S D2=$O(^MAGDAUDT(2006.5761,TODAY,1,LOCATION,1," "),-1)+1
. S X=$G(^MAGDAUDT(2006.5761,TODAY,1,LOCATION,1,0))
. S $P(X,"^",2)="2006.576111"
. S $P(X,"^",3)=D2
. S $P(X,"^",4)=$P(X,"^",4)+1
. S ^MAGDAUDT(2006.5761,TODAY,1,LOCATION,0)=LOCATION
. S ^MAGDAUDT(2006.5761,TODAY,1,LOCATION,1,0)=X
. S ^MAGDAUDT(2006.5761,TODAY,1,LOCATION,1,D2,0)=MESSAGE
. S ^MAGDAUDT(2006.5761,TODAY,1,LOCATION,1,"B",MESSAGE,D2)=""
. L -^MAGDAUDT(2006.5761,TODAY)
. Q
S X=$G(^MAGDAUDT(2006.5761,TODAY,1,LOCATION,1,D2,0))
S X=MESSAGE_"^"_($P(X,"^",2)+1)_"^"_NOW
S ^MAGDAUDT(2006.5761,TODAY,1,LOCATION,1,D2,0)=X
S OUT=$P(X,"^",2)
Q
;
LOGXIMG(OUT,D0,DEST,LOCATION,STATUS,TO,XMIT,MECH) ; RPC = MAG DICOM ROUTE LOG XMIT
N X
; D0 ;---- IEN of queue entry (2006.035)
; DEST ;-- IEN of destination in 2005.2 or in 2006.585
; TO ;---- Name of file at destination
; XMIT ;-- Date and time transmission started
N D41 ;--- IEN in "routed" multiple
N D61 ;--- IEN in "permanent" multiple
N IMG ;--- IEN of Image in 2005
N NOW ;----- Current date and time
N QUEUED ; Date and time file was queued
N TP ;---- File TP (FULL, ABS, BIG, TXT, DICOM)
;
D STATUS^MAGDRPC5(.X,D0,STATUS,LOCATION) I X<1 S OUT="-1,"_X Q
I STATUS="FAILED" S OUT=1 Q
S X=$G(^MAGQUEUE(2006.035,D0,0)),IMG=$P(X,"^",1),TP=$P(X,"^",3)
S QUEUED=$P($G(^MAGQUEUE(2006.035,D0,1)),"^",3)
;
S NOW=$$NOW^XLFDT()
S $P(^MAGQUEUE(2006.035,D0,1),"^",4)=NOW
L +^MAG(2005,IMG):1E9 ; Background job MUST wait
S D41=$O(^MAG(2005,IMG,4," "),-1)+1
S D61=$O(^MAG(2005,IMG,6," "),-1)+1
D:MECH=1
. S ^MAG(2005,IMG,4,0)="^2005.0106^"_D41_"^"_D41
. S ^MAG(2005,IMG,4,D41,0)=NOW_"^"_DEST_"^"_TP_"^"_TO_"^"_$G(XMIT)_"^"_QUEUED_"^"_D61
. S ^MAG(2005,IMG,4,"LOC",DEST,D41)=""
. S ^MAG(2005,"ROUTE",DEST,NOW,IMG,D41)=""
. Q
S X=""
I MECH=1 S X=$P($G(^MAG(2005.2,+DEST,0)),"^",1)_"^"_(+DEST)_"^"
I MECH=2 S X=$P($G(^MAG(2006.587,+DEST,0)),"^",1)_"^^"_(+DEST)
S $P(X,"^",4)=NOW ; Timestamp of transmission
S $P(X,"^",6)=TO ; Filename at destination
S $P(X,"^",7)=TP ; File Type
S ^MAG(2005,IMG,6,0)="^2005.0106^"_D61_"^"_D61
S ^MAG(2005,IMG,6,D61,0)=X
L -^MAG(2005,IMG)
S OUT=1
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDRPC7 6460 printed Sep 23, 2025@19:37:38 Page 2
MAGDRPC7 ;WOIFO/EdM - RPC to fetch a Audit Info ; 10/30/2008 09:20
+1 ;;3.0;IMAGING;**11,51,54**;03-July-2009;;Build 1424
+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 ;
GET1(OUT,LOCATION,TODAY) ; RPC = MAG DICOM TEXT AUDIT GET
+1 ; Get the numbers of text-messages per day per purpose
+2 NEW COUNT,D2,DATE,I,MSG,N,X
+3 if '$DATA(DT)
DO DT^DICRW
+4 KILL OUT
SET (OUT(1),N)=1
SET I=100
+5 SET TODAY=+$GET(TODAY)
SET DATE=DT
+6 if TODAY
Begin DoDot:1
+7 if '$DATA(^MAGDAUDT(2006.5761,DATE,1,LOCATION))
QUIT
+8 ; Retrieve one day's statistics
+9 SET MSG=""
FOR
SET MSG=$ORDER(^MAGDAUDT(2006.5761,DATE,1,LOCATION,1,"B",MSG))
if MSG=""
QUIT
Begin DoDot:2
+10 SET D2=$ORDER(^MAGDAUDT(2006.5761,DATE,1,LOCATION,1,"B",MSG,""))
if 'D2
QUIT
+11 SET X=$GET(^MAGDAUDT(2006.5761,DATE,1,LOCATION,1,D2,0))
+12 SET COUNT=$PIECE(X,"^",2)
if 'COUNT
QUIT
+13 SET LAST=$PIECE(X,"^",3)
+14 SET I=I+1
SET N=N+1
SET OUT(I)=DATE_"^"_COUNT_"^"_MSG_"^"_LAST
SET MSG(MSG)=""
+15 QUIT
End DoDot:2
+16 QUIT
End DoDot:1
IF 'TODAY
SET DATE=0
FOR
SET DATE=$ORDER(^MAGDAUDT(2006.5761,DATE))
if 'DATE
QUIT
Begin DoDot:1
End DoDot:1
+17 SET I=1
SET MSG=""
FOR
SET MSG=$ORDER(MSG(MSG))
if MSG=""
QUIT
Begin DoDot:1
+18 SET I=I+1
SET N=N+1
SET OUT(I)="^^"_MSG
+19 QUIT
End DoDot:1
+20 SET OUT(1)=N-1
+21 QUIT
+22 ;
GET2(OUT,LOCATION,START,STOP,MAX,OFFSET) ; RPC = MAG DICOM IMAGE AUDIT GET
+1 ; Get the numbers of messages per day per instrument
+2 NEW COUNT,D2,DATE,F1,F2,I,INSTR,LAST,N,X
+3 if '$DATA(DT)
DO DT^DICRW
+4 SET MAX=+$GET(MAX)
SET OFFSET=+$GET(OFFSET)
SET (F1,F2,LAST)=0
if 'MAX
SET MAX=100
+5 KILL OUT
SET (OUT(1),N)=1
SET I=1000
+6 SET START=+$GET(START)-1
SET STOP=+$GET(STOP)
+7 if START<0
SET START=0
+8 if 'STOP
SET STOP=9999999
+9 SET DATE=START
FOR
SET DATE=$ORDER(^MAGDAUDT(2006.5762,DATE))
if 'DATE
QUIT
if DATE>STOP
QUIT
Begin DoDot:1
+10 if '$DATA(^MAGDAUDT(2006.5762,DATE,1,LOCATION))
QUIT
+11 ; Retrieve one day's statistics
+12 SET INSTR=""
FOR
SET INSTR=$ORDER(^MAGDAUDT(2006.5762,DATE,1,LOCATION,1,"B",INSTR))
if INSTR=""
QUIT
Begin DoDot:2
+13 SET D2=$ORDER(^MAGDAUDT(2006.5762,DATE,1,LOCATION,1,"B",INSTR,""))
if 'D2
QUIT
+14 SET X=$GET(^MAGDAUDT(2006.5762,DATE,1,LOCATION,1,D2,0))
+15 SET COUNT=$PIECE(X,"^",2)
if $PIECE(X,"^",4)>COUNT
SET COUNT=$PIECE(X,"^",4)
+16 if 'COUNT
QUIT
+17 SET INSTR(INSTR)=""
+18 SET F1=F1+1
if F1'>OFFSET
QUIT
+19 SET F2=F2+1
if F2>MAX
QUIT
+20 SET LAST=F1
+21 SET I=I+1
SET N=N+1
SET OUT(I)=DATE_"^"_$PIECE(X,"^",2)_"^"_INSTR_"^"_$PIECE(X,"^",3,5)
+22 QUIT
End DoDot:2
+23 QUIT
End DoDot:1
+24 SET I=1
SET INSTR=""
FOR
SET INSTR=$ORDER(INSTR(INSTR))
if INSTR=""
QUIT
Begin DoDot:1
+25 SET I=I+1
SET N=N+1
SET OUT(I)="^^"_INSTR
+26 QUIT
End DoDot:1
+27 SET OUT(1)=(N-1)_","_LAST
+28 QUIT
+29 ;
RANGE(OUT) ; RPC = MAG DICOM AUDIT RANGE
+1 ; Get the date-ranges for the various audit files
+2 NEW DF,DL,FM,N
+3 KILL OUT
SET N=1
+4 FOR FM=2006.5761,2006.5762
Begin DoDot:1
+5 SET DF=$ORDER(^MAGDAUDT(FM,0))
if 'DF
SET DF=""
+6 SET DL=$ORDER(^MAGDAUDT(FM," "),-1)
if 'DL
SET DL=""
+7 SET N=N+1
SET OUT(N)=FM_"^"_DF_"^"_DL
+8 QUIT
End DoDot:1
+9 SET N=N+1
SET OUT(N)="-END-"
+10 QUIT
+11 ;
PURGE(OUT,FM,DATE) ; RPC = MAG DICOM AUDIT PURGE
+1 ; Purge Audit FIle
+2 NEW D0,DAYS,X
+3 ; Background job MUST wait
LOCK +^MAGDAUDT(FM):1E9
+4 SET DAYS=$PIECE($GET(^MAGDAUDT(FM,0)),"^",4)
SET OUT=0
+5 SET X=0
FOR
SET X=$ORDER(^MAGDAUDT(FM,X))
if 'X
QUIT
if X'<DATE
QUIT
Begin DoDot:1
+6 KILL ^MAGDAUDT(FM,X)
+7 SET DAYS=DAYS-1
SET OUT=OUT+1
+8 QUIT
End DoDot:1
+9 if DAYS<1
SET DAYS=0
+10 SET $PIECE(^MAGDAUDT(FM,0),"^",4)=DAYS
+11 LOCK -^MAGDAUDT(FM)
+12 SET OUT=OUT_" day"_$SELECT(OUT=1:"",1:"s")_" purged."
+13 QUIT
+14 ;
COUNT(OUT,LOCATION,MESSAGE) ; RPC = MAG DICOM AUDIT COUNT
+1 ; update today's count
+2 NEW D2,TODAY,NOW,X
+3 IF '$GET(LOCATION)
SET OUT="-1,No Location Specified"
QUIT
+4 IF $GET(MESSAGE)=""
SET OUT="-2,No Message Specified"
QUIT
+5 ;
+6 SET NOW=$$NOW^XLFDT()
SET TODAY=NOW\1
+7 SET D2=$ORDER(^MAGDAUDT(2006.5761,TODAY,1,LOCATION,1,"B",MESSAGE,""))
+8 if 'D2
Begin DoDot:1
+9 ; Background job MUST wait
LOCK +^MAGDAUDT(2006.5761,TODAY):1E9
+10 SET D2=$ORDER(^MAGDAUDT(2006.5761,TODAY,1,LOCATION,1," "),-1)+1
+11 SET X=$GET(^MAGDAUDT(2006.5761,TODAY,1,LOCATION,1,0))
+12 SET $PIECE(X,"^",2)="2006.576111"
+13 SET $PIECE(X,"^",3)=D2
+14 SET $PIECE(X,"^",4)=$PIECE(X,"^",4)+1
+15 SET ^MAGDAUDT(2006.5761,TODAY,1,LOCATION,0)=LOCATION
+16 SET ^MAGDAUDT(2006.5761,TODAY,1,LOCATION,1,0)=X
+17 SET ^MAGDAUDT(2006.5761,TODAY,1,LOCATION,1,D2,0)=MESSAGE
+18 SET ^MAGDAUDT(2006.5761,TODAY,1,LOCATION,1,"B",MESSAGE,D2)=""
+19 LOCK -^MAGDAUDT(2006.5761,TODAY)
+20 QUIT
End DoDot:1
+21 SET X=$GET(^MAGDAUDT(2006.5761,TODAY,1,LOCATION,1,D2,0))
+22 SET X=MESSAGE_"^"_($PIECE(X,"^",2)+1)_"^"_NOW
+23 SET ^MAGDAUDT(2006.5761,TODAY,1,LOCATION,1,D2,0)=X
+24 SET OUT=$PIECE(X,"^",2)
+25 QUIT
+26 ;
LOGXIMG(OUT,D0,DEST,LOCATION,STATUS,TO,XMIT,MECH) ; RPC = MAG DICOM ROUTE LOG XMIT
+1 NEW X
+2 ; D0 ;---- IEN of queue entry (2006.035)
+3 ; DEST ;-- IEN of destination in 2005.2 or in 2006.585
+4 ; TO ;---- Name of file at destination
+5 ; XMIT ;-- Date and time transmission started
+6 ;--- IEN in "routed" multiple
NEW D41
+7 ;--- IEN in "permanent" multiple
NEW D61
+8 ;--- IEN of Image in 2005
NEW IMG
+9 ;----- Current date and time
NEW NOW
+10 ; Date and time file was queued
NEW QUEUED
+11 ;---- File TP (FULL, ABS, BIG, TXT, DICOM)
NEW TP
+12 ;
+13 DO STATUS^MAGDRPC5(.X,D0,STATUS,LOCATION)
IF X<1
SET OUT="-1,"_X
QUIT
+14 IF STATUS="FAILED"
SET OUT=1
QUIT
+15 SET X=$GET(^MAGQUEUE(2006.035,D0,0))
SET IMG=$PIECE(X,"^",1)
SET TP=$PIECE(X,"^",3)
+16 SET QUEUED=$PIECE($GET(^MAGQUEUE(2006.035,D0,1)),"^",3)
+17 ;
+18 SET NOW=$$NOW^XLFDT()
+19 SET $PIECE(^MAGQUEUE(2006.035,D0,1),"^",4)=NOW
+20 ; Background job MUST wait
LOCK +^MAG(2005,IMG):1E9
+21 SET D41=$ORDER(^MAG(2005,IMG,4," "),-1)+1
+22 SET D61=$ORDER(^MAG(2005,IMG,6," "),-1)+1
+23 if MECH=1
Begin DoDot:1
+24 SET ^MAG(2005,IMG,4,0)="^2005.0106^"_D41_"^"_D41
+25 SET ^MAG(2005,IMG,4,D41,0)=NOW_"^"_DEST_"^"_TP_"^"_TO_"^"_$GET(XMIT)_"^"_QUEUED_"^"_D61
+26 SET ^MAG(2005,IMG,4,"LOC",DEST,D41)=""
+27 SET ^MAG(2005,"ROUTE",DEST,NOW,IMG,D41)=""
+28 QUIT
End DoDot:1
+29 SET X=""
+30 IF MECH=1
SET X=$PIECE($GET(^MAG(2005.2,+DEST,0)),"^",1)_"^"_(+DEST)_"^"
+31 IF MECH=2
SET X=$PIECE($GET(^MAG(2006.587,+DEST,0)),"^",1)_"^^"_(+DEST)
+32 ; Timestamp of transmission
SET $PIECE(X,"^",4)=NOW
+33 ; Filename at destination
SET $PIECE(X,"^",6)=TO
+34 ; File Type
SET $PIECE(X,"^",7)=TP
+35 SET ^MAG(2005,IMG,6,0)="^2005.0106^"_D61_"^"_D61
+36 SET ^MAG(2005,IMG,6,D61,0)=X
+37 LOCK -^MAG(2005,IMG)
+38 SET OUT=1
+39 QUIT
+40 ;
