MAGDSTV2 ;WOIFO/PMK - Process a Q/R Client RPC; Jul 05, 2022@13:48:58
;;3.0;IMAGING;**231,333**;Mar 19, 2002;Build 2
;; Per VA Directive 6402, this routine should not be modified.
;; +---------------------------------------------------------------+
;; | Property of the US Government. |
;; | No permission to copy or redistribute this software is given. |
;; | |
;; | 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 DIVISION ;- user's location
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
;
S DIVISION=$G(DUZ(2),0) ; user's logon division -- P333 PMK 07/05/2022
;
; 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,DIVISION,1,"ACOUNT"))+1
. . I '$D(^MAGDSTT(2006.541,DIVISION,1,NEXTIEN)) D RESULT("QR-REQUEST","NONE") Q
. . ; if another RPC is already processing this request, skip it
. . L +^MAGDSTT(2006.541,DIVISION,1,"ACOUNT"):0 E D RESULT("QR-REQUEST","NONE") Q
. . S VALUE=^MAGDSTT(2006.541,DIVISION,1,NEXTIEN,0)_"^"_NEXTIEN
. . D RESULT("QR-REQUEST",VALUE)
. . S J=0
. . F S J=$O(^MAGDSTT(2006.541,DIVISION,1,NEXTIEN,1,J)) Q:'J D
. . . S VALUE=^MAGDSTT(2006.541,DIVISION,1,NEXTIEN,1,J,0)
. . . D RESULT("KEY",VALUE)
. . . Q
. . S ^MAGDSTT(2006.541,DIVISION,1,"ACOUNT")=NEXTIEN
. . L -^MAGDSTT(2006.541,DIVISION,1,"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
. . ;
. . ; only store this if the monitor is running - P333 PMK 03/15/2022
. . I $$ENABLED^MAGDSTV1 D
. . . S (J,^(0))=$G(^XTMP(MAGXTMP,"Q/R RETRIEVE STATUS",0),0)+1
. . . S ^XTMP(MAGXTMP,"Q/R RETRIEVE STATUS",J)=$P(ARGS,"|",6,999)
. . . Q
. . 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 5105 printed Mar 25, 2026@15:26:43 Page 2
MAGDSTV2 ;WOIFO/PMK - Process a Q/R Client RPC; Jul 05, 2022@13:48:58
+1 ;;3.0;IMAGING;**231,333**;Mar 19, 2002;Build 2
+2 ;; Per VA Directive 6402, 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 ;; | |
+7 ;; | The Food and Drug Administration classifies this software as |
+8 ;; | a medical device. As such, it may not be changed in any way. |
+9 ;; | Modifications to this software may result in an adulterated |
+10 ;; | medical device under 21CFR820, the use of which is considered |
+11 ;; | to be a violation of US Federal Statutes. |
+12 ;; +---------------------------------------------------------------+
+13 ;;
+14 ;
+15 ; Supported IA #10103 reference $$NOW^XLFDT function call
+16 ;
+17 QUIT
+18 ; M2MB server
+19 ;
+20 ; This routine is invoked by the M2M Broker RPC to handle a Q/R client.
+21 ;
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 ;- user's location
NEW DIVISION
+6 ;-- code for an error, if encountered
NEW ERRCODE
+7 ;- pointer to item in REQUEST array
NEW IREQUEST
+8 ; ----- error message array
NEW MSG
+9 ;--- operation code of the REQUEST item
NEW OPCODE
+10 ;--- intermediate return code
NEW RETURN
+11 ;-------- scratch variable
NEW J
+12 ;
+13 ; user's logon division -- P333 PMK 07/05/2022
SET DIVISION=$GET(DUZ(2),0)
+14 ;
+15 ; pass the request list and determine what has to be done
+16 FOR IREQUEST=2:1:$GET(REQUEST(1))
Begin DoDot:1
+17 SET OPCODE=$PIECE(REQUEST(IREQUEST),"|")
+18 SET ARGS=$PIECE(REQUEST(IREQUEST),"|",2,999)
+19 ;
+20 IF OPCODE="NEXT"
Begin DoDot:2
+21 SET NEXTIEN=$GET(^MAGDSTT(2006.541,DIVISION,1,"ACOUNT"))+1
+22 IF '$DATA(^MAGDSTT(2006.541,DIVISION,1,NEXTIEN))
DO RESULT("QR-REQUEST","NONE")
QUIT
+23 ; if another RPC is already processing this request, skip it
+24 LOCK +^MAGDSTT(2006.541,DIVISION,1,"ACOUNT"):0
IF '$TEST
DO RESULT("QR-REQUEST","NONE")
QUIT
+25 SET VALUE=^MAGDSTT(2006.541,DIVISION,1,NEXTIEN,0)_"^"_NEXTIEN
+26 DO RESULT("QR-REQUEST",VALUE)
+27 SET J=0
+28 FOR
SET J=$ORDER(^MAGDSTT(2006.541,DIVISION,1,NEXTIEN,1,J))
if 'J
QUIT
Begin DoDot:3
+29 SET VALUE=^MAGDSTT(2006.541,DIVISION,1,NEXTIEN,1,J,0)
+30 DO RESULT("KEY",VALUE)
+31 QUIT
End DoDot:3
+32 SET ^MAGDSTT(2006.541,DIVISION,1,"ACOUNT")=NEXTIEN
+33 LOCK -^MAGDSTT(2006.541,DIVISION,1,"ACOUNT")
+34 QUIT
End DoDot:2
QUIT
+35 ;
+36 ; save query results in ^XTMP
IF OPCODE="QUERY RESULT"
Begin DoDot:2
+37 NEW V,VARS,VAR
+38 SET VARS="MAGXTMP^HOSTNAME^VISTAJOB^QRSTACK^IEN2006541^LEVEL^I^J^K^L^VARIABLE^VALUE"
+39 FOR V=1:1:$LENGTH(VARS,"^")
SET VAR=$PIECE(VARS,"^",V)
NEW @VAR
SET @VAR=$PIECE(ARGS,"|",V)
+40 IF LEVEL="PATIENT"
Begin DoDot:3
+41 IF I=""
SET ^XTMP(MAGXTMP,HOSTNAME,VISTAJOB,QRSTACK,"PATIENT")=VALUE
+42 IF '$TEST
SET ^XTMP(MAGXTMP,HOSTNAME,VISTAJOB,QRSTACK,"PATIENT",I,VARIABLE)=VALUE
+43 QUIT
End DoDot:3
+44 IF '$TEST
IF LEVEL="STUDY"
Begin DoDot:3
+45 IF J=""
SET ^XTMP(MAGXTMP,HOSTNAME,VISTAJOB,QRSTACK,"STUDY",I)=VALUE
+46 IF '$TEST
SET ^XTMP(MAGXTMP,HOSTNAME,VISTAJOB,QRSTACK,"STUDY",I,J,VARIABLE)=VALUE
+47 QUIT
End DoDot:3
+48 IF '$TEST
IF LEVEL="SERIES"
Begin DoDot:3
+49 IF K=""
SET ^XTMP(MAGXTMP,HOSTNAME,VISTAJOB,QRSTACK,"SERIES",I,J)=VALUE
+50 IF '$TEST
SET ^XTMP(MAGXTMP,HOSTNAME,VISTAJOB,QRSTACK,"SERIES",I,J,K,VARIABLE)=VALUE
+51 QUIT
End DoDot:3
+52 IF '$TEST
IF LEVEL="IMAGE"
Begin DoDot:3
+53 IF L=""
SET ^XTMP(MAGXTMP,HOSTNAME,VISTAJOB,QRSTACK,"IMAGE",I,J,K)=VALUE
+54 IF '$TEST
SET ^XTMP(MAGXTMP,HOSTNAME,VISTAJOB,QRSTACK,"IMAGE",I,J,K,L,VARIABLE)=VALUE
+55 QUIT
End DoDot:3
+56 IF '$TEST
IF LEVEL="DONE"
Begin DoDot:3
+57 ; "DONE" uses the request IEN for proper synchronization
+58 SET ^XTMP(MAGXTMP,HOSTNAME,VISTAJOB,QRSTACK,"DONE",IEN2006541)=$$NOW^XLFDT_"^"_VARIABLE_"^"_VALUE
+59 QUIT
End DoDot:3
+60 IF '$TEST
IF LEVEL="WORKING..."
Begin DoDot:3
+61 SET ^XTMP(MAGXTMP,HOSTNAME,VISTAJOB,QRSTACK,"WORKING...",IEN2006541)=$$NOW^XLFDT_"^"_VARIABLE_"^"_VALUE
+62 QUIT
End DoDot:3
+63 IF '$TEST
IF LEVEL="MESSAGE"
Begin DoDot:3
+64 SET ^XTMP(MAGXTMP,HOSTNAME,VISTAJOB,QRSTACK,"MESSAGE",VARIABLE,I)=VALUE
+65 QUIT
End DoDot:3
+66 ; throw an error (line of code written on 3/14)
IF '$TEST
SET PI=CIRCUMFERENCE/DIAMETER
+67 QUIT
End DoDot:2
QUIT
+68 ; save retrieve results in ^XTMP
IF OPCODE="RETRIEVE RESULT"
Begin DoDot:2
+69 SET MAGXTMP=$PIECE(ARGS,"|",1)
SET HOSTNAME=$PIECE(ARGS,"|",2)
SET VISTAJOB=$PIECE(ARGS,"|",3)
+70 SET QRSTACK=$PIECE(ARGS,"|",4)
+71 ; IEN2006541 is not used here
SET IEN2006541=$PIECE(ARGS,"|",5)
+72 SET ACNUMB=$PIECE(ARGS,"|",6)
SET X=$PIECE(ARGS,"|",7,999)
+73 SET ^XTMP(MAGXTMP,HOSTNAME,VISTAJOB,QRSTACK,"Q/R RETRIEVE STATUS",ACNUMB)=X
+74 ;
+75 ; only store this if the monitor is running - P333 PMK 03/15/2022
+76 IF $$ENABLED^MAGDSTV1
Begin DoDot:3
+77 SET (J,^(0))=$GET(^XTMP(MAGXTMP,"Q/R RETRIEVE STATUS",0),0)+1
+78 SET ^XTMP(MAGXTMP,"Q/R RETRIEVE STATUS",J)=$PIECE(ARGS,"|",6,999)
+79 QUIT
End DoDot:3
+80 QUIT
+81 ;
End DoDot:2
QUIT
+82 IF OPCODE="CRASH"
Begin DoDot:2
+83 ; generate an error on the server to test error trapping
SET I=1/0
+84 QUIT
End DoDot:2
QUIT
+85 QUIT
End DoDot:1
+86 QUIT
+87 ;
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
