MAGDSTQ7 ;WOIFO/PMK - Study Tracker - Query/Retrieve user patient lookup ; Jul 01, 2020@10:00:22
;;3.0;IMAGING;**231**;Mar 19, 2002;Build 9;Feb 27, 2015
;; 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. |
;; +---------------------------------------------------------------+
;;
;
; Notice: This routine is on both VistA and the DICOM Gateway
;
Q
;
; Entry point from ^MAGDSTQ1 for manual Q/R client
PATIENTQ ; need current and previous PII
N CLIENT S CLIENT="MANUAL" ; set the patient lookup CLIENT for manual Q/R client
N CHANGED,CHANGEDATE,DFN,DOB,DOD,FINIS,HISTINFO,IHISTINFO,IPATINFO
N K,NAME,NODE,OK,PATINFO,PROMPT,RETURN,SENSITIVE,SEX,SSN,X,Y
;
; PATINFO is not used in this subroutine
;
S DFN=$G(^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"PATIENT DFN"))
S PROMPT="patient"
S IPATINFO=$$PATIENT^MAGDSTQA(.PATINFO,.DFN) ; find the patient
I IPATINFO D
. D HISTLKUP^MAGDSTQA(.HISTINFO,DFN) ; get previous PII, if any
. I HISTINFO(0)>1 D ; select the appropriate version of PII
. . S PROMPT="patient identification information"
. . S IHISTINFO=$$PATIENT2^MAGDSTQA("PII CHANGES",.HISTINFO,1) ; select previous PII interaction
. . I IHISTINFO D SAVEKEYS(.HISTINFO,IHISTINFO)
. . Q
. E D ; only one version of PII
. . D SAVEKEYS(.PATINFO,IPATINFO)
. . Q
. Q
Q
;
SAVEKEYS(INFO,I) ; save the query keys
N DAY,PIDDASHES,MONTH,YEAR
D GETINFO^MAGDSTQA(.INFO,I)
I CHANGED="" D ; today's pii values, get DICOM formatted name
. D DCMNAME(.NAME,DFN)
. Q
S PIDDASHES=$G(^TMP("MAG",$J,"Q/R PARAM","PATIENT ID DASHES"))
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"PATIENT NAME")=$TR(NAME,",","^")
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"PATIENT ID")=$S(PIDDASHES="N":$TR(SSN,"-"),1:SSN)
I $L(DOB)=4 S YEAR=DOB,(MONTH,DAY)="01"
E S YEAR=$E(DOB,7,10),MONTH=$E(DOB,1,2),DAY=$E(DOB,4,5)
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"PATIENT BIRTH DATE")=YEAR_MONTH_DAY
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"PATIENT'S SEX")=$E(SEX,1)
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"PATIENT DFN")=DFN
Q
;
DCMNAME(OUTPUT,DFN) ; get properly formatted DICOM patient name
; DICOM: family ^ given ^ middle ^ prefix ^ suffix
;
N I
I $$VISTA^MAGDSTQ D ; VistA code - call API
. D DCMNAME^MAGDSTA3(.OUTPUT,DFN)
. Q
E D ; DICOM Gateway code - call RPC
. N RPCERR
. S RPCERR=$$CALLRPC^MAGM2VCU("MAG DICOM FORMAT PATIENT NAME","M",.OUTPUT,DFN)
. I RPCERR<0 D S OUTPUT(0)=-1 Q
. . D ERRORMSG^MAGDSTQ0(1,"Error in MAG DICOM FORMAT PATIENT NAME rpc",.OUTPUT)
. . Q
. Q
; remove trailing delimiters
F I=$L(OUTPUT):-1:1 Q:$E(OUTPUT,I)'="^" S $E(OUTPUT,I)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDSTQ7 3495 printed Sep 02, 2024@18:47:14 Page 2
MAGDSTQ7 ;WOIFO/PMK - Study Tracker - Query/Retrieve user patient lookup ; Jul 01, 2020@10:00:22
+1 ;;3.0;IMAGING;**231**;Mar 19, 2002;Build 9;Feb 27, 2015
+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 ; Notice: This routine is on both VistA and the DICOM Gateway
+19 ;
+20 QUIT
+21 ;
+22 ; Entry point from ^MAGDSTQ1 for manual Q/R client
PATIENTQ ; need current and previous PII
+1 ; set the patient lookup CLIENT for manual Q/R client
NEW CLIENT
SET CLIENT="MANUAL"
+2 NEW CHANGED,CHANGEDATE,DFN,DOB,DOD,FINIS,HISTINFO,IHISTINFO,IPATINFO
+3 NEW K,NAME,NODE,OK,PATINFO,PROMPT,RETURN,SENSITIVE,SEX,SSN,X,Y
+4 ;
+5 ; PATINFO is not used in this subroutine
+6 ;
+7 SET DFN=$GET(^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"PATIENT DFN"))
+8 SET PROMPT="patient"
+9 ; find the patient
SET IPATINFO=$$PATIENT^MAGDSTQA(.PATINFO,.DFN)
+10 IF IPATINFO
Begin DoDot:1
+11 ; get previous PII, if any
DO HISTLKUP^MAGDSTQA(.HISTINFO,DFN)
+12 ; select the appropriate version of PII
IF HISTINFO(0)>1
Begin DoDot:2
+13 SET PROMPT="patient identification information"
+14 ; select previous PII interaction
SET IHISTINFO=$$PATIENT2^MAGDSTQA("PII CHANGES",.HISTINFO,1)
+15 IF IHISTINFO
DO SAVEKEYS(.HISTINFO,IHISTINFO)
+16 QUIT
End DoDot:2
+17 ; only one version of PII
IF '$TEST
Begin DoDot:2
+18 DO SAVEKEYS(.PATINFO,IPATINFO)
+19 QUIT
End DoDot:2
+20 QUIT
End DoDot:1
+21 QUIT
+22 ;
SAVEKEYS(INFO,I) ; save the query keys
+1 NEW DAY,PIDDASHES,MONTH,YEAR
+2 DO GETINFO^MAGDSTQA(.INFO,I)
+3 ; today's pii values, get DICOM formatted name
IF CHANGED=""
Begin DoDot:1
+4 DO DCMNAME(.NAME,DFN)
+5 QUIT
End DoDot:1
+6 SET PIDDASHES=$GET(^TMP("MAG",$JOB,"Q/R PARAM","PATIENT ID DASHES"))
+7 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"PATIENT NAME")=$TRANSLATE(NAME,",","^")
+8 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"PATIENT ID")=$SELECT(PIDDASHES="N":$TRANSLATE(SSN,"-"),1:SSN)
+9 IF $LENGTH(DOB)=4
SET YEAR=DOB
SET (MONTH,DAY)="01"
+10 IF '$TEST
SET YEAR=$EXTRACT(DOB,7,10)
SET MONTH=$EXTRACT(DOB,1,2)
SET DAY=$EXTRACT(DOB,4,5)
+11 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"PATIENT BIRTH DATE")=YEAR_MONTH_DAY
+12 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"PATIENT'S SEX")=$EXTRACT(SEX,1)
+13 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"PATIENT DFN")=DFN
+14 QUIT
+15 ;
DCMNAME(OUTPUT,DFN) ; get properly formatted DICOM patient name
+1 ; DICOM: family ^ given ^ middle ^ prefix ^ suffix
+2 ;
+3 NEW I
+4 ; VistA code - call API
IF $$VISTA^MAGDSTQ
Begin DoDot:1
+5 DO DCMNAME^MAGDSTA3(.OUTPUT,DFN)
+6 QUIT
End DoDot:1
+7 ; DICOM Gateway code - call RPC
IF '$TEST
Begin DoDot:1
+8 NEW RPCERR
+9 SET RPCERR=$$CALLRPC^MAGM2VCU("MAG DICOM FORMAT PATIENT NAME","M",.OUTPUT,DFN)
+10 IF RPCERR<0
Begin DoDot:2
+11 DO ERRORMSG^MAGDSTQ0(1,"Error in MAG DICOM FORMAT PATIENT NAME rpc",.OUTPUT)
+12 QUIT
End DoDot:2
SET OUTPUT(0)=-1
QUIT
+13 QUIT
End DoDot:1
+14 ; remove trailing delimiters
+15 FOR I=$LENGTH(OUTPUT):-1:1
if $EXTRACT(OUTPUT,I)'="^"
QUIT
SET $EXTRACT(OUTPUT,I)=""
+16 QUIT
