MAGDQRUL ;WOIFO/EdM,MLH - Imaging RPCs for Query/Retrieve - logging utility ; 30 Dec 2011 2:20 PM
;;3.0;IMAGING;**118**;Mar 19, 2002;Build 4525;May 01, 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. |
;; +---------------------------------------------------------------+
;;
Q
;
LOG(TYP,DETAIL,TXT) N D1,D2,D3,LOC,X
; check usage
I $G(TYP)="" S OUT(1)="-1^Audit type not provided" Q
I '$D(DETAIL) S OUT(1)="-2^Audit detail must be defined" Q
;
D:'$G(DT) DT^DICRW
S D1=$O(^MAGDAUDT(2006.5733,"B",DT,""))
S:'D1 D1=$$ADD($NA(^MAGDAUDT(2006.5733)),"QUERY/RETRIEVE STATISTICS",2006.5733,DT,1)
;
S LOC=$G(DUZ(2)) S:'LOC LOC=$$KSP^XUPARAM("INST")
S D1=$O(^MAGDAUDT(2006.5733,DT,1,"B",LOC,""))
S:'D1 D1=$$ADD($NA(^MAGDAUDT(2006.5733,DT,1)),"",2006.57331,LOC,1)
;
S D2=$O(^MAGDAUDT(2006.5733,DT,1,D1,1,"B",TYP,""))
S:'D2 D2=$$ADD($NA(^MAGDAUDT(2006.5733,DT,1,D1,1)),"",2006.57332,TYP,0)
L +^MAGDAUDT(2006.5733,DT,1,D1,1,D2):1E9 ; Background job MUST wait
S X=$G(^MAGDAUDT(2006.5733,DT,1,D1,1,D2,0))
S $P(X,"^",2)=$P(X,"^",2)+1
S ^MAGDAUDT(2006.5733,DT,1,D1,1,D2,0)=X
L -^MAGDAUDT(2006.5733,DT,1,D1,1,D2)
;
D:DETAIL'=""
. S D3=$O(^MAGDAUDT(2006.5733,DT,1,D1,1,D2,1,"B",DETAIL,""))
. S:'D3 D3=$$ADD($NA(^MAGDAUDT(2006.5733,DT,1,D1,1,D2,1)),"",2006.57333,DETAIL,0)
. L +^MAGDAUDT(2006.5733,DT,1,D1,1,D2,1,D3):1E9 ; Background job MUST wait
. S X=$G(^MAGDAUDT(2006.5733,DT,1,D1,1,D2,1,D3,0))
. S $P(X,"^",2)=$P(X,"^",2)+1
. S ^MAGDAUDT(2006.5733,DT,1,D1,1,D2,1,D3,0)=X
. L -^MAGDAUDT(2006.5733,DT,1,D1,1,D2,1,D3)
. Q
;
S OUT(1)=$G(TXT)
Q
;
ADD(ROOT,F1,F2,VAL,DINUM) N D0,NAM,O,X
S ROOT=$E(ROOT,1,$L(ROOT)-1)_",",NAM=ROOT_"0)",O=ROOT_""" "")"
L +@NAM:1E9 ; Background job MUST wait
S X=$G(@NAM)
S $P(X,"^",1,2)=F1_"^"_F2
S D0=$S(DINUM:+VAL,1:$O(@O,-1)+1),$P(X,"^",3)=D0
S $P(X,"^",4)=$P(X,"^",4)+1
S @NAM=X
S @(ROOT_D0_",0)")=VAL
S @(ROOT_"""B"",$P(VAL,""^"",1),D0)")=""
L -@NAM
Q D0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDQRUL 2847 printed Dec 13, 2024@02:01:12 Page 2
MAGDQRUL ;WOIFO/EdM,MLH - Imaging RPCs for Query/Retrieve - logging utility ; 30 Dec 2011 2:20 PM
+1 ;;3.0;IMAGING;**118**;Mar 19, 2002;Build 4525;May 01, 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 QUIT
+18 ;
LOG(TYP,DETAIL,TXT) NEW D1,D2,D3,LOC,X
+1 ; check usage
+2 IF $GET(TYP)=""
SET OUT(1)="-1^Audit type not provided"
QUIT
+3 IF '$DATA(DETAIL)
SET OUT(1)="-2^Audit detail must be defined"
QUIT
+4 ;
+5 if '$GET(DT)
DO DT^DICRW
+6 SET D1=$ORDER(^MAGDAUDT(2006.5733,"B",DT,""))
+7 if 'D1
SET D1=$$ADD($NAME(^MAGDAUDT(2006.5733)),"QUERY/RETRIEVE STATISTICS",2006.5733,DT,1)
+8 ;
+9 SET LOC=$GET(DUZ(2))
if 'LOC
SET LOC=$$KSP^XUPARAM("INST")
+10 SET D1=$ORDER(^MAGDAUDT(2006.5733,DT,1,"B",LOC,""))
+11 if 'D1
SET D1=$$ADD($NAME(^MAGDAUDT(2006.5733,DT,1)),"",2006.57331,LOC,1)
+12 ;
+13 SET D2=$ORDER(^MAGDAUDT(2006.5733,DT,1,D1,1,"B",TYP,""))
+14 if 'D2
SET D2=$$ADD($NAME(^MAGDAUDT(2006.5733,DT,1,D1,1)),"",2006.57332,TYP,0)
+15 ; Background job MUST wait
LOCK +^MAGDAUDT(2006.5733,DT,1,D1,1,D2):1E9
+16 SET X=$GET(^MAGDAUDT(2006.5733,DT,1,D1,1,D2,0))
+17 SET $PIECE(X,"^",2)=$PIECE(X,"^",2)+1
+18 SET ^MAGDAUDT(2006.5733,DT,1,D1,1,D2,0)=X
+19 LOCK -^MAGDAUDT(2006.5733,DT,1,D1,1,D2)
+20 ;
+21 if DETAIL'=""
Begin DoDot:1
+22 SET D3=$ORDER(^MAGDAUDT(2006.5733,DT,1,D1,1,D2,1,"B",DETAIL,""))
+23 if 'D3
SET D3=$$ADD($NAME(^MAGDAUDT(2006.5733,DT,1,D1,1,D2,1)),"",2006.57333,DETAIL,0)
+24 ; Background job MUST wait
LOCK +^MAGDAUDT(2006.5733,DT,1,D1,1,D2,1,D3):1E9
+25 SET X=$GET(^MAGDAUDT(2006.5733,DT,1,D1,1,D2,1,D3,0))
+26 SET $PIECE(X,"^",2)=$PIECE(X,"^",2)+1
+27 SET ^MAGDAUDT(2006.5733,DT,1,D1,1,D2,1,D3,0)=X
+28 LOCK -^MAGDAUDT(2006.5733,DT,1,D1,1,D2,1,D3)
+29 QUIT
End DoDot:1
+30 ;
+31 SET OUT(1)=$GET(TXT)
+32 QUIT
+33 ;
ADD(ROOT,F1,F2,VAL,DINUM) NEW D0,NAM,O,X
+1 SET ROOT=$EXTRACT(ROOT,1,$LENGTH(ROOT)-1)_","
SET NAM=ROOT_"0)"
SET O=ROOT_""" "")"
+2 ; Background job MUST wait
LOCK +@NAM:1E9
+3 SET X=$GET(@NAM)
+4 SET $PIECE(X,"^",1,2)=F1_"^"_F2
+5 SET D0=$SELECT(DINUM:+VAL,1:$ORDER(@O,-1)+1)
SET $PIECE(X,"^",3)=D0
+6 SET $PIECE(X,"^",4)=$PIECE(X,"^",4)+1
+7 SET @NAM=X
+8 SET @(ROOT_D0_",0)")=VAL
+9 SET @(ROOT_"""B"",$P(VAL,""^"",1),D0)")=""
+10 LOCK -@NAM
+11 QUIT D0
