Changeset 623 for WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGSIV1.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGSIV1.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGSIV1.m
r613 r623 1 MAGGSIV1 ;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 20 VALID(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 55 VALINDEX(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 115 ERR ; 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 1 MAGGSIV1 ;WOIFO/GEK - Imaging Validate Data ; [ 08/15/2004 08:57 ] 2 ;;3.0;IMAGING;**8,20**;Apr 12, 2006 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 Q 19 VALID(MAGF,MAGL,MAGD,MAGRES) ; call to validate value for field in a FM file. 20 ; Function is boolean. Returns: 21 ; 0 - Invalid 22 ; 1 - Valid 23 ; "" - Error 24 ; Call this function before you set the FDA Array. 25 ; MAGD - sent by reference because it could be Internal or External 26 ; and if it is external and valid, it is changed to Internal. 27 ; 28 ; MAGF : File Number 29 ; MAGL : Field Number 30 ; MAGD : (sent by reference) data value of field 31 ; MAGRES: (sent by reference) Result message 32 ; 33 N $ETRAP,$ESTACK S $ETRAP="D ERR^"_$T(+0) 34 N MAGR,MAGMSG,MAGSP,MAGRESA,MAGE,MAGPT 35 ;if a BAD field number 36 I '$$VFIELD^DILFD(MAGF,MAGL) D Q 0 37 . S MAGRES="The field number: "_MAGL_", in File: "_MAGF_", is invalid." 38 D FIELD^DID(MAGF,MAGL,"","SPECIFIER","MAGSP") 39 ; If it is a pointer field 40 ; If an integer - We assume it is a pointer and validate that and Quit. 41 ; If not integer - We assume it is external value, proceed to let CHK do validate 42 I (MAGSP("SPECIFIER")["P"),(+MAGD=MAGD) D Q MAGPT 43 . I $$EXTERNAL^DILFD(MAGF,MAGL,"",MAGD)'="" S MAGPT=1,MAGRES="Valid pointer" Q 44 . S MAGPT=0,MAGRES="The value: "_MAGD_" for field: "_MAGL_" in File: "_MAGF_" is an invalid Pointer." 45 . Q 46 ; 47 D CHK^DIE(MAGF,MAGL,"E",MAGD,.MAGR,"MAGMSG") 48 ; If success, Quit. We changed External to Internal. Internal is in MAGR 49 I MAGR'="^" S MAGD=MAGR Q 1 50 ; If not success Get the error text and Quit 0 51 D MSG^DIALOG("A",.MAGRESA,245,5,"MAGMSG") 52 S MAGRES=MAGRESA(1) 53 Q 0 54 VALINDEX(MAGRY,TYPE,SPEC,PROC) ; Validate the interdependency of Index Terms. 55 ; MAGRY is the return array 56 ; MAGRY(0)="1^Okay" or "0^error message" 57 ; MAGRY(1..n) Information about the Type,Spec and Proc 58 ; 59 ; Validate the Procedure/Event <-> Specialty/SubSpecialty interdependency 60 ; Assure the TYPE is a Clinical TYPE. 61 ; Assure all are Active. 62 N CLS,RES,ARR,TYX,PRX,SPX,OK 63 K MAGRY 64 S TYPE=$G(TYPE),PROC=$G(PROC),SPEC=$G(SPEC) 65 I TYPE=0 S TYPE="" 66 I PROC=0 S PROC="" 67 I SPEC=0 S SPEC="" 68 I ((PROC]"")!(SPEC]"")) I TYPE="" S MAGRY(0)="0^Type is required." Q 0 69 ; TYPE is required, but not enforcing yet. All vendors are not sending 70 ; index values. 71 ; VALID will accept External or Internal and return Internal if Valid 72 I $L(TYPE) I '$$VALID(2005,42,.TYPE,.RES) S MAGRY(0)="0^"_RES Q 0 73 I $L(PROC) I '$$VALID(2005,43,.PROC,.RES) S MAGRY(0)="0^"_RES Q 0 74 I $L(SPEC) I '$$VALID(2005,44,.SPEC,.RES) S MAGRY(0)="0^"_RES Q 0 75 ; 76 I TYPE D I 'OK S MAGRY(0)=OK Q 0 77 . S OK=1,TYX=TYPE_"," 78 . K ARR D GETS^DIQ(2005.83,TYX,".01;1;2","EI","ARR") 79 . S MAGRY(1)="Type - Class : "_ARR(2005.83,TYX,.01,"E")_" - "_ARR(2005.83,TYX,1,"E") 80 . I $L(ARR(2005.83,TYX,2,"E")) S MAGRY(1)=MAGRY(1)_" - "_ARR(2005.83,TYX,2,"E") 81 . I ARR(2005.83,TYX,2,"I")="I" S OK="0^Type is Inactive" 82 . Q 83 ; 84 I SPEC D I 'OK S MAGRY(0)=OK Q 0 85 . S OK=1,SPX=SPEC_"," 86 . K ARR D GETS^DIQ(2005.84,SPX,".01;2;4","EI","ARR") 87 . S MAGRY(2)="Specialty/SubSpecialty: "_ARR(2005.84,SPX,.01,"E") 88 . I $L(ARR(2005.84,SPX,4,"E")) S MAGRY(2)=MAGRY(2)_" - "_ARR(2005.84,SPX,4,"E") 89 . I $L(ARR(2005.84,SPX,2,"E")) S MAGRY(2)=MAGRY(2)_" <"_ARR(2005.84,SPX,2,"E")_">" 90 . I ARR(2005.84,SPX,4,"I")="I" S OK="0^Specialty is Inactive" 91 . Q 92 ; 93 I PROC D I 'OK S MAGRY(0)=OK Q 0 94 . S OK=1,PRX=PROC_"," 95 . K ARR D GETS^DIQ(2005.85,PRX,".01;4","EI","ARR") 96 . S MAGRY(4)="Procedure/Event : "_$$GET1^DIQ(2005.85,PROC,.01) 97 . I $L(ARR(2005.85,PRX,4,"E")) S MAGRY(4)=MAGRY(4)_" - "_ARR(2005.85,PRX,4,"E") 98 . I ARR(2005.85,PRX,4,"I")="I" S OK="0^Procedure is Inactive" 99 . Q 100 ; 101 ; If PROC and SPEC are "", then Quit, any TYPE by itself is valid 102 I (PROC=""),(SPEC="") S MAGRY(0)="1^Okay" Q 1 103 ; Here, TYPE has to be Clin. 104 S CLS=$$GET1^DIQ(2005.83,TYPE,1,"","MAGTAR") I $E(CLS,1,5)="ADMIN" D Q 0 105 . S MAGRY(0)="0^The Type Index is Administrative, it has to be Clinical." 106 I (PROC="")!(SPEC="") S MAGRY(0)="1^Okay" Q 1 107 ; we get here, we have to validate the interdependency of SPEC <-> PROC. 108 I '$O(^MAG(2005.85,PROC,1,0)) S MAGRY(0)="1^Okay" Q 1 109 I '$D(^MAG(2005.85,PROC,1,"B",SPEC)) D Q 0 110 . S MAGRY(0)="0^Invalid Association between Spec/SubSpec and Proc/Event" 111 . Q 112 S MAGRY(0)="1^Okay" 113 Q 1 114 ERR ; 115 N ERR 116 S ERR=$$EC^%ZOSV 117 S MAGRES="0^Error during data validation: "_ERR 118 D LOGERR^MAGGTERR(ERR) 119 D @^%ZOSF("ERRTN") 120 D CLEAN^DILF 121 Q
Note:
See TracChangeset
for help on using the changeset viewer.
