- 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 Jan 18, 2025@03:04:03 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