source: FOIAVistA/trunk/r/IMAGING-MAG-ZMAG/MAGGSIV1.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 5.3 KB
Line 
1MAGGSIV1 ;WOIFO/GEK - Imaging Validate Data ; [ 08/15/2004 08:57 ]
2 ;;3.0;IMAGING;**8,20,59**;Nov 27, 2007;Build 20
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;; +---------------------------------------------------------------+
5 ;; | Property of the US Government. |
6 ;; | No permission to copy or redistribute this software is given. |
7 ;; | Use of unreleased versions of this software requires the user |
8 ;; | to execute a written test agreement with the VistA Imaging |
9 ;; | Development Office of the Department of Veterans Affairs, |
10 ;; | telephone (301) 734-0100. |
11 ;; | |
12 ;; | The Food and Drug Administration classifies this software as |
13 ;; | a medical device. As such, it may not be changed in any way. |
14 ;; | Modifications to this software may result in an adulterated |
15 ;; | medical device under 21CFR820, the use of which is considered |
16 ;; | to be a violation of US Federal Statutes. |
17 ;; +---------------------------------------------------------------+
18 ;;
19 Q
20VALID(MAGF,MAGL,MAGD,MAGRES) ; call to validate value for field in a FM file.
21 ; Function is boolean. Returns:
22 ; 0 - Invalid
23 ; 1 - Valid
24 ; "" - Error
25 ; Call this function before you set the FDA Array.
26 ; MAGD - sent by reference because it could be Internal or External
27 ; and if it is external and valid, it is changed to Internal.
28 ;
29 ; MAGF : File Number
30 ; MAGL : Field Number
31 ; MAGD : (sent by reference) data value of field
32 ; MAGRES: (sent by reference) Result message
33 ;
34 N $ETRAP,$ESTACK S $ETRAP="D ERR^"_$T(+0)
35 N MAGR,MAGMSG,MAGSP,MAGRESA,MAGE,MAGPT
36 ;if a BAD field number
37 I '$$VFIELD^DILFD(MAGF,MAGL) D Q 0
38 . S MAGRES="The field number: "_MAGL_", in File: "_MAGF_", is invalid."
39 D FIELD^DID(MAGF,MAGL,"","SPECIFIER","MAGSP")
40 ; If it is a pointer field
41 ; If an integer - We assume it is a pointer and validate that and Quit.
42 ; If not integer - We assume it is external value, proceed to let CHK do validate
43 I (MAGSP("SPECIFIER")["P"),(+MAGD=MAGD) D Q MAGPT
44 . I $$EXTERNAL^DILFD(MAGF,MAGL,"",MAGD)'="" S MAGPT=1,MAGRES="Valid pointer" Q
45 . S MAGPT=0,MAGRES="The value: "_MAGD_" for field: "_MAGL_" in File: "_MAGF_" is an invalid Pointer."
46 . Q
47 ;
48 D CHK^DIE(MAGF,MAGL,"E",MAGD,.MAGR,"MAGMSG")
49 ; If success, Quit. We changed External to Internal. Internal is in MAGR
50 I MAGR'="^" S MAGD=MAGR Q 1
51 ; If not success Get the error text and Quit 0
52 D MSG^DIALOG("A",.MAGRESA,245,5,"MAGMSG")
53 S MAGRES=MAGRESA(1)
54 Q 0
55VALINDEX(MAGRY,TYPE,SPEC,PROC) ; Validate the interdependency of Index Terms.
56 ; MAGRY is the return array
57 ; MAGRY(0)="1^Okay" or "0^error message"
58 ; MAGRY(1..n) Information about the Type,Spec and Proc
59 ;
60 ; Validate the Procedure/Event <-> Specialty/SubSpecialty interdependency
61 ; Assure the TYPE is a Clinical TYPE.
62 ; Assure all are Active.
63 N CLS,RES,ARR,TYX,PRX,SPX,OK
64 K MAGRY
65 S TYPE=$G(TYPE),PROC=$G(PROC),SPEC=$G(SPEC)
66 I TYPE=0 S TYPE=""
67 I PROC=0 S PROC=""
68 I SPEC=0 S SPEC=""
69 I ((PROC]"")!(SPEC]"")) I TYPE="" S MAGRY(0)="0^Type is required." Q 0
70 ; TYPE is required, but not enforcing yet. All vendors are not sending
71 ; index values.
72 ; VALID will accept External or Internal and return Internal if Valid
73 I $L(TYPE) I '$$VALID(2005,42,.TYPE,.RES) S MAGRY(0)="0^"_RES Q 0
74 I $L(PROC) I '$$VALID(2005,43,.PROC,.RES) S MAGRY(0)="0^"_RES Q 0
75 I $L(SPEC) I '$$VALID(2005,44,.SPEC,.RES) S MAGRY(0)="0^"_RES Q 0
76 ;
77 I TYPE D I 'OK S MAGRY(0)=OK Q 0
78 . S OK=1,TYX=TYPE_","
79 . K ARR D GETS^DIQ(2005.83,TYX,".01;1;2","EI","ARR")
80 . S MAGRY(1)="Type - Class : "_ARR(2005.83,TYX,.01,"E")_" - "_ARR(2005.83,TYX,1,"E")
81 . I $L(ARR(2005.83,TYX,2,"E")) S MAGRY(1)=MAGRY(1)_" - "_ARR(2005.83,TYX,2,"E")
82 . I ARR(2005.83,TYX,2,"I")="I" S OK="0^Type is Inactive"
83 . Q
84 ;
85 I SPEC D I 'OK S MAGRY(0)=OK Q 0
86 . S OK=1,SPX=SPEC_","
87 . K ARR D GETS^DIQ(2005.84,SPX,".01;2;4","EI","ARR")
88 . S MAGRY(2)="Specialty/SubSpecialty: "_ARR(2005.84,SPX,.01,"E")
89 . I $L(ARR(2005.84,SPX,4,"E")) S MAGRY(2)=MAGRY(2)_" - "_ARR(2005.84,SPX,4,"E")
90 . I $L(ARR(2005.84,SPX,2,"E")) S MAGRY(2)=MAGRY(2)_" <"_ARR(2005.84,SPX,2,"E")_">"
91 . I ARR(2005.84,SPX,4,"I")="I" S OK="0^Specialty is Inactive"
92 . Q
93 ;
94 I PROC D I 'OK S MAGRY(0)=OK Q 0
95 . S OK=1,PRX=PROC_","
96 . K ARR D GETS^DIQ(2005.85,PRX,".01;4","EI","ARR")
97 . S MAGRY(4)="Procedure/Event : "_$$GET1^DIQ(2005.85,PROC,.01)
98 . I $L(ARR(2005.85,PRX,4,"E")) S MAGRY(4)=MAGRY(4)_" - "_ARR(2005.85,PRX,4,"E")
99 . I ARR(2005.85,PRX,4,"I")="I" S OK="0^Procedure is Inactive"
100 . Q
101 ;
102 ; If PROC and SPEC are "", then Quit, any TYPE by itself is valid
103 I (PROC=""),(SPEC="") S MAGRY(0)="1^Okay" Q 1
104 ; Here, TYPE has to be Clin.
105 S CLS=$$GET1^DIQ(2005.83,TYPE,1,"","MAGTAR") I $E(CLS,1,5)="ADMIN" D Q 0
106 . S MAGRY(0)="0^The Type Index is Administrative, it has to be Clinical."
107 I (PROC="")!(SPEC="") S MAGRY(0)="1^Okay" Q 1
108 ; we get here, we have to validate the interdependency of SPEC <-> PROC.
109 I '$O(^MAG(2005.85,PROC,1,0)) S MAGRY(0)="1^Okay" Q 1
110 I '$D(^MAG(2005.85,PROC,1,"B",SPEC)) D Q 0
111 . S MAGRY(0)="0^Invalid Association between Spec/SubSpec and Proc/Event"
112 . Q
113 S MAGRY(0)="1^Okay"
114 Q 1
115ERR ;
116 N ERR
117 S ERR=$$EC^%ZOSV
118 S MAGRES="0^Error during data validation: "_ERR
119 D LOGERR^MAGGTERR(ERR)
120 D @^%ZOSF("ERRTN")
121 D CLEAN^DILF
122 Q
Note: See TracBrowser for help on using the repository browser.