MAGDAIRG ;WOIFO/SG - Automatic Import Reconciliation Workflow ; 29 Jul 2009 7:26 AM
;;3.0;IMAGING;**53**;Mar 19, 2002;Build 1719;Apr 28, 2010
;; 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
;
;***** BUILDS THE LIST OF IMAGING TYPES AND "NO CREDIT" LOCATIONS
;
; .DVITLST Reference to a local variable where the division,
; imaging type, and "No Credit" imaging locations are
; returned to.
;
; DVITLST(
; DivIEN,
; TypeIEN, Number of "No Credit" imaging locations
; LocIEN) ""
;
LIST(DVITLST) ;
N DIVIEN,IEN1,ILIEN,ITIEN,MAGERR,TMP
K DVITLST
;
;=== Load the list of imaging types that are referenced by radiology
; procedures. There is no point in creating outside locations for
;=== imaging types that are not used at the site.
S ITIEN=0
F S ITIEN=$O(^RAMIS(71,"AIMG",ITIEN)) Q:ITIEN'>0 D
. S DVITLST(0,ITIEN)=0
. Q
;
;=== Check the Radiology files
S DIVIEN=0
F S DIVIEN=$O(^RA(79,DIVIEN)) Q:DIVIEN'>0 D
. I '$D(^RA(79,DIVIEN,"L","B")) Q ; ignore inactivated divisions
. ;--- Use the same list of imaging types for all divisions
. M DVITLST(DIVIEN)=DVITLST(0)
. ;=== Load locations of the division
. S IEN1=0
. F S IEN1=$O(^RA(79,DIVIEN,"L",IEN1)) Q:IEN1'>0 D
. . ;--- IEN of the imaging location
. . S ILIEN=$$GET1^DIQ(79.01,IEN1_","_DIVIEN_",",.01,"I",,"MAGERR")
. . Q:ILIEN'>0
. . ;--- IEN of the imaging type
. . S ITIEN=$$GET1^DIQ(79.1,ILIEN_",",6,"I",,"MAGERR")
. . ;--- Store the association
. . S:ITIEN>0 DVITLST(DIVIEN,ITIEN,ILIEN)=""
. . Q
. ;=== Keep only "No Credit" locations
. S ITIEN=0
. F S ITIEN=$O(DVITLST(DIVIEN,ITIEN)) Q:ITIEN'>0 D
. . S DVITLST(DIVIEN,ITIEN)=0
. . S ILIEN=0
. . F S ILIEN=$O(DVITLST(DIVIEN,ITIEN,ILIEN)) Q:ILIEN'>0 D
. . . S TMP=+$$GET1^DIQ(79.1,ILIEN_",",21,"I",,"MAGERR")
. . . I TMP'=2 K DVITLST(DIVIEN,ITIEN,ILIEN) Q
. . . S DVITLST(DIVIEN,ITIEN)=DVITLST(DIVIEN,ITIEN)+1
. . . Q
. . Q
. Q
;
;=== Cleanup
K DVITLST(0)
Q
;
;##### CHECKS THE OUTSIDE LOCATIONS AND DISPLAYS THEM
;
; Input Parameter
; ===============
; VERBOSE -- 1 output messages (default)
; 0 suppress messages
;
; Output Parameter
; ================
; DVITLST --- described above at beginning of LIST subroutine
;
; Return Values
; =============
; -2 Required outside locations are not (properly) defined
; in the OUTSIDE IMAGING LOCATION file (#2006.5759)
; -1 Required "No Credit" locations are not (properly)
; defined in the Radiology files.
; 0 Ok
; Notes
; =====
;
; This entry point can also be called as a procedure:
; D DISPLAY^MAGDAIRG() if you do not need its return value.
;
DISPLAY(VERBOSE,DVITLST) ;
N DIVIEN,ERRCNT,IEN,IENS,ILIEN,ITIEN,MAGBUF,MAGERR,MAGLST,TMP
S VERBOSE=$G(VERBOSE,1) ; default is verbose
;
;=== Load the list of imaging types and "No Credit" locations
D LIST(.DVITLST)
;
;=== Check the Radiology files
W:VERBOSE !!,"Checking the Radiology files..."
S (DIVIEN,ERRCNT)=0
F S DIVIEN=$O(DVITLST(DIVIEN)) Q:DIVIEN'>0 D
. W:VERBOSE !,"Division: "_$$DIVNAME(DIVIEN)
. S ITIEN=0
. F S ITIEN=$O(DVITLST(DIVIEN,ITIEN)) Q:ITIEN'>0 D
. . S MAGLST(DIVIEN,ITIEN)=0
. . ;--- Check if there is at least one "No Credit" location for
. . ;--- this imaging type
. . Q:DVITLST(DIVIEN,ITIEN)>0
. . ;--- Display the warning message
. . W:VERBOSE !?2,$$ITNAME(ITIEN),?32," - Define ""No Credit"" Imaging Location!"
. . S ERRCNT=ERRCNT+1
. . Q
. Q
;--- Instruct the user to create missing "No Credit" locations
I ERRCNT>0 D:VERBOSE Q:$QUIT -1 Q
. W !! D MESSAGE("MSG1") W !
. Q
;
;=== Check the OUTSIDE IMAGING LOCATION file (#2006.5759)
W:VERBOSE !!,"Checking the OUTSIDE IMAGING LOCATION file (#2006.5759)..."
S IEN=0
F S IEN=$O(^MAGD(2006.5759,IEN)) Q:IEN'>0 D
. S IENS=IEN_"," K MAGBUF
. D GETS^DIQ(2006.5759,IENS,".01;2;4","I","MAGBUF","MAGERR")
. S DIVIEN=+$G(MAGBUF(2006.5759,IENS,4,"I")) ; INSTITUTION
. S ITIEN=+$G(MAGBUF(2006.5759,IENS,2,"I")) ; IMAGING TYPE
. S ILIEN=+$G(MAGBUF(2006.5759,IENS,.01,"I")) ; IMAGING LOCATION
. ;--- Check if all required pointers are valid
. I '$D(DVITLST(DIVIEN,ITIEN,ILIEN)) D:VERBOSE S ERRCNT=ERRCNT+1 Q
. . W !,"Invalid record in the file #2006.5759 (IEN="_IEN_")!"
. . Q
. ;--- Add the outside location to the list
. S MAGLST(DIVIEN,ITIEN,ILIEN)=IEN
. S MAGLST(DIVIEN,ITIEN)=$G(MAGLST(DIVIEN,ITIEN))+1
. Q
;
;=== Display the associations for each division and image type
S (DIVIEN,ERRCNT)=0
F S DIVIEN=$O(MAGLST(DIVIEN)) Q:DIVIEN'>0 D
. W:VERBOSE !!,"Division: "_$$DIVNAME(DIVIEN)
. S ITIEN=0
. F S ITIEN=$O(MAGLST(DIVIEN,ITIEN)) Q:ITIEN'>0 D
. . W:VERBOSE !?2,$$ITNAME(ITIEN),?32," - "
. . ;--- No association for this division and image type
. . I MAGLST(DIVIEN,ITIEN)'>0 D:VERBOSE S ERRCNT=ERRCNT+1 Q
. . . W "Create record in file #2006.5759!"
. . . Q
. . ;--- Multiple associations for this division and image type
. . I MAGLST(DIVIEN,ITIEN)>1 D:VERBOSE S ERRCNT=ERRCNT+1 Q
. . . W "Delete redundant records in file #2006.5759!"
. . . S ILIEN=0
. . . F S ILIEN=$O(MAGLST(DIVIEN,ITIEN,ILIEN)) Q:ILIEN'>0 D
. . . . S TMP=$$GET1^DIQ(79.1,ILIEN_",",.01,,,"MAGERR")
. . . . S:TMP="" TMP="Unknown Imaging Location (IEN="_ILIEN_")"
. . . . W !?32," - ",TMP
. . . . Q
. . . Q
. . ;--- Valid association for this division and image type
. . S ILIEN=$O(MAGLST(DIVIEN,ITIEN,0))
. . S TMP=$$GET1^DIQ(79.1,ILIEN_",",.01,,,"MAGERR")
. . I TMP="" D
. . . S TMP="Unknown Imaging Location (IEN="_ILIEN_")"
. . . S ERRCNT=ERRCNT+1
. . . Q
. . W:VERBOSE TMP
. . Q
. Q
;
;=== Instruct the user to fix problems in the OUTSIDE IMAGING LOCATION file
I ERRCNT>0 D:VERBOSE Q:$QUIT -2 Q
. W !! D MESSAGE("MSG2") W !
. Q
;
;=== Success
Q:$QUIT 0 Q
;
;+++++ RETURNS DIVISION NAME
DIVNAME(DIVIEN) ;
N MAGERR,NAME
S NAME=$$GET1^DIQ(4,DIVIEN_",",.01,,,"MAGERR")
Q $S(NAME'="":NAME,1:"Unknown (IEN="_DIVIEN_")")
;
;+++++ RETURNS NAME OF THE IMAGING TYPE
ITNAME(ITIEN) ;
N MAGERR,NAME
S NAME=$$GET1^DIQ(79.2,ITIEN_",",.01,,,"MAGERR")
Q $S(NAME'="":NAME,1:"Unknown Imaging Type (IEN="_ITIEN_")")
;
;+++++ FORMATS AND DISPLAYS THE MULTILINE MESSAGE
MESSAGE(TAG) ;
N DIWF,DIWL,DIWR,MAGI,X
K ^UTILITY($J,"W")
S DIWF="W",DIWL=1,DIWR=$G(IOM,80)-1
F MAGI=1:1 S X=$P($T(@TAG+MAGI),";;",2) Q:X="" D ^DIWP
D ^DIWW
Q
;
;+++++ MESSAGES
MSG1 ;
;;Please define missing "No Credit" imaging locations for the
;;aforementioned divisions and imaging types (using the Location
;;Parameter Set-up [RA SYSLOC] and Division Parameter Set-up
;;[RA SYSDIV] options of the System Definition Menu ... [RA SYSDEF]
;;options) and then run this option again.
MSG2 ;
;;Please fix the aforementioned problems in the OUTSIDE IMAGING
;;LOCATION file (#2006.5759) and then run this option again.
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDAIRG 8060 printed Apr 09, 2024@21:04:26 Page 2
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
+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 ;; | The Food and Drug Administration classifies this software as |
+11 ;; | a medical device. As such, it may not be changed in any way. |
+12 ;; | Modifications to this software may result in an adulterated |
+13 ;; | medical device under 21CFR820, the use of which is considered |
+14 ;; | to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
+17 QUIT
+18 ;
+19 ;***** BUILDS THE LIST OF IMAGING TYPES AND "NO CREDIT" LOCATIONS
+20 ;
+21 ; .DVITLST Reference to a local variable where the division,
+22 ; imaging type, and "No Credit" imaging locations are
+23 ; returned to.
+24 ;
+25 ; DVITLST(
+26 ; DivIEN,
+27 ; TypeIEN, Number of "No Credit" imaging locations
+28 ; LocIEN) ""
+29 ;
LIST(DVITLST) ;
+1 NEW DIVIEN,IEN1,ILIEN,ITIEN,MAGERR,TMP
+2 KILL DVITLST
+3 ;
+4 ;=== Load the list of imaging types that are referenced by radiology
+5 ; procedures. There is no point in creating outside locations for
+6 ;=== imaging types that are not used at the site.
+7 SET ITIEN=0
+8 FOR
SET ITIEN=$ORDER(^RAMIS(71,"AIMG",ITIEN))
if ITIEN'>0
QUIT
Begin DoDot:1
+9 SET DVITLST(0,ITIEN)=0
+10 QUIT
End DoDot:1
+11 ;
+12 ;=== Check the Radiology files
+13 SET DIVIEN=0
+14 FOR
SET DIVIEN=$ORDER(^RA(79,DIVIEN))
if DIVIEN'>0
QUIT
Begin DoDot:1
+15 ; ignore inactivated divisions
IF '$DATA(^RA(79,DIVIEN,"L","B"))
QUIT
+16 ;--- Use the same list of imaging types for all divisions
+17 MERGE DVITLST(DIVIEN)=DVITLST(0)
+18 ;=== Load locations of the division
+19 SET IEN1=0
+20 FOR
SET IEN1=$ORDER(^RA(79,DIVIEN,"L",IEN1))
if IEN1'>0
QUIT
Begin DoDot:2
+21 ;--- IEN of the imaging location
+22 SET ILIEN=$$GET1^DIQ(79.01,IEN1_","_DIVIEN_",",.01,"I",,"MAGERR")
+23 if ILIEN'>0
QUIT
+24 ;--- IEN of the imaging type
+25 SET ITIEN=$$GET1^DIQ(79.1,ILIEN_",",6,"I",,"MAGERR")
+26 ;--- Store the association
+27 if ITIEN>0
SET DVITLST(DIVIEN,ITIEN,ILIEN)=""
+28 QUIT
End DoDot:2
+29 ;=== Keep only "No Credit" locations
+30 SET ITIEN=0
+31 FOR
SET ITIEN=$ORDER(DVITLST(DIVIEN,ITIEN))
if ITIEN'>0
QUIT
Begin DoDot:2
+32 SET DVITLST(DIVIEN,ITIEN)=0
+33 SET ILIEN=0
+34 FOR
SET ILIEN=$ORDER(DVITLST(DIVIEN,ITIEN,ILIEN))
if ILIEN'>0
QUIT
Begin DoDot:3
+35 SET TMP=+$$GET1^DIQ(79.1,ILIEN_",",21,"I",,"MAGERR")
+36 IF TMP'=2
KILL DVITLST(DIVIEN,ITIEN,ILIEN)
QUIT
+37 SET DVITLST(DIVIEN,ITIEN)=DVITLST(DIVIEN,ITIEN)+1
+38 QUIT
End DoDot:3
+39 QUIT
End DoDot:2
+40 QUIT
End DoDot:1
+41 ;
+42 ;=== Cleanup
+43 KILL DVITLST(0)
+44 QUIT
+45 ;
+46 ;##### CHECKS THE OUTSIDE LOCATIONS AND DISPLAYS THEM
+47 ;
+48 ; Input Parameter
+49 ; ===============
+50 ; VERBOSE -- 1 output messages (default)
+51 ; 0 suppress messages
+52 ;
+53 ; Output Parameter
+54 ; ================
+55 ; DVITLST --- described above at beginning of LIST subroutine
+56 ;
+57 ; Return Values
+58 ; =============
+59 ; -2 Required outside locations are not (properly) defined
+60 ; in the OUTSIDE IMAGING LOCATION file (#2006.5759)
+61 ; -1 Required "No Credit" locations are not (properly)
+62 ; defined in the Radiology files.
+63 ; 0 Ok
+64 ; Notes
+65 ; =====
+66 ;
+67 ; This entry point can also be called as a procedure:
+68 ; D DISPLAY^MAGDAIRG() if you do not need its return value.
+69 ;
DISPLAY(VERBOSE,DVITLST) ;
+1 NEW DIVIEN,ERRCNT,IEN,IENS,ILIEN,ITIEN,MAGBUF,MAGERR,MAGLST,TMP
+2 ; default is verbose
SET VERBOSE=$GET(VERBOSE,1)
+3 ;
+4 ;=== Load the list of imaging types and "No Credit" locations
+5 DO LIST(.DVITLST)
+6 ;
+7 ;=== Check the Radiology files
+8 if VERBOSE
WRITE !!,"Checking the Radiology files..."
+9 SET (DIVIEN,ERRCNT)=0
+10 FOR
SET DIVIEN=$ORDER(DVITLST(DIVIEN))
if DIVIEN'>0
QUIT
Begin DoDot:1
+11 if VERBOSE
WRITE !,"Division: "_$$DIVNAME(DIVIEN)
+12 SET ITIEN=0
+13 FOR
SET ITIEN=$ORDER(DVITLST(DIVIEN,ITIEN))
if ITIEN'>0
QUIT
Begin DoDot:2
+14 SET MAGLST(DIVIEN,ITIEN)=0
+15 ;--- Check if there is at least one "No Credit" location for
+16 ;--- this imaging type
+17 if DVITLST(DIVIEN,ITIEN)>0
QUIT
+18 ;--- Display the warning message
+19 if VERBOSE
WRITE !?2,$$ITNAME(ITIEN),?32," - Define ""No Credit"" Imaging Location!"
+20 SET ERRCNT=ERRCNT+1
+21 QUIT
End DoDot:2
+22 QUIT
End DoDot:1
+23 ;--- Instruct the user to create missing "No Credit" locations
+24 IF ERRCNT>0
if VERBOSE
Begin DoDot:1
+25 WRITE !!
DO MESSAGE("MSG1")
WRITE !
+26 QUIT
End DoDot:1
if $QUIT
QUIT -1
QUIT
+27 ;
+28 ;=== Check the OUTSIDE IMAGING LOCATION file (#2006.5759)
+29 if VERBOSE
WRITE !!,"Checking the OUTSIDE IMAGING LOCATION file (#2006.5759)..."
+30 SET IEN=0
+31 FOR
SET IEN=$ORDER(^MAGD(2006.5759,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+32 SET IENS=IEN_","
KILL MAGBUF
+33 DO GETS^DIQ(2006.5759,IENS,".01;2;4","I","MAGBUF","MAGERR")
+34 ; INSTITUTION
SET DIVIEN=+$GET(MAGBUF(2006.5759,IENS,4,"I"))
+35 ; IMAGING TYPE
SET ITIEN=+$GET(MAGBUF(2006.5759,IENS,2,"I"))
+36 ; IMAGING LOCATION
SET ILIEN=+$GET(MAGBUF(2006.5759,IENS,.01,"I"))
+37 ;--- Check if all required pointers are valid
+38 IF '$DATA(DVITLST(DIVIEN,ITIEN,ILIEN))
if VERBOSE
Begin DoDot:2
+39 WRITE !,"Invalid record in the file #2006.5759 (IEN="_IEN_")!"
+40 QUIT
End DoDot:2
SET ERRCNT=ERRCNT+1
QUIT
+41 ;--- Add the outside location to the list
+42 SET MAGLST(DIVIEN,ITIEN,ILIEN)=IEN
+43 SET MAGLST(DIVIEN,ITIEN)=$GET(MAGLST(DIVIEN,ITIEN))+1
+44 QUIT
End DoDot:1
+45 ;
+46 ;=== Display the associations for each division and image type
+47 SET (DIVIEN,ERRCNT)=0
+48 FOR
SET DIVIEN=$ORDER(MAGLST(DIVIEN))
if DIVIEN'>0
QUIT
Begin DoDot:1
+49 if VERBOSE
WRITE !!,"Division: "_$$DIVNAME(DIVIEN)
+50 SET ITIEN=0
+51 FOR
SET ITIEN=$ORDER(MAGLST(DIVIEN,ITIEN))
if ITIEN'>0
QUIT
Begin DoDot:2
+52 if VERBOSE
WRITE !?2,$$ITNAME(ITIEN),?32," - "
+53 ;--- No association for this division and image type
+54 IF MAGLST(DIVIEN,ITIEN)'>0
if VERBOSE
Begin DoDot:3
+55 WRITE "Create record in file #2006.5759!"
+56 QUIT
End DoDot:3
SET ERRCNT=ERRCNT+1
QUIT
+57 ;--- Multiple associations for this division and image type
+58 IF MAGLST(DIVIEN,ITIEN)>1
if VERBOSE
Begin DoDot:3
+59 WRITE "Delete redundant records in file #2006.5759!"
+60 SET ILIEN=0
+61 FOR
SET ILIEN=$ORDER(MAGLST(DIVIEN,ITIEN,ILIEN))
if ILIEN'>0
QUIT
Begin DoDot:4
+62 SET TMP=$$GET1^DIQ(79.1,ILIEN_",",.01,,,"MAGERR")
+63 if TMP=""
SET TMP="Unknown Imaging Location (IEN="_ILIEN_")"
+64 WRITE !?32," - ",TMP
+65 QUIT
End DoDot:4
+66 QUIT
End DoDot:3
SET ERRCNT=ERRCNT+1
QUIT
+67 ;--- Valid association for this division and image type
+68 SET ILIEN=$ORDER(MAGLST(DIVIEN,ITIEN,0))
+69 SET TMP=$$GET1^DIQ(79.1,ILIEN_",",.01,,,"MAGERR")
+70 IF TMP=""
Begin DoDot:3
+71 SET TMP="Unknown Imaging Location (IEN="_ILIEN_")"
+72 SET ERRCNT=ERRCNT+1
+73 QUIT
End DoDot:3
+74 if VERBOSE
WRITE TMP
+75 QUIT
End DoDot:2
+76 QUIT
End DoDot:1
+77 ;
+78 ;=== Instruct the user to fix problems in the OUTSIDE IMAGING LOCATION file
+79 IF ERRCNT>0
if VERBOSE
Begin DoDot:1
+80 WRITE !!
DO MESSAGE("MSG2")
WRITE !
+81 QUIT
End DoDot:1
if $QUIT
QUIT -2
QUIT
+82 ;
+83 ;=== Success
+84 if $QUIT
QUIT 0
QUIT
+85 ;
+86 ;+++++ RETURNS DIVISION NAME
DIVNAME(DIVIEN) ;
+1 NEW MAGERR,NAME
+2 SET NAME=$$GET1^DIQ(4,DIVIEN_",",.01,,,"MAGERR")
+3 QUIT $SELECT(NAME'="":NAME,1:"Unknown (IEN="_DIVIEN_")")
+4 ;
+5 ;+++++ RETURNS NAME OF THE IMAGING TYPE
ITNAME(ITIEN) ;
+1 NEW MAGERR,NAME
+2 SET NAME=$$GET1^DIQ(79.2,ITIEN_",",.01,,,"MAGERR")
+3 QUIT $SELECT(NAME'="":NAME,1:"Unknown Imaging Type (IEN="_ITIEN_")")
+4 ;
+5 ;+++++ FORMATS AND DISPLAYS THE MULTILINE MESSAGE
MESSAGE(TAG) ;
+1 NEW DIWF,DIWL,DIWR,MAGI,X
+2 KILL ^UTILITY($JOB,"W")
+3 SET DIWF="W"
SET DIWL=1
SET DIWR=$GET(IOM,80)-1
+4 FOR MAGI=1:1
SET X=$PIECE($TEXT(@TAG+MAGI),";;",2)
if X=""
QUIT
DO ^DIWP
+5 DO ^DIWW
+6 QUIT
+7 ;
+8 ;+++++ MESSAGES
MSG1 ;
+1 ;;Please define missing "No Credit" imaging locations for the
+2 ;;aforementioned divisions and imaging types (using the Location
+3 ;;Parameter Set-up [RA SYSLOC] and Division Parameter Set-up
+4 ;;[RA SYSDIV] options of the System Definition Menu ... [RA SYSDEF]
+5 ;;options) and then run this option again.
MSG2 ;
+1 ;;Please fix the aforementioned problems in the OUTSIDE IMAGING
+2 ;;LOCATION file (#2006.5759) and then run this option again.
