MAGDRA3 ;WOIFO/LB - Routine to lookup patient by casenumber of name ; 05 Apr 2011 8:50 AM
;;3.0;IMAGING;**49**;Mar 19, 2002;Build 2033;Apr 07, 2011
;; 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
ASK() ;Prompt user
N DIR,X,Y
S DIR(0)="F:1:30",DIR("A")="Enter patient or case number"
S DIR("?")="Enter a patient name or case number to associate this image."
D ^DIR
Q Y
READ(RESULT) ;
N ANS
S RESULT=0,ANS=$$ASK
I ANS=""!(ANS="^") S RESULT="^" Q RESULT
I ANS?1.5N!(ANS?6N1"-".N)!(ANS?3N1"-"6N1"-".N) D CASE(ANS,.RESULT) I +RESULT Q RESULT
I ANS?1.8N Q RESULT ;Incomplete ssn sent. Couldn't be a case number?
D:ANS'?.N1"-".E PAT(ANS,.RESULT)
Q RESULT
CASE(CASE,RESULT) ;
N MAGXR,MAGDFN,MAGDTI,MAGCNI,ARESULT
S MAGXR=$S($L(CASE,"-")>1:"RAAPI",1:"AE")
I MAGXR="RAAPI",$$ACCFIND^RAAPI(CASE,.ARESULT)>0 S RESULT=$TR(ARESULT(1),"^","~")
I MAGXR="AE",$D(^RADPT(MAGXR,CASE)) D
. S MAGDFN=$O(^RADPT(MAGXR,CASE,0))
. S MAGDTI=$O(^RADPT(MAGXR,CASE,MAGDFN,0))
. S MAGCNI=$O(^RADPT(MAGXR,CASE,MAGDFN,MAGDTI,0))
. S RESULT=MAGDFN_"~"_MAGDTI_"~"_MAGCNI
Q
PAT(PAT,RESULT) ;
N DIR,X,Y
S DIR(0)="P^70:EMZ",DIR("B")=PAT
D ^DIR
S RESULT=Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDRA3 2134 printed Sep 23, 2025@19:37:27 Page 2
MAGDRA3 ;WOIFO/LB - Routine to lookup patient by casenumber of name ; 05 Apr 2011 8:50 AM
+1 ;;3.0;IMAGING;**49**;Mar 19, 2002;Build 2033;Apr 07, 2011
+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
ASK() ;Prompt user
+1 NEW DIR,X,Y
+2 SET DIR(0)="F:1:30"
SET DIR("A")="Enter patient or case number"
+3 SET DIR("?")="Enter a patient name or case number to associate this image."
+4 DO ^DIR
+5 QUIT Y
READ(RESULT) ;
+1 NEW ANS
+2 SET RESULT=0
SET ANS=$$ASK
+3 IF ANS=""!(ANS="^")
SET RESULT="^"
QUIT RESULT
+4 IF ANS?1.5N!(ANS?6N1"-".N)!(ANS?3N1"-"6N1"-".N)
DO CASE(ANS,.RESULT)
IF +RESULT
QUIT RESULT
+5 ;Incomplete ssn sent. Couldn't be a case number?
IF ANS?1.8N
QUIT RESULT
+6 if ANS'?.N1"-".E
DO PAT(ANS,.RESULT)
+7 QUIT RESULT
CASE(CASE,RESULT) ;
+1 NEW MAGXR,MAGDFN,MAGDTI,MAGCNI,ARESULT
+2 SET MAGXR=$SELECT($LENGTH(CASE,"-")>1:"RAAPI",1:"AE")
+3 IF MAGXR="RAAPI"
IF $$ACCFIND^RAAPI(CASE,.ARESULT)>0
SET RESULT=$TRANSLATE(ARESULT(1),"^","~")
+4 IF MAGXR="AE"
IF $DATA(^RADPT(MAGXR,CASE))
Begin DoDot:1
+5 SET MAGDFN=$ORDER(^RADPT(MAGXR,CASE,0))
+6 SET MAGDTI=$ORDER(^RADPT(MAGXR,CASE,MAGDFN,0))
+7 SET MAGCNI=$ORDER(^RADPT(MAGXR,CASE,MAGDFN,MAGDTI,0))
+8 SET RESULT=MAGDFN_"~"_MAGDTI_"~"_MAGCNI
End DoDot:1
+9 QUIT
PAT(PAT,RESULT) ;
+1 NEW DIR,X,Y
+2 SET DIR(0)="P^70:EMZ"
SET DIR("B")=PAT
+3 DO ^DIR
+4 SET RESULT=Y
+5 QUIT
