MAGVIM10 ;WOIFO/PMK/MLS/SG/DAC/JSL/MAT - Imaging RPCs for Importer ; 30 Jul 2013 7:28 PM
;;3.0;IMAGING;**118,138,164**;Mar 19, 2002;Build 35;Nov 03, 2016
;; 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
;***** RETURNS THE LIST OF RADIOLOGY PROCEDURES
; RPC: MAGV GET RADIOLOGY PROCEDURES
;
; Modified from PROC^MAGDRPCA (RPC: MAG DICOM RADIOLOGY PROCEDURES)
; for MAG*3.0*118.
;
; .ARRAY Reference to a local variable where results
; are returned to.
;
; STATIONUM STATION NUMBER (#99) of an INSTITUTION file (#4) entry.
;
; IENMAGLOC IEN of an entry in the IMAGING LOCATIONS file(#79.1)
;
; [IENRAPROC] IEN of an entry in the RAD/NUC MED PROCEDURES file (#71)
;
; NOTE
; ====
;
; Does not return procedure types of "B"road or "P"arent if a list is
; requested (vs. a single procedure).
;
; The call to $$IEN^XUAF4() is Supported IA#1271.
; Direct reads of ^RAMIS(71, via Private IA#1174.
;
GETPROCS(ARRAY,STATIONUM,IENMAGLOC,IENRAPROC) ;
;
;--- Initialize.
N IMAGTYPE ; IEN of the imaging type (file #79.2)
N INACTDAT ; Inactivation date of the procedure
N RADPROC ; Radiology procedure data (file #71)
N TODAY ; today's date in Fileman format
N PROCTYPE ; Type of procedure
;
N IEN
N MAGX S MAGX=""
K ARRAY
S (ARRAY(1),IEN)=0,TODAY=$$DT^XLFDT()
;
;--- Validate parameters
S IENRAPROC=$G(IENRAPROC)
;;S STATIONUM=$G(STATIONUM) ;;P164 took out STATIONUM, IENINST by David M (#I10555403FY16)
;;I (STATIONUM'>0) D Q ;;P164 RPC is based on the RA Imaging Location selected by the user, not the arbitrary check on Institution .vs Imaging Location Division
;;. S ARRAY(1)="-1,Invalid STATION NUMBER: '"_STATIONUM_"'."
;;. Q
;
;;--- Get IEN of INSTITUTION file (#4) from STATION NUMBER (Supported IA# 2171).
;;N IENINST S IENINST=$$IEN^XUAF4(STATIONUM) ;P164 took out STATIONUM, IENINST
;;
;;I IENINST="" D Q
;;. S ARRAY(1)="-2,Could not resolve Institution from STATION NUMBER '"_STATIONUM_"'."
;;. Q
;
;--- Output a single RAD/NUC MED PROCEDURE file (#71) entry.
I IENRAPROC'="" S IEN=IENRAPROC D
. S RADPROC=^RAMIS(71,IEN,0),IMAGTYPE=+$P(RADPROC,U,12)
. S MAGX=$O(^RA(79.1,"BIMG",IMAGTYPE,""))
. Q:MAGX=""
. D OUTPUT(MAGX)
. Q
;--- Loop through the RAD/NUC MED PROCEDURES file (#71).
E D
. F S IEN=$O(^RAMIS(71,IEN)) Q:'IEN D CHEKINST
. Q
Q
;
;+++++ Internal entry point: Validate a procedures' institution matches.
;
CHEKINST ;
S RADPROC=^RAMIS(71,IEN,0),IMAGTYPE=+$P(RADPROC,U,12)
;
;--- Select by input IMAGING LOCATION (#79.1).
N MAGXX,MATCH S (MAGXX,MATCH)=0
F S MAGXX=$O(^RA(79.1,"BIMG",IMAGTYPE,MAGXX)) Q:MAGXX="" Q:MATCH>0 D
. ;
. ;--- Resolve HOSPITAL LOCATION file IEN from IMAGING LOCATION.
. N IENHSPLOC S IENHSPLOC=$$GET1^DIQ(79.1,MAGXX,.01,"I")
. ;
. ;--- Resolve the INSTITUTION file (#4) IEN.
. N IENINSPRC S IENINSPRC=$$GET1^DIQ(44,IENHSPLOC,3,"I")
. ;
. ;--- Quit if not in the same INSTITUTION.
. ;;Q:IENINSPRC'=IENINST ;;p164 David M took out IENINST
. S:MAGXX=IENMAGLOC MATCH=MATCH+1,MAGX=MAGXX
. Q
Q:MATCH=0 D OUTPUT(MAGX)
Q
;
;+++++ Internal entry point: Assemble output for one record.
;
OUTPUT(MAGX) ;
N BUF S BUF=$P(RADPROC,U)_U_IEN ; Procedure Name and IEN
S PROCTYPE=$P(RADPROC,U,6) ; Type of Procedure
;
;--- Iff list output (LOCATION was input), filter out 'B'road, 'P'arent.
N FILTER S FILTER=$S(IENMAGLOC'="":1,1:0)
I FILTER=1,(PROCTYPE="B")!(PROCTYPE="P") Q
S $P(BUF,U,3)=PROCTYPE ; Type of Procedure
S $P(BUF,U,4)=$P(RADPROC,U,9) ; CPT Code (file #81)
S $P(BUF,U,5)=IMAGTYPE ; Type of Imaging (file #79.2)
S INACTDAT=$P($G(^RAMIS(71,IEN,"I")),U)
I INACTDAT,INACTDAT<TODAY Q ; ignore inactive procedures
S $P(BUF,U,6)=INACTDAT ; Inactivation Date
S $P(BUF,U,7)=$S(IENMAGLOC="":MAGX,1:IENMAGLOC) ; Imaging Location (file #79.1)
;
;--- Resolve HOSPITAL LOCATION file IEN from IMAGING LOCATION.
N IENHSPLOC S IENHSPLOC=$$GET1^DIQ(79.1,MAGX,.01,"I")
S $P(BUF,U,8)=IENHSPLOC ; Hospital Location file (#44) - IEN
S $P(BUF,U,9)=$$GET1^DIQ(44,IENHSPLOC,.01) ; Hospital Location file (#44) - NAME
;
;--- Add the descriptor to the result array
S ARRAY(1)=ARRAY(1)+1,ARRAY(ARRAY(1)+1)=BUF
Q
;
; MAGVIM10
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGVIM10 5360 printed Oct 16, 2024@18:10:37 Page 2
MAGVIM10 ;WOIFO/PMK/MLS/SG/DAC/JSL/MAT - Imaging RPCs for Importer ; 30 Jul 2013 7:28 PM
+1 ;;3.0;IMAGING;**118,138,164**;Mar 19, 2002;Build 35;Nov 03, 2016
+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 ;***** RETURNS THE LIST OF RADIOLOGY PROCEDURES
+19 ; RPC: MAGV GET RADIOLOGY PROCEDURES
+20 ;
+21 ; Modified from PROC^MAGDRPCA (RPC: MAG DICOM RADIOLOGY PROCEDURES)
+22 ; for MAG*3.0*118.
+23 ;
+24 ; .ARRAY Reference to a local variable where results
+25 ; are returned to.
+26 ;
+27 ; STATIONUM STATION NUMBER (#99) of an INSTITUTION file (#4) entry.
+28 ;
+29 ; IENMAGLOC IEN of an entry in the IMAGING LOCATIONS file(#79.1)
+30 ;
+31 ; [IENRAPROC] IEN of an entry in the RAD/NUC MED PROCEDURES file (#71)
+32 ;
+33 ; NOTE
+34 ; ====
+35 ;
+36 ; Does not return procedure types of "B"road or "P"arent if a list is
+37 ; requested (vs. a single procedure).
+38 ;
+39 ; The call to $$IEN^XUAF4() is Supported IA#1271.
+40 ; Direct reads of ^RAMIS(71, via Private IA#1174.
+41 ;
GETPROCS(ARRAY,STATIONUM,IENMAGLOC,IENRAPROC) ;
+1 ;
+2 ;--- Initialize.
+3 ; IEN of the imaging type (file #79.2)
NEW IMAGTYPE
+4 ; Inactivation date of the procedure
NEW INACTDAT
+5 ; Radiology procedure data (file #71)
NEW RADPROC
+6 ; today's date in Fileman format
NEW TODAY
+7 ; Type of procedure
NEW PROCTYPE
+8 ;
+9 NEW IEN
+10 NEW MAGX
SET MAGX=""
+11 KILL ARRAY
+12 SET (ARRAY(1),IEN)=0
SET TODAY=$$DT^XLFDT()
+13 ;
+14 ;--- Validate parameters
+15 SET IENRAPROC=$GET(IENRAPROC)
+16 ;;S STATIONUM=$G(STATIONUM) ;;P164 took out STATIONUM, IENINST by David M (#I10555403FY16)
+17 ;;I (STATIONUM'>0) D Q ;;P164 RPC is based on the RA Imaging Location selected by the user, not the arbitrary check on Institution .vs Imaging Location Division
+18 ;;. S ARRAY(1)="-1,Invalid STATION NUMBER: '"_STATIONUM_"'."
+19 ;;. Q
+20 ;
+21 ;;--- Get IEN of INSTITUTION file (#4) from STATION NUMBER (Supported IA# 2171).
+22 ;;N IENINST S IENINST=$$IEN^XUAF4(STATIONUM) ;P164 took out STATIONUM, IENINST
+23 ;;
+24 ;;I IENINST="" D Q
+25 ;;. S ARRAY(1)="-2,Could not resolve Institution from STATION NUMBER '"_STATIONUM_"'."
+26 ;;. Q
+27 ;
+28 ;--- Output a single RAD/NUC MED PROCEDURE file (#71) entry.
+29 IF IENRAPROC'=""
SET IEN=IENRAPROC
Begin DoDot:1
+30 SET RADPROC=^RAMIS(71,IEN,0)
SET IMAGTYPE=+$PIECE(RADPROC,U,12)
+31 SET MAGX=$ORDER(^RA(79.1,"BIMG",IMAGTYPE,""))
+32 if MAGX=""
QUIT
+33 DO OUTPUT(MAGX)
+34 QUIT
End DoDot:1
+35 ;--- Loop through the RAD/NUC MED PROCEDURES file (#71).
+36 IF '$TEST
Begin DoDot:1
+37 FOR
SET IEN=$ORDER(^RAMIS(71,IEN))
if 'IEN
QUIT
DO CHEKINST
+38 QUIT
End DoDot:1
+39 QUIT
+40 ;
+41 ;+++++ Internal entry point: Validate a procedures' institution matches.
+42 ;
CHEKINST ;
+1 SET RADPROC=^RAMIS(71,IEN,0)
SET IMAGTYPE=+$PIECE(RADPROC,U,12)
+2 ;
+3 ;--- Select by input IMAGING LOCATION (#79.1).
+4 NEW MAGXX,MATCH
SET (MAGXX,MATCH)=0
+5 FOR
SET MAGXX=$ORDER(^RA(79.1,"BIMG",IMAGTYPE,MAGXX))
if MAGXX=""
QUIT
if MATCH>0
QUIT
Begin DoDot:1
+6 ;
+7 ;--- Resolve HOSPITAL LOCATION file IEN from IMAGING LOCATION.
+8 NEW IENHSPLOC
SET IENHSPLOC=$$GET1^DIQ(79.1,MAGXX,.01,"I")
+9 ;
+10 ;--- Resolve the INSTITUTION file (#4) IEN.
+11 NEW IENINSPRC
SET IENINSPRC=$$GET1^DIQ(44,IENHSPLOC,3,"I")
+12 ;
+13 ;--- Quit if not in the same INSTITUTION.
+14 ;;Q:IENINSPRC'=IENINST ;;p164 David M took out IENINST
+15 if MAGXX=IENMAGLOC
SET MATCH=MATCH+1
SET MAGX=MAGXX
+16 QUIT
End DoDot:1
+17 if MATCH=0
QUIT
DO OUTPUT(MAGX)
+18 QUIT
+19 ;
+20 ;+++++ Internal entry point: Assemble output for one record.
+21 ;
OUTPUT(MAGX) ;
+1 ; Procedure Name and IEN
NEW BUF
SET BUF=$PIECE(RADPROC,U)_U_IEN
+2 ; Type of Procedure
SET PROCTYPE=$PIECE(RADPROC,U,6)
+3 ;
+4 ;--- Iff list output (LOCATION was input), filter out 'B'road, 'P'arent.
+5 NEW FILTER
SET FILTER=$SELECT(IENMAGLOC'="":1,1:0)
+6 IF FILTER=1
IF (PROCTYPE="B")!(PROCTYPE="P")
QUIT
+7 ; Type of Procedure
SET $PIECE(BUF,U,3)=PROCTYPE
+8 ; CPT Code (file #81)
SET $PIECE(BUF,U,4)=$PIECE(RADPROC,U,9)
+9 ; Type of Imaging (file #79.2)
SET $PIECE(BUF,U,5)=IMAGTYPE
+10 SET INACTDAT=$PIECE($GET(^RAMIS(71,IEN,"I")),U)
+11 ; ignore inactive procedures
IF INACTDAT
IF INACTDAT<TODAY
QUIT
+12 ; Inactivation Date
SET $PIECE(BUF,U,6)=INACTDAT
+13 ; Imaging Location (file #79.1)
SET $PIECE(BUF,U,7)=$SELECT(IENMAGLOC="":MAGX,1:IENMAGLOC)
+14 ;
+15 ;--- Resolve HOSPITAL LOCATION file IEN from IMAGING LOCATION.
+16 NEW IENHSPLOC
SET IENHSPLOC=$$GET1^DIQ(79.1,MAGX,.01,"I")
+17 ; Hospital Location file (#44) - IEN
SET $PIECE(BUF,U,8)=IENHSPLOC
+18 ; Hospital Location file (#44) - NAME
SET $PIECE(BUF,U,9)=$$GET1^DIQ(44,IENHSPLOC,.01)
+19 ;
+20 ;--- Add the descriptor to the result array
+21 SET ARRAY(1)=ARRAY(1)+1
SET ARRAY(ARRAY(1)+1)=BUF
+22 QUIT
+23 ;
+24 ; MAGVIM10
