- 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 Feb 18, 2025@23:36:25 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