MAGDSTV2 ;WOIFO/PMK - Process a Q/R Client RPC; Mar 31, 2020@13:00:30
;;3.0;IMAGING;**231**;Mar 19, 2002;Build 9;Sep 03, 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. |
;; +---------------------------------------------------------------+
;;
;
; Supported IA #10103 reference $$NOW^XLFDT function call
;
Q
; M2MB server
;
; This routine is invoked by the M2M Broker RPC to handle a Q/R client.
;
ENTRY(RESULT,REQUEST) ; RPC = MAG DICOM Q/R CLIENT
N ARGS ; ---- argument string of the REQUEST item
N DATETIME ;- fileman date/time of the study
N DCMPID ;--- DICOM patient id
N DFN ;------ VistA's internal patient identifier
N ERRCODE ;-- code for an error, if encountered
N IREQUEST ;- pointer to item in REQUEST array
N MSG ; ----- error message array
N OPCODE ;--- operation code of the REQUEST item
N RETURN ;--- intermediate return code
N J ;-------- scratch variable
;
; pass the request list and determine what has to be done
F IREQUEST=2:1:$G(REQUEST(1)) D
. S OPCODE=$P(REQUEST(IREQUEST),"|")
. S ARGS=$P(REQUEST(IREQUEST),"|",2,999)
. ;
. I OPCODE="NEXT" D Q
. . S NEXTIEN=$G(^MAGDSTT(2006.541,"ACOUNT"))+1
. . I '$D(^MAGDSTT(2006.541,NEXTIEN)) D RESULT("QR-REQUEST","NONE") Q
. . ; if another RPC is already processing this request, skip it
. . L +^MAGDSTT(2006.541,"ACOUNT"):0 E D RESULT("QR-REQUEST","NONE") Q
. . S VALUE=^MAGDSTT(2006.541,NEXTIEN,0)_"^"_NEXTIEN
. . D RESULT("QR-REQUEST",VALUE)
. . S J=0
. . F S J=$O(^MAGDSTT(2006.541,NEXTIEN,1,J)) Q:'J D
. . . S VALUE=^MAGDSTT(2006.541,NEXTIEN,1,J,0)
. . . D RESULT("KEY",VALUE)
. . . Q
. . S ^MAGDSTT(2006.541,"ACOUNT")=NEXTIEN
. . L -^MAGDSTT(2006.541,"ACOUNT")
. . Q
. ;
. I OPCODE="QUERY RESULT" D Q ; save query results in ^XTMP
. . N V,VARS,VAR
. . S VARS="MAGXTMP^HOSTNAME^VISTAJOB^QRSTACK^IEN2006541^LEVEL^I^J^K^L^VARIABLE^VALUE"
. . F V=1:1:$L(VARS,"^") S VAR=$P(VARS,"^",V) N @VAR S @VAR=$P(ARGS,"|",V)
. . I LEVEL="PATIENT" D
. . . I I="" S ^XTMP(MAGXTMP,HOSTNAME,VISTAJOB,QRSTACK,"PATIENT")=VALUE
. . . E S ^XTMP(MAGXTMP,HOSTNAME,VISTAJOB,QRSTACK,"PATIENT",I,VARIABLE)=VALUE
. . . Q
. . E I LEVEL="STUDY" D
. . . I J="" S ^XTMP(MAGXTMP,HOSTNAME,VISTAJOB,QRSTACK,"STUDY",I)=VALUE
. . . E S ^XTMP(MAGXTMP,HOSTNAME,VISTAJOB,QRSTACK,"STUDY",I,J,VARIABLE)=VALUE
. . . Q
. . E I LEVEL="SERIES" D
. . . I K="" S ^XTMP(MAGXTMP,HOSTNAME,VISTAJOB,QRSTACK,"SERIES",I,J)=VALUE
. . . E S ^XTMP(MAGXTMP,HOSTNAME,VISTAJOB,QRSTACK,"SERIES",I,J,K,VARIABLE)=VALUE
. . . Q
. . E I LEVEL="IMAGE" D
. . . I L="" S ^XTMP(MAGXTMP,HOSTNAME,VISTAJOB,QRSTACK,"IMAGE",I,J,K)=VALUE
. . . E S ^XTMP(MAGXTMP,HOSTNAME,VISTAJOB,QRSTACK,"IMAGE",I,J,K,L,VARIABLE)=VALUE
. . . Q
. . E I LEVEL="DONE" D
. . . ; "DONE" uses the request IEN for proper synchronization
. . . S ^XTMP(MAGXTMP,HOSTNAME,VISTAJOB,QRSTACK,"DONE",IEN2006541)=$$NOW^XLFDT_"^"_VARIABLE_"^"_VALUE
. . . Q
. . E I LEVEL="WORKING..." D
. . . S ^XTMP(MAGXTMP,HOSTNAME,VISTAJOB,QRSTACK,"WORKING...",IEN2006541)=$$NOW^XLFDT_"^"_VARIABLE_"^"_VALUE
. . . Q
. . E I LEVEL="MESSAGE" D
. . . S ^XTMP(MAGXTMP,HOSTNAME,VISTAJOB,QRSTACK,"MESSAGE",VARIABLE,I)=VALUE
. . . Q
. . E S PI=CIRCUMFERENCE/DIAMETER ; throw an error (line of code written on 3/14)
. . Q
. I OPCODE="RETRIEVE RESULT" D Q ; save retrieve results in ^XTMP
. . S MAGXTMP=$P(ARGS,"|",1),HOSTNAME=$P(ARGS,"|",2),VISTAJOB=$P(ARGS,"|",3)
. . S QRSTACK=$P(ARGS,"|",4)
. . S IEN2006541=$P(ARGS,"|",5) ; IEN2006541 is not used here
. . S ACNUMB=$P(ARGS,"|",6),X=$P(ARGS,"|",7,999)
. . S ^XTMP(MAGXTMP,HOSTNAME,VISTAJOB,QRSTACK,"Q/R RETRIEVE STATUS",ACNUMB)=X
. . Q
. I OPCODE="CRASH" D Q
. . S I=1/0 ; generate an error on the server to test error trapping
. . Q
. Q
Q
;
RESULT(OPCODE,ARGS) ; add an item to the RESULT list
S RESULT(1)=$G(RESULT(1),1)+1 ; first element in array is counter
S RESULT(RESULT(1))=OPCODE_"|"_ARGS
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDSTV2 4873 printed Apr 09, 2024@21:00:42 Page 2
MAGDSTV2 ;WOIFO/PMK - Process a Q/R Client RPC; Mar 31, 2020@13:00:30
+1 ;;3.0;IMAGING;**231**;Mar 19, 2002;Build 9;Sep 03, 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 ;
+18 ; Supported IA #10103 reference $$NOW^XLFDT function call
+19 ;
+20 QUIT
+21 ; M2MB server
+22 ;
+23 ; This routine is invoked by the M2M Broker RPC to handle a Q/R client.
+24 ;
ENTRY(RESULT,REQUEST) ; RPC = MAG DICOM Q/R CLIENT
+1 ; ---- argument string of the REQUEST item
NEW ARGS
+2 ;- fileman date/time of the study
NEW DATETIME
+3 ;--- DICOM patient id
NEW DCMPID
+4 ;------ VistA's internal patient identifier
NEW DFN
+5 ;-- code for an error, if encountered
NEW ERRCODE
+6 ;- pointer to item in REQUEST array
NEW IREQUEST
+7 ; ----- error message array
NEW MSG
+8 ;--- operation code of the REQUEST item
NEW OPCODE
+9 ;--- intermediate return code
NEW RETURN
+10 ;-------- scratch variable
NEW J
+11 ;
+12 ; pass the request list and determine what has to be done
+13 FOR IREQUEST=2:1:$GET(REQUEST(1))
Begin DoDot:1
+14 SET OPCODE=$PIECE(REQUEST(IREQUEST),"|")
+15 SET ARGS=$PIECE(REQUEST(IREQUEST),"|",2,999)
+16 ;
+17 IF OPCODE="NEXT"
Begin DoDot:2
+18 SET NEXTIEN=$GET(^MAGDSTT(2006.541,"ACOUNT"))+1
+19 IF '$DATA(^MAGDSTT(2006.541,NEXTIEN))
DO RESULT("QR-REQUEST","NONE")
QUIT
+20 ; if another RPC is already processing this request, skip it
+21 LOCK +^MAGDSTT(2006.541,"ACOUNT"):0
IF '$TEST
DO RESULT("QR-REQUEST","NONE")
QUIT
+22 SET VALUE=^MAGDSTT(2006.541,NEXTIEN,0)_"^"_NEXTIEN
+23 DO RESULT("QR-REQUEST",VALUE)
+24 SET J=0
+25 FOR
SET J=$ORDER(^MAGDSTT(2006.541,NEXTIEN,1,J))
if 'J
QUIT
Begin DoDot:3
+26 SET VALUE=^MAGDSTT(2006.541,NEXTIEN,1,J,0)
+27 DO RESULT("KEY",VALUE)
+28 QUIT
End DoDot:3
+29 SET ^MAGDSTT(2006.541,"ACOUNT")=NEXTIEN
+30 LOCK -^MAGDSTT(2006.541,"ACOUNT")
+31 QUIT
End DoDot:2
QUIT
+32 ;
+33 ; save query results in ^XTMP
IF OPCODE="QUERY RESULT"
Begin DoDot:2
+34 NEW V,VARS,VAR
+35 SET VARS="MAGXTMP^HOSTNAME^VISTAJOB^QRSTACK^IEN2006541^LEVEL^I^J^K^L^VARIABLE^VALUE"
+36 FOR V=1:1:$LENGTH(VARS,"^")
SET VAR=$PIECE(VARS,"^",V)
NEW @VAR
SET @VAR=$PIECE(ARGS,"|",V)
+37 IF LEVEL="PATIENT"
Begin DoDot:3
+38 IF I=""
SET ^XTMP(MAGXTMP,HOSTNAME,VISTAJOB,QRSTACK,"PATIENT")=VALUE
+39 IF '$TEST
SET ^XTMP(MAGXTMP,HOSTNAME,VISTAJOB,QRSTACK,"PATIENT",I,VARIABLE)=VALUE
+40 QUIT
End DoDot:3
+41 IF '$TEST
IF LEVEL="STUDY"
Begin DoDot:3
+42 IF J=""
SET ^XTMP(MAGXTMP,HOSTNAME,VISTAJOB,QRSTACK,"STUDY",I)=VALUE
+43 IF '$TEST
SET ^XTMP(MAGXTMP,HOSTNAME,VISTAJOB,QRSTACK,"STUDY",I,J,VARIABLE)=VALUE
+44 QUIT
End DoDot:3
+45 IF '$TEST
IF LEVEL="SERIES"
Begin DoDot:3
+46 IF K=""
SET ^XTMP(MAGXTMP,HOSTNAME,VISTAJOB,QRSTACK,"SERIES",I,J)=VALUE
+47 IF '$TEST
SET ^XTMP(MAGXTMP,HOSTNAME,VISTAJOB,QRSTACK,"SERIES",I,J,K,VARIABLE)=VALUE
+48 QUIT
End DoDot:3
+49 IF '$TEST
IF LEVEL="IMAGE"
Begin DoDot:3
+50 IF L=""
SET ^XTMP(MAGXTMP,HOSTNAME,VISTAJOB,QRSTACK,"IMAGE",I,J,K)=VALUE
+51 IF '$TEST
SET ^XTMP(MAGXTMP,HOSTNAME,VISTAJOB,QRSTACK,"IMAGE",I,J,K,L,VARIABLE)=VALUE
+52 QUIT
End DoDot:3
+53 IF '$TEST
IF LEVEL="DONE"
Begin DoDot:3
+54 ; "DONE" uses the request IEN for proper synchronization
+55 SET ^XTMP(MAGXTMP,HOSTNAME,VISTAJOB,QRSTACK,"DONE",IEN2006541)=$$NOW^XLFDT_"^"_VARIABLE_"^"_VALUE
+56 QUIT
End DoDot:3
+57 IF '$TEST
IF LEVEL="WORKING..."
Begin DoDot:3
+58 SET ^XTMP(MAGXTMP,HOSTNAME,VISTAJOB,QRSTACK,"WORKING...",IEN2006541)=$$NOW^XLFDT_"^"_VARIABLE_"^"_VALUE
+59 QUIT
End DoDot:3
+60 IF '$TEST
IF LEVEL="MESSAGE"
Begin DoDot:3
+61 SET ^XTMP(MAGXTMP,HOSTNAME,VISTAJOB,QRSTACK,"MESSAGE",VARIABLE,I)=VALUE
+62 QUIT
End DoDot:3
+63 ; throw an error (line of code written on 3/14)
IF '$TEST
SET PI=CIRCUMFERENCE/DIAMETER
+64 QUIT
End DoDot:2
QUIT
+65 ; save retrieve results in ^XTMP
IF OPCODE="RETRIEVE RESULT"
Begin DoDot:2
+66 SET MAGXTMP=$PIECE(ARGS,"|",1)
SET HOSTNAME=$PIECE(ARGS,"|",2)
SET VISTAJOB=$PIECE(ARGS,"|",3)
+67 SET QRSTACK=$PIECE(ARGS,"|",4)
+68 ; IEN2006541 is not used here
SET IEN2006541=$PIECE(ARGS,"|",5)
+69 SET ACNUMB=$PIECE(ARGS,"|",6)
SET X=$PIECE(ARGS,"|",7,999)
+70 SET ^XTMP(MAGXTMP,HOSTNAME,VISTAJOB,QRSTACK,"Q/R RETRIEVE STATUS",ACNUMB)=X
+71 QUIT
End DoDot:2
QUIT
+72 IF OPCODE="CRASH"
Begin DoDot:2
+73 ; generate an error on the server to test error trapping
SET I=1/0
+74 QUIT
End DoDot:2
QUIT
+75 QUIT
End DoDot:1
+76 QUIT
+77 ;
RESULT(OPCODE,ARGS) ; add an item to the RESULT list
+1 ; first element in array is counter
SET RESULT(1)=$GET(RESULT(1),1)+1
+2 SET RESULT(RESULT(1))=OPCODE_"|"_ARGS
+3 QUIT
