MAGGSIV1 ;WOIFO/GEK - Imaging Validate Data ; [ 08/15/2004 08:57 ]
;;3.0;IMAGING;**8,20,59**;Nov 27, 2007;Build 20
;;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
VALID(MAGF,MAGL,MAGD,MAGRES) ; call to validate value for field in a FM file.
; Function is boolean. Returns:
; 0 - Invalid
; 1 - Valid
; "" - Error
; Call this function before you set the FDA Array.
; MAGD - sent by reference because it could be Internal or External
; and if it is external and valid, it is changed to Internal.
;
; MAGF : File Number
; MAGL : Field Number
; MAGD : (sent by reference) data value of field
; MAGRES: (sent by reference) Result message
;
N $ETRAP,$ESTACK S $ETRAP="D ERR^"_$T(+0)
N MAGR,MAGMSG,MAGSP,MAGRESA,MAGE,MAGPT
;if a BAD field number
I '$$VFIELD^DILFD(MAGF,MAGL) D Q 0
. S MAGRES="The field number: "_MAGL_", in File: "_MAGF_", is invalid."
D FIELD^DID(MAGF,MAGL,"","SPECIFIER","MAGSP")
; If it is a pointer field
; If an integer - We assume it is a pointer and validate that and Quit.
; If not integer - We assume it is external value, proceed to let CHK do validate
I (MAGSP("SPECIFIER")["P"),(+MAGD=MAGD) D Q MAGPT
. I $$EXTERNAL^DILFD(MAGF,MAGL,"",MAGD)'="" S MAGPT=1,MAGRES="Valid pointer" Q
. S MAGPT=0,MAGRES="The value: "_MAGD_" for field: "_MAGL_" in File: "_MAGF_" is an invalid Pointer."
. Q
;
D CHK^DIE(MAGF,MAGL,"E",MAGD,.MAGR,"MAGMSG")
; If success, Quit. We changed External to Internal. Internal is in MAGR
I MAGR'="^" S MAGD=MAGR Q 1
; If not success Get the error text and Quit 0
D MSG^DIALOG("A",.MAGRESA,245,5,"MAGMSG")
S MAGRES=MAGRESA(1)
Q 0
VALINDEX(MAGRY,TYPE,SPEC,PROC) ; Validate the interdependency of Index Terms.
; MAGRY is the return array
; MAGRY(0)="1^Okay" or "0^error message"
; MAGRY(1..n) Information about the Type,Spec and Proc
;
; Validate the Procedure/Event <-> Specialty/SubSpecialty interdependency
; Assure the TYPE is a Clinical TYPE.
; Assure all are Active.
N CLS,RES,ARR,TYX,PRX,SPX,OK
K MAGRY
S TYPE=$G(TYPE),PROC=$G(PROC),SPEC=$G(SPEC)
I TYPE=0 S TYPE=""
I PROC=0 S PROC=""
I SPEC=0 S SPEC=""
I ((PROC]"")!(SPEC]"")) I TYPE="" S MAGRY(0)="0^Type is required." Q 0
; TYPE is required, but not enforcing yet. All vendors are not sending
; index values.
; VALID will accept External or Internal and return Internal if Valid
I $L(TYPE) I '$$VALID(2005,42,.TYPE,.RES) S MAGRY(0)="0^"_RES Q 0
I $L(PROC) I '$$VALID(2005,43,.PROC,.RES) S MAGRY(0)="0^"_RES Q 0
I $L(SPEC) I '$$VALID(2005,44,.SPEC,.RES) S MAGRY(0)="0^"_RES Q 0
;
I TYPE D I 'OK S MAGRY(0)=OK Q 0
. S OK=1,TYX=TYPE_","
. K ARR D GETS^DIQ(2005.83,TYX,".01;1;2","EI","ARR")
. S MAGRY(1)="Type - Class : "_ARR(2005.83,TYX,.01,"E")_" - "_ARR(2005.83,TYX,1,"E")
. I $L(ARR(2005.83,TYX,2,"E")) S MAGRY(1)=MAGRY(1)_" - "_ARR(2005.83,TYX,2,"E")
. I ARR(2005.83,TYX,2,"I")="I" S OK="0^Type is Inactive"
. Q
;
I SPEC D I 'OK S MAGRY(0)=OK Q 0
. S OK=1,SPX=SPEC_","
. K ARR D GETS^DIQ(2005.84,SPX,".01;2;4","EI","ARR")
. S MAGRY(2)="Specialty/SubSpecialty: "_ARR(2005.84,SPX,.01,"E")
. I $L(ARR(2005.84,SPX,4,"E")) S MAGRY(2)=MAGRY(2)_" - "_ARR(2005.84,SPX,4,"E")
. I $L(ARR(2005.84,SPX,2,"E")) S MAGRY(2)=MAGRY(2)_" <"_ARR(2005.84,SPX,2,"E")_">"
. I ARR(2005.84,SPX,4,"I")="I" S OK="0^Specialty is Inactive"
. Q
;
I PROC D I 'OK S MAGRY(0)=OK Q 0
. S OK=1,PRX=PROC_","
. K ARR D GETS^DIQ(2005.85,PRX,".01;4","EI","ARR")
. S MAGRY(4)="Procedure/Event : "_$$GET1^DIQ(2005.85,PROC,.01)
. I $L(ARR(2005.85,PRX,4,"E")) S MAGRY(4)=MAGRY(4)_" - "_ARR(2005.85,PRX,4,"E")
. I ARR(2005.85,PRX,4,"I")="I" S OK="0^Procedure is Inactive"
. Q
;
; If PROC and SPEC are "", then Quit, any TYPE by itself is valid
I (PROC=""),(SPEC="") S MAGRY(0)="1^Okay" Q 1
; Here, TYPE has to be Clin.
S CLS=$$GET1^DIQ(2005.83,TYPE,1,"","MAGTAR") I $E(CLS,1,5)="ADMIN" D Q 0
. S MAGRY(0)="0^The Type Index is Administrative, it has to be Clinical."
I (PROC="")!(SPEC="") S MAGRY(0)="1^Okay" Q 1
; we get here, we have to validate the interdependency of SPEC <-> PROC.
I '$O(^MAG(2005.85,PROC,1,0)) S MAGRY(0)="1^Okay" Q 1
I '$D(^MAG(2005.85,PROC,1,"B",SPEC)) D Q 0
. S MAGRY(0)="0^Invalid Association between Spec/SubSpec and Proc/Event"
. Q
S MAGRY(0)="1^Okay"
Q 1
ERR ;
N ERR
S ERR=$$EC^%ZOSV
S MAGRES="0^Error during data validation: "_ERR
D LOGERR^MAGGTERR(ERR)
D @^%ZOSF("ERRTN")
D CLEAN^DILF
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGGSIV1 5583 printed Apr 09, 2024@21:10:56 Page 2
MAGGSIV1 ;WOIFO/GEK - Imaging Validate Data ; [ 08/15/2004 08:57 ]
+1 ;;3.0;IMAGING;**8,20,59**;Nov 27, 2007;Build 20
+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 ;; | |
+11 ;; | The Food and Drug Administration classifies this software as |
+12 ;; | a medical device. As such, it may not be changed in any way. |
+13 ;; | Modifications to this software may result in an adulterated |
+14 ;; | medical device under 21CFR820, the use of which is considered |
+15 ;; | to be a violation of US Federal Statutes. |
+16 ;; +---------------------------------------------------------------+
+17 ;;
+18 QUIT
VALID(MAGF,MAGL,MAGD,MAGRES) ; call to validate value for field in a FM file.
+1 ; Function is boolean. Returns:
+2 ; 0 - Invalid
+3 ; 1 - Valid
+4 ; "" - Error
+5 ; Call this function before you set the FDA Array.
+6 ; MAGD - sent by reference because it could be Internal or External
+7 ; and if it is external and valid, it is changed to Internal.
+8 ;
+9 ; MAGF : File Number
+10 ; MAGL : Field Number
+11 ; MAGD : (sent by reference) data value of field
+12 ; MAGRES: (sent by reference) Result message
+13 ;
+14 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERR^"_$TEXT(+0)
+15 NEW MAGR,MAGMSG,MAGSP,MAGRESA,MAGE,MAGPT
+16 ;if a BAD field number
+17 IF '$$VFIELD^DILFD(MAGF,MAGL)
Begin DoDot:1
+18 SET MAGRES="The field number: "_MAGL_", in File: "_MAGF_", is invalid."
End DoDot:1
QUIT 0
+19 DO FIELD^DID(MAGF,MAGL,"","SPECIFIER","MAGSP")
+20 ; If it is a pointer field
+21 ; If an integer - We assume it is a pointer and validate that and Quit.
+22 ; If not integer - We assume it is external value, proceed to let CHK do validate
+23 IF (MAGSP("SPECIFIER")["P")
IF (+MAGD=MAGD)
Begin DoDot:1
+24 IF $$EXTERNAL^DILFD(MAGF,MAGL,"",MAGD)'=""
SET MAGPT=1
SET MAGRES="Valid pointer"
QUIT
+25 SET MAGPT=0
SET MAGRES="The value: "_MAGD_" for field: "_MAGL_" in File: "_MAGF_" is an invalid Pointer."
+26 QUIT
End DoDot:1
QUIT MAGPT
+27 ;
+28 DO CHK^DIE(MAGF,MAGL,"E",MAGD,.MAGR,"MAGMSG")
+29 ; If success, Quit. We changed External to Internal. Internal is in MAGR
+30 IF MAGR'="^"
SET MAGD=MAGR
QUIT 1
+31 ; If not success Get the error text and Quit 0
+32 DO MSG^DIALOG("A",.MAGRESA,245,5,"MAGMSG")
+33 SET MAGRES=MAGRESA(1)
+34 QUIT 0
VALINDEX(MAGRY,TYPE,SPEC,PROC) ; Validate the interdependency of Index Terms.
+1 ; MAGRY is the return array
+2 ; MAGRY(0)="1^Okay" or "0^error message"
+3 ; MAGRY(1..n) Information about the Type,Spec and Proc
+4 ;
+5 ; Validate the Procedure/Event <-> Specialty/SubSpecialty interdependency
+6 ; Assure the TYPE is a Clinical TYPE.
+7 ; Assure all are Active.
+8 NEW CLS,RES,ARR,TYX,PRX,SPX,OK
+9 KILL MAGRY
+10 SET TYPE=$GET(TYPE)
SET PROC=$GET(PROC)
SET SPEC=$GET(SPEC)
+11 IF TYPE=0
SET TYPE=""
+12 IF PROC=0
SET PROC=""
+13 IF SPEC=0
SET SPEC=""
+14 IF ((PROC]"")!(SPEC]""))
IF TYPE=""
SET MAGRY(0)="0^Type is required."
QUIT 0
+15 ; TYPE is required, but not enforcing yet. All vendors are not sending
+16 ; index values.
+17 ; VALID will accept External or Internal and return Internal if Valid
+18 IF $LENGTH(TYPE)
IF '$$VALID(2005,42,.TYPE,.RES)
SET MAGRY(0)="0^"_RES
QUIT 0
+19 IF $LENGTH(PROC)
IF '$$VALID(2005,43,.PROC,.RES)
SET MAGRY(0)="0^"_RES
QUIT 0
+20 IF $LENGTH(SPEC)
IF '$$VALID(2005,44,.SPEC,.RES)
SET MAGRY(0)="0^"_RES
QUIT 0
+21 ;
+22 IF TYPE
Begin DoDot:1
+23 SET OK=1
SET TYX=TYPE_","
+24 KILL ARR
DO GETS^DIQ(2005.83,TYX,".01;1;2","EI","ARR")
+25 SET MAGRY(1)="Type - Class : "_ARR(2005.83,TYX,.01,"E")_" - "_ARR(2005.83,TYX,1,"E")
+26 IF $LENGTH(ARR(2005.83,TYX,2,"E"))
SET MAGRY(1)=MAGRY(1)_" - "_ARR(2005.83,TYX,2,"E")
+27 IF ARR(2005.83,TYX,2,"I")="I"
SET OK="0^Type is Inactive"
+28 QUIT
End DoDot:1
IF 'OK
SET MAGRY(0)=OK
QUIT 0
+29 ;
+30 IF SPEC
Begin DoDot:1
+31 SET OK=1
SET SPX=SPEC_","
+32 KILL ARR
DO GETS^DIQ(2005.84,SPX,".01;2;4","EI","ARR")
+33 SET MAGRY(2)="Specialty/SubSpecialty: "_ARR(2005.84,SPX,.01,"E")
+34 IF $LENGTH(ARR(2005.84,SPX,4,"E"))
SET MAGRY(2)=MAGRY(2)_" - "_ARR(2005.84,SPX,4,"E")
+35 IF $LENGTH(ARR(2005.84,SPX,2,"E"))
SET MAGRY(2)=MAGRY(2)_" <"_ARR(2005.84,SPX,2,"E")_">"
+36 IF ARR(2005.84,SPX,4,"I")="I"
SET OK="0^Specialty is Inactive"
+37 QUIT
End DoDot:1
IF 'OK
SET MAGRY(0)=OK
QUIT 0
+38 ;
+39 IF PROC
Begin DoDot:1
+40 SET OK=1
SET PRX=PROC_","
+41 KILL ARR
DO GETS^DIQ(2005.85,PRX,".01;4","EI","ARR")
+42 SET MAGRY(4)="Procedure/Event : "_$$GET1^DIQ(2005.85,PROC,.01)
+43 IF $LENGTH(ARR(2005.85,PRX,4,"E"))
SET MAGRY(4)=MAGRY(4)_" - "_ARR(2005.85,PRX,4,"E")
+44 IF ARR(2005.85,PRX,4,"I")="I"
SET OK="0^Procedure is Inactive"
+45 QUIT
End DoDot:1
IF 'OK
SET MAGRY(0)=OK
QUIT 0
+46 ;
+47 ; If PROC and SPEC are "", then Quit, any TYPE by itself is valid
+48 IF (PROC="")
IF (SPEC="")
SET MAGRY(0)="1^Okay"
QUIT 1
+49 ; Here, TYPE has to be Clin.
+50 SET CLS=$$GET1^DIQ(2005.83,TYPE,1,"","MAGTAR")
IF $EXTRACT(CLS,1,5)="ADMIN"
Begin DoDot:1
+51 SET MAGRY(0)="0^The Type Index is Administrative, it has to be Clinical."
End DoDot:1
QUIT 0
+52 IF (PROC="")!(SPEC="")
SET MAGRY(0)="1^Okay"
QUIT 1
+53 ; we get here, we have to validate the interdependency of SPEC <-> PROC.
+54 IF '$ORDER(^MAG(2005.85,PROC,1,0))
SET MAGRY(0)="1^Okay"
QUIT 1
+55 IF '$DATA(^MAG(2005.85,PROC,1,"B",SPEC))
Begin DoDot:1
+56 SET MAGRY(0)="0^Invalid Association between Spec/SubSpec and Proc/Event"
+57 QUIT
End DoDot:1
QUIT 0
+58 SET MAGRY(0)="1^Okay"
+59 QUIT 1
ERR ;
+1 NEW ERR
+2 SET ERR=$$EC^%ZOSV
+3 SET MAGRES="0^Error during data validation: "_ERR
+4 DO LOGERR^MAGGTERR(ERR)
+5 DO @^%ZOSF("ERRTN")
+6 DO CLEAN^DILF
+7 QUIT
