MAGDCCS3 ;WOIFO/MLH - DICOM Correct - Clinical specialties - subroutines ; 14 Jul 2003 11:24 AM
;;3.0;IMAGING;**10,11**;14-April-2004
;; +---------------------------------------------------------------+
;; | 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 request/consultation number"
S DIR("?")="Enter a patient name or request/consultation number to associate with this image."
D ^DIR
Q Y
READ(RESULT) ; Accept input for patient or request/consultation number.
; We'll return patient DFN^NAME, or DFN~REQNO.
N ANS
S RESULT=0,ANS=$$ASK
I ANS=""!(ANS="^") S RESULT="^" Q RESULT
;Is user trying to select on request/consult # or by patient?
I ANS?1.8N D REQCON(ANS,.RESULT) I +RESULT Q RESULT ; request/consult #
D:ANS'?.N1"-".E PAT(ANS,.RESULT) ; patient
Q RESULT
REQCON(GMRIEN,RESULT) ; Validate existence of user-entered request/consultation number.
;
S RESULT=$$GET1^DIQ(123,GMRIEN,.02,"I") ; get the patient's DFN value
I RESULT'="" S RESULT=RESULT_"~"_GMRIEN
Q
PAT(PAT,RESULT) ; Verify that patient exists and has requests/consults on file.
N DIR,X,Y
S DIR(0)="P^2:EMZ",DIR("B")=PAT
D ^DIR
I Y D
. W !,"Y=",Y,! ; ***<<< DEBUG
. I $$ANYREQ^MAGDGMRC(+Y) S RESULT=Y
. E W !,"No requests/consultations on file for this patient.",!
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDCCS3 2254 printed Nov 22, 2024@17:09:53 Page 2
MAGDCCS3 ;WOIFO/MLH - DICOM Correct - Clinical specialties - subroutines ; 14 Jul 2003 11:24 AM
+1 ;;3.0;IMAGING;**10,11**;14-April-2004
+2 ;; +---------------------------------------------------------------+
+3 ;; | Property of the US Government. |
+4 ;; | No permission to copy or redistribute this software is given. |
+5 ;; | Use of unreleased versions of this software requires the user |
+6 ;; | to execute a written test agreement with the VistA Imaging |
+7 ;; | Development Office of the Department of Veterans Affairs, |
+8 ;; | telephone (301) 734-0100. |
+9 ;; | |
+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 request/consultation number"
+3 SET DIR("?")="Enter a patient name or request/consultation number to associate with this image."
+4 DO ^DIR
+5 QUIT Y
READ(RESULT) ; Accept input for patient or request/consultation number.
+1 ; We'll return patient DFN^NAME, or DFN~REQNO.
+2 NEW ANS
+3 SET RESULT=0
SET ANS=$$ASK
+4 IF ANS=""!(ANS="^")
SET RESULT="^"
QUIT RESULT
+5 ;Is user trying to select on request/consult # or by patient?
+6 ; request/consult #
IF ANS?1.8N
DO REQCON(ANS,.RESULT)
IF +RESULT
QUIT RESULT
+7 ; patient
if ANS'?.N1"-".E
DO PAT(ANS,.RESULT)
+8 QUIT RESULT
REQCON(GMRIEN,RESULT) ; Validate existence of user-entered request/consultation number.
+1 ;
+2 ; get the patient's DFN value
SET RESULT=$$GET1^DIQ(123,GMRIEN,.02,"I")
+3 IF RESULT'=""
SET RESULT=RESULT_"~"_GMRIEN
+4 QUIT
PAT(PAT,RESULT) ; Verify that patient exists and has requests/consults on file.
+1 NEW DIR,X,Y
+2 SET DIR(0)="P^2:EMZ"
SET DIR("B")=PAT
+3 DO ^DIR
+4 IF Y
Begin DoDot:1
+5 ; ***<<< DEBUG
WRITE !,"Y=",Y,!
+6 IF $$ANYREQ^MAGDGMRC(+Y)
SET RESULT=Y
+7 IF '$TEST
WRITE !,"No requests/consultations on file for this patient.",!
+8 QUIT
End DoDot:1
+9 QUIT
