Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MAGDAIRG

MAGDAIRG.m

Go to the documentation of this file. 
  1. MAGDAIRG ;WOIFO/SG - Automatic Import Reconciliation Workflow ; 29 Jul 2009 7:26 AM
  1.  ;;3.0;IMAGING;**53**;Mar 19, 2002;Build 1719;Apr 28, 2010
  1.  ;; Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;; +---------------------------------------------------------------+
  1.  ;; | Property of the US Government.                                |
  1.  ;; | No permission to copy or redistribute this software is given. |
  1.  ;; | Use of unreleased versions of this software requires the user |
  1.  ;; | to execute a written test agreement with the VistA Imaging    |
  1.  ;; | Development Office of the Department of Veterans Affairs,     |
  1.  ;; | telephone (301) 734-0100.                                     |
  1.  ;; | The Food and Drug Administration classifies this software as  |
  1.  ;; | a medical device.  As such, it may not be changed in any way. |
  1.  ;; | Modifications to this software may result in an adulterated   |
  1.  ;; | medical device under 21CFR820, the use of which is considered |
  1.  ;; | to be a violation of US Federal Statutes.                     |
  1.  ;; +---------------------------------------------------------------+
  1.  ;;
  1.  Q
  1.  ;
  1.  ;***** BUILDS THE LIST OF IMAGING TYPES AND "NO CREDIT" LOCATIONS
  1.  ;
  1.  ; .DVITLST      Reference to a local variable where the division,
  1.  ;               imaging type, and "No Credit" imaging locations are
  1.  ;               returned to.
  1.  ;
  1.  ; DVITLST(
  1.  ;   DivIEN,
  1.  ;     TypeIEN,  Number of "No Credit" imaging locations
  1.  ;       LocIEN) ""
  1.  ;
  1. LIST(DVITLST) ;
  1.  N DIVIEN,IEN1,ILIEN,ITIEN,MAGERR,TMP
  1.  K DVITLST
  1.  ;
  1.  ;=== Load the list of imaging types that are referenced by radiology 
  1.  ;    procedures. There is no point in creating outside locations for
  1.  ;=== imaging types that are not used at the site.
  1.  S ITIEN=0
  1.  F  S ITIEN=$O(^RAMIS(71,"AIMG",ITIEN))  Q:ITIEN'>0  D
  1.  . S DVITLST(0,ITIEN)=0
  1.  . Q
  1.  ;
  1.  ;=== Check the Radiology files
  1.  S DIVIEN=0
  1.  F  S DIVIEN=$O(^RA(79,DIVIEN))  Q:DIVIEN'>0  D
  1.  . I '$D(^RA(79,DIVIEN,"L","B")) Q  ; ignore inactivated divisions
  1.  . ;--- Use the same list of imaging types for all divisions
  1.  . M DVITLST(DIVIEN)=DVITLST(0)
  1.  . ;=== Load locations of the division
  1.  . S IEN1=0
  1.  . F  S IEN1=$O(^RA(79,DIVIEN,"L",IEN1))  Q:IEN1'>0  D
  1.  . . ;--- IEN of the imaging location
  1.  . . S ILIEN=$$GET1^DIQ(79.01,IEN1_","_DIVIEN_",",.01,"I",,"MAGERR")
  1.  . . Q:ILIEN'>0
  1.  . . ;--- IEN of the imaging type
  1.  . . S ITIEN=$$GET1^DIQ(79.1,ILIEN_",",6,"I",,"MAGERR")
  1.  . . ;--- Store the association
  1.  . . S:ITIEN>0 DVITLST(DIVIEN,ITIEN,ILIEN)=""
  1.  . . Q
  1.  . ;=== Keep only "No Credit" locations
  1.  . S ITIEN=0
  1.  . F  S ITIEN=$O(DVITLST(DIVIEN,ITIEN))  Q:ITIEN'>0  D
  1.  . . S DVITLST(DIVIEN,ITIEN)=0
  1.  . . S ILIEN=0
  1.  . . F  S ILIEN=$O(DVITLST(DIVIEN,ITIEN,ILIEN))  Q:ILIEN'>0  D
  1.  . . . S TMP=+$$GET1^DIQ(79.1,ILIEN_",",21,"I",,"MAGERR")
  1.  . . . I TMP'=2  K DVITLST(DIVIEN,ITIEN,ILIEN)  Q
  1.  . . . S DVITLST(DIVIEN,ITIEN)=DVITLST(DIVIEN,ITIEN)+1
  1.  . . . Q
  1.  . . Q
  1.  . Q
  1.  ;
  1.  ;=== Cleanup
  1.  K DVITLST(0)
  1.  Q
  1.  ;
  1.  ;##### CHECKS THE OUTSIDE LOCATIONS AND DISPLAYS THEM
  1.  ; 
  1.  ; Input Parameter
  1.  ; ===============
  1.  ; VERBOSE -- 1 output messages (default)
  1.  ;            0 suppress messages
  1.  ;            
  1.  ; Output Parameter
  1.  ; ================
  1.  ; DVITLST ---  described above at beginning of LIST subroutine
  1.  ;            
  1.  ; Return Values
  1.  ; =============
  1.  ;           -2  Required outside locations are not (properly) defined
  1.  ;               in the OUTSIDE IMAGING LOCATION file (#2006.5759)
  1.  ;           -1  Required "No Credit" locations are not (properly)
  1.  ;               defined in the Radiology files.
  1.  ;            0  Ok
  1.  ; Notes
  1.  ; =====
  1.  ;
  1.  ; This entry point can also be called as a procedure:
  1.  ; D DISPLAY^MAGDAIRG() if you do not need its return value.
  1.  ;
  1. DISPLAY(VERBOSE,DVITLST) ;
  1.  N DIVIEN,ERRCNT,IEN,IENS,ILIEN,ITIEN,MAGBUF,MAGERR,MAGLST,TMP
  1.  S VERBOSE=$G(VERBOSE,1) ; default is verbose
  1.  ;
  1.  ;=== Load the list of imaging types and "No Credit" locations
  1.  D LIST(.DVITLST)
  1.  ;
  1.  ;=== Check the Radiology files
  1.  W:VERBOSE !!,"Checking the Radiology files..."
  1.  S (DIVIEN,ERRCNT)=0
  1.  F  S DIVIEN=$O(DVITLST(DIVIEN))  Q:DIVIEN'>0  D
  1.  . W:VERBOSE !,"Division: "_$$DIVNAME(DIVIEN)
  1.  . S ITIEN=0
  1.  . F  S ITIEN=$O(DVITLST(DIVIEN,ITIEN))  Q:ITIEN'>0  D
  1.  . . S MAGLST(DIVIEN,ITIEN)=0
  1.  . . ;--- Check if there is at least one "No Credit" location for
  1.  . . ;--- this imaging type
  1.  . . Q:DVITLST(DIVIEN,ITIEN)>0
  1.  . . ;--- Display the warning message
  1.  . . W:VERBOSE !?2,$$ITNAME(ITIEN),?32," - Define ""No Credit"" Imaging Location!"
  1.  . . S ERRCNT=ERRCNT+1
  1.  . . Q
  1.  . Q
  1.  ;--- Instruct the user to create missing "No Credit" locations
  1.  I ERRCNT>0  D:VERBOSE  Q:$QUIT -1  Q
  1.  . W !!  D MESSAGE("MSG1")  W !
  1.  . Q
  1.  ;
  1.  ;=== Check the OUTSIDE IMAGING LOCATION file (#2006.5759)
  1.  W:VERBOSE !!,"Checking the OUTSIDE IMAGING LOCATION file (#2006.5759)..."
  1.  S IEN=0
  1.  F  S IEN=$O(^MAGD(2006.5759,IEN))  Q:IEN'>0  D
  1.  . S IENS=IEN_","  K MAGBUF
  1.  . D GETS^DIQ(2006.5759,IENS,".01;2;4","I","MAGBUF","MAGERR")
  1.  . S DIVIEN=+$G(MAGBUF(2006.5759,IENS,4,"I"))   ; INSTITUTION
  1.  . S ITIEN=+$G(MAGBUF(2006.5759,IENS,2,"I"))    ; IMAGING TYPE
  1.  . S ILIEN=+$G(MAGBUF(2006.5759,IENS,.01,"I"))  ; IMAGING LOCATION
  1.  . ;--- Check if all required pointers are valid
  1.  . I '$D(DVITLST(DIVIEN,ITIEN,ILIEN))  D:VERBOSE  S ERRCNT=ERRCNT+1 Q
  1.  . . W !,"Invalid record in the file #2006.5759 (IEN="_IEN_")!"
  1.  . . Q
  1.  . ;--- Add the outside location to the list
  1.  . S MAGLST(DIVIEN,ITIEN,ILIEN)=IEN
  1.  . S MAGLST(DIVIEN,ITIEN)=$G(MAGLST(DIVIEN,ITIEN))+1
  1.  . Q
  1.  ;
  1.  ;=== Display the associations for each division and image type
  1.  S (DIVIEN,ERRCNT)=0
  1.  F  S DIVIEN=$O(MAGLST(DIVIEN))  Q:DIVIEN'>0  D
  1.  . W:VERBOSE !!,"Division: "_$$DIVNAME(DIVIEN)
  1.  . S ITIEN=0
  1.  . F  S ITIEN=$O(MAGLST(DIVIEN,ITIEN))  Q:ITIEN'>0  D
  1.  . . W:VERBOSE !?2,$$ITNAME(ITIEN),?32," - "
  1.  . . ;--- No association for this division and image type
  1.  . . I MAGLST(DIVIEN,ITIEN)'>0  D:VERBOSE  S ERRCNT=ERRCNT+1  Q
  1.  . . . W "Create record in file #2006.5759!"
  1.  . . . Q
  1.  . . ;--- Multiple associations for this division and image type
  1.  . . I MAGLST(DIVIEN,ITIEN)>1  D:VERBOSE  S ERRCNT=ERRCNT+1  Q
  1.  . . . W "Delete redundant records in file #2006.5759!"
  1.  . . . S ILIEN=0
  1.  . . . F  S ILIEN=$O(MAGLST(DIVIEN,ITIEN,ILIEN))  Q:ILIEN'>0  D
  1.  . . . . S TMP=$$GET1^DIQ(79.1,ILIEN_",",.01,,,"MAGERR")
  1.  . . . . S:TMP="" TMP="Unknown Imaging Location (IEN="_ILIEN_")"
  1.  . . . . W !?32," - ",TMP
  1.  . . . . Q
  1.  . . . Q
  1.  . . ;--- Valid association for this division and image type
  1.  . . S ILIEN=$O(MAGLST(DIVIEN,ITIEN,0))
  1.  . . S TMP=$$GET1^DIQ(79.1,ILIEN_",",.01,,,"MAGERR")
  1.  . . I TMP="" D
  1.  . . . S TMP="Unknown Imaging Location (IEN="_ILIEN_")"
  1.  . . . S ERRCNT=ERRCNT+1
  1.  . . . Q
  1.  . . W:VERBOSE TMP
  1.  . . Q
  1.  . Q
  1.  ;
  1.  ;=== Instruct the user to fix problems in the OUTSIDE IMAGING LOCATION file
  1.  I ERRCNT>0 D:VERBOSE  Q:$QUIT -2  Q
  1.  . W !!  D MESSAGE("MSG2")  W !
  1.  . Q
  1.  ;
  1.  ;=== Success
  1.  Q:$QUIT 0  Q
  1.  ;
  1.  ;+++++ RETURNS DIVISION NAME
  1. DIVNAME(DIVIEN) ;
  1.  N MAGERR,NAME
  1.  S NAME=$$GET1^DIQ(4,DIVIEN_",",.01,,,"MAGERR")
  1.  Q $S(NAME'="":NAME,1:"Unknown (IEN="_DIVIEN_")")
  1.  ;
  1.  ;+++++ RETURNS NAME OF THE IMAGING TYPE
  1. ITNAME(ITIEN) ;
  1.  N MAGERR,NAME
  1.  S NAME=$$GET1^DIQ(79.2,ITIEN_",",.01,,,"MAGERR")
  1.  Q $S(NAME'="":NAME,1:"Unknown Imaging Type (IEN="_ITIEN_")")
  1.  ;
  1.  ;+++++ FORMATS AND DISPLAYS THE MULTILINE MESSAGE
  1. MESSAGE(TAG) ;
  1.  N DIWF,DIWL,DIWR,MAGI,X
  1.  K ^UTILITY($J,"W")
  1.  S DIWF="W",DIWL=1,DIWR=$G(IOM,80)-1
  1.  F MAGI=1:1  S X=$P($T(@TAG+MAGI),";;",2)  Q:X=""  D ^DIWP
  1.  D ^DIWW
  1.  Q
  1.  ;
  1.  ;+++++ MESSAGES
  1. MSG1 ;
  1.  ;;Please define missing "No Credit" imaging locations for the
  1.  ;;aforementioned divisions and imaging types (using the Location
  1.  ;;Parameter Set-up [RA SYSLOC] and Division Parameter Set-up
  1.  ;;[RA SYSDIV] options of the System Definition Menu ... [RA SYSDEF]
  1.  ;;options) and then run this option again.
  1. MSG2 ;
  1.  ;;Please fix the aforementioned problems in the OUTSIDE IMAGING
  1.  ;;LOCATION file (#2006.5759) and then run this option again.