MAGVRS08 ;WOIFO/MLH,NST - RPC calls for DICOM file processing ; 28 Feb 2012 3:51 PM
;;3.0;IMAGING;**118**;Mar 19, 2002;Build 4525;May 01, 2013
;; 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
GETPATA(OUT,PATREFIEN) ; RPC - MAGV GET PAT REF ATTS
D REFRESH^MAGVRS41(.OUT,2005.6,PATREFIEN,0,1)
Q
GETPROCA(OUT,PATREFIEN,PROCREFIEN,OVERRIDE) ; RPC - MAGV GET PROC REF ATTS
D REFRESH^MAGVRS41(.OUT,2005.61,PROCREFIEN,$G(PATREFIEN),$G(OVERRIDE))
Q
GETPATI(OUT,PATREFIEN) ; RPC - MAGV GET PAT INFO
; Currently works for VA patients only
N OSEP,ISEP,SSEP,PATREFATTS,I,PATREFATTNAM
N NAMEVAL,FMPREF,PATATTS,ERROR,OUTIX,DOB,PTSENS
S OSEP=$$OUTSEP^MAGVRS41,ISEP=$$INPUTSEP^MAGVRS41,SSEP=$$STATSEP^MAGVRS41
I $D(PATREFIEN)#10=0 S OUT(1)="-1"_SSEP_SSEP_"PATIENT REFERENCE IEN NOT RECEIVED" Q
I +PATREFIEN'=PATREFIEN S OUT(1)="-2"_SSEP_SSEP_"INVALID PATIENT REFERENCE IEN FORMAT" Q
I '$D(^MAGV(2005.6,PATREFIEN)) S OUT(1)="-3"_SSEP_SSEP_"PATIENT REFERENCE NOT FOUND" Q
D REFRESH^MAGVRS41(.PATREFATTS,2005.6,PATREFIEN,0,1)
I $G(PATREFATTS(1)) S OUT(1)=PATREFATTS(1) Q ; error in pt attribute fetch
S I=1
F S I=$O(PATREFATTS(I)) Q:'I D
. S NAMEVAL=$P(PATREFATTS(I),SSEP,1)
. S PATREFATTNAM($P(NAMEVAL,OSEP,1))=$P(NAMEVAL,OSEP,2)
. Q
I $G(PATREFATTNAM("ID TYPE"))'="D" S OUT(1)="-4"_SSEP_SSEP_"VA DFNs ONLY" Q
I '$G(PATREFATTNAM("ENTERPRISE PATIENT ID")) S OUT(1)="-5"_SSEP_SSEP_"MISSING ENTERPRISE PATIENT ID" Q
S FMPREF=PATREFATTNAM("ENTERPRISE PATIENT ID")
N DFN,VA,VADM,VAERR,TMP
S DFN=FMPREF
D DEM^VADPT ; Supported IA (#10061)
I +$G(VAERR) S OUT(1)=(-$G(VAERR))_SSEP_SSEP_"NO PATIENT INFO("_DFN_")" Q
; VADM(1)=Patient's name
; VADM(5)=Patient's sex (M^MALE)
; VADM(3)=Patient's DOB (internal^external)
S TMP=$S($T(GETICN^MPIF001)'="":$$GETICN^MPIF001(DFN),1:"-1^NO MPI") ; Supported IA (#2701)
S OUTIX=1,OUT(OUTIX)=0_SSEP
S OUTIX=OUTIX+1,OUT(OUTIX)="ICN"_OSEP_TMP_SSEP
S:$D(VA("PID")) OUTIX=OUTIX+1,OUT(OUTIX)="PID"_OSEP_$TR(VA("PID"),"-","")_SSEP
S:$D(VADM(1)) OUTIX=OUTIX+1,OUT(OUTIX)="NAME"_OSEP_VADM(1)_SSEP
S:$D(VADM(5)) OUTIX=OUTIX+1,OUT(OUTIX)="SEX"_OSEP_$P(VADM(5),"^")_SSEP
S:$G(VADM(3)) OUTIX=OUTIX+1,OUT(OUTIX)="DOB"_OSEP_(17000000+VADM(3))_SSEP
; pt sensitivity
K PTSENS S:'$G(DUZ) DUZ=.5 D PTSEC^DGSEC4(.PTSENS,FMPREF) ; ICR 3027
S:$D(PTSENS(1))#10 OUTIX=OUTIX+1,OUT(OUTIX)="PATIENT SENSITIVITY"_OSEP_PTSENS(1)_SSEP
Q
GETACCNO(OUT,PATREFIEN,PROCREFIEN,OVERRIDE) ; RPC - MAGV GET ACCESSION NUM
N OSEP,ISEP,SSEP,ATTARY,ATTIX,ATTDTA,ACCNUM
S OSEP=$$OUTSEP^MAGVRS41,ISEP=$$INPUTSEP^MAGVRS41,SSEP=$$STATSEP^MAGVRS41
D REFRESH^MAGVRS41(.ATTARY,2005.61,PROCREFIEN,$G(PATREFIEN),$G(OVERRIDE))
I ATTARY(1) S OUT(1)=ATTARY(1) Q ; an exception was found
S ATTIX=1
F S ATTIX=$O(ATTARY(ATTIX)) Q:'ATTIX D Q:$D(ACCNUM)
. S ATTDTA=ATTARY(ATTIX)
. S:$P(ATTDTA,OSEP,1)="ACCESSION NUMBER" ACCNUM=$P(ATTDTA,OSEP,2)
. Q
S OUT=$S($G(ACCNUM)'="":0_SSEP_ACCNUM,1:-99_SSEP_SSEP_"Accession number not defined")
Q
GETPROCI(OUT,PATREFIEN,PROCREFIEN,OVERRIDE) ; RPC - MAGV GET PROCEDURE INFO
N OSEP,ISEP,SSEP,PROCARY,ACCRETURN,ACCNUM,PROCARYIX,NAMVAL,SPCLTY,ACCNUM
S OSEP=$$OUTSEP^MAGVRS41,ISEP=$$INPUTSEP^MAGVRS41,SSEP=$$STATSEP^MAGVRS41
D GETPROCA(.PROCARY,$G(PATREFIEN),$G(PROCREFIEN),$G(OVERRIDE))
I $G(PROCARY(1)) S OUT(1)=PROCARY(1) Q ; an exception was found
S PROCARYIX=1
F S PROCARYIX=$O(PROCARY(PROCARYIX)) Q:'PROCARYIX D
. S NAMVAL=$P(PROCARY(PROCARYIX),SSEP,1)
. I $P(NAMVAL,OSEP,1)="PROCEDURE TYPE" S SPCLTY=$P(NAMVAL,OSEP,2) Q
. I $P(NAMVAL,OSEP,1)="ACCESSION NUMBER" S ACCNUM=$P(NAMVAL,OSEP,2) Q
. Q
I $G(SPCLTY)="" S OUT(1)="-21"_SSEP_SSEP_"No specialty associated with procedure reference" Q
I $G(ACCNUM)="" S OUT(1)="-22"_SSEP_SSEP_"No accession number associated with procedure reference" Q
I SPCLTY="RAD" D GETRPROC^MAGVRS81(.OUT,ACCNUM) Q
I SPCLTY="CON" D GETCPROC^MAGVRS82(.OUT,ACCNUM) Q
S OUT(1)="-199"_SSEP_SSEP_"Specialty "_SPCLTY_" not processed at this time" Q
Q
;
GETRPT(OUT,PATREFIEN,PROCREFIEN,OVERRIDE) ; RPC - MAGV GET REPORT
N OSEP,ISEP,SSEP,ACCRETURN,ACCNUM,PROCARYIX,NAMVAL,SPCLTY,ACCNUM
S OSEP=$$OUTSEP^MAGVRS41,ISEP=$$INPUTSEP^MAGVRS41,SSEP=$$STATSEP^MAGVRS41
D GETPROCA(.PROCARY,$G(PATREFIEN),$G(PROCREFIEN),$G(OVERRIDE))
I $G(PROCARY(1)) S OUT(1)=PROCARY(1) Q ; an exception was found
S PROCARYIX=1
F S PROCARYIX=$O(PROCARY(PROCARYIX)) Q:'PROCARYIX D
. S NAMVAL=$P(PROCARY(PROCARYIX),SSEP,1)
. I $P(NAMVAL,OSEP,1)="PROCEDURE TYPE" S SPCLTY=$P(NAMVAL,OSEP,2) Q
. I $P(NAMVAL,OSEP,1)="ACCESSION NUMBER" S ACCNUM=$P(NAMVAL,OSEP,2) Q
. Q
I $G(SPCLTY)="" S OUT(1)="-21"_SSEP_SSEP_"No specialty associated with procedure reference" Q
I $G(ACCNUM)="" S OUT(1)="-22"_SSEP_SSEP_"No accession number associated with procedure reference" Q
I SPCLTY="RAD" D GETRRPT^MAGVRS81(.OUT,ACCNUM) Q
I SPCLTY="CON" D GETCRPT^MAGVRS82(.OUT,ACCNUM) Q
S OUT(1)="-199"_SSEP_SSEP_"Specialty "_SPCLTY_" not processed at this time" Q
Q
POP(ARY,NAME,VALUE) ; populate an array with a name value pair
S ARY($O(ARY(" "),-1)+1)=NAME_OSEP_VALUE_SSEP
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGVRS08 6078 printed Oct 16, 2024@18:10:48 Page 2
MAGVRS08 ;WOIFO/MLH,NST - RPC calls for DICOM file processing ; 28 Feb 2012 3:51 PM
+1 ;;3.0;IMAGING;**118**;Mar 19, 2002;Build 4525;May 01, 2013
+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
GETPATA(OUT,PATREFIEN) ; RPC - MAGV GET PAT REF ATTS
+1 DO REFRESH^MAGVRS41(.OUT,2005.6,PATREFIEN,0,1)
+2 QUIT
GETPROCA(OUT,PATREFIEN,PROCREFIEN,OVERRIDE) ; RPC - MAGV GET PROC REF ATTS
+1 DO REFRESH^MAGVRS41(.OUT,2005.61,PROCREFIEN,$GET(PATREFIEN),$GET(OVERRIDE))
+2 QUIT
GETPATI(OUT,PATREFIEN) ; RPC - MAGV GET PAT INFO
+1 ; Currently works for VA patients only
+2 NEW OSEP,ISEP,SSEP,PATREFATTS,I,PATREFATTNAM
+3 NEW NAMEVAL,FMPREF,PATATTS,ERROR,OUTIX,DOB,PTSENS
+4 SET OSEP=$$OUTSEP^MAGVRS41
SET ISEP=$$INPUTSEP^MAGVRS41
SET SSEP=$$STATSEP^MAGVRS41
+5 IF $DATA(PATREFIEN)#10=0
SET OUT(1)="-1"_SSEP_SSEP_"PATIENT REFERENCE IEN NOT RECEIVED"
QUIT
+6 IF +PATREFIEN'=PATREFIEN
SET OUT(1)="-2"_SSEP_SSEP_"INVALID PATIENT REFERENCE IEN FORMAT"
QUIT
+7 IF '$DATA(^MAGV(2005.6,PATREFIEN))
SET OUT(1)="-3"_SSEP_SSEP_"PATIENT REFERENCE NOT FOUND"
QUIT
+8 DO REFRESH^MAGVRS41(.PATREFATTS,2005.6,PATREFIEN,0,1)
+9 ; error in pt attribute fetch
IF $GET(PATREFATTS(1))
SET OUT(1)=PATREFATTS(1)
QUIT
+10 SET I=1
+11 FOR
SET I=$ORDER(PATREFATTS(I))
if 'I
QUIT
Begin DoDot:1
+12 SET NAMEVAL=$PIECE(PATREFATTS(I),SSEP,1)
+13 SET PATREFATTNAM($PIECE(NAMEVAL,OSEP,1))=$PIECE(NAMEVAL,OSEP,2)
+14 QUIT
End DoDot:1
+15 IF $GET(PATREFATTNAM("ID TYPE"))'="D"
SET OUT(1)="-4"_SSEP_SSEP_"VA DFNs ONLY"
QUIT
+16 IF '$GET(PATREFATTNAM("ENTERPRISE PATIENT ID"))
SET OUT(1)="-5"_SSEP_SSEP_"MISSING ENTERPRISE PATIENT ID"
QUIT
+17 SET FMPREF=PATREFATTNAM("ENTERPRISE PATIENT ID")
+18 NEW DFN,VA,VADM,VAERR,TMP
+19 SET DFN=FMPREF
+20 ; Supported IA (#10061)
DO DEM^VADPT
+21 IF +$GET(VAERR)
SET OUT(1)=(-$GET(VAERR))_SSEP_SSEP_"NO PATIENT INFO("_DFN_")"
QUIT
+22 ; VADM(1)=Patient's name
+23 ; VADM(5)=Patient's sex (M^MALE)
+24 ; VADM(3)=Patient's DOB (internal^external)
+25 ; Supported IA (#2701)
SET TMP=$SELECT($TEXT(GETICN^MPIF001)'="":$$GETICN^MPIF001(DFN),1:"-1^NO MPI")
+26 SET OUTIX=1
SET OUT(OUTIX)=0_SSEP
+27 SET OUTIX=OUTIX+1
SET OUT(OUTIX)="ICN"_OSEP_TMP_SSEP
+28 if $DATA(VA("PID"))
SET OUTIX=OUTIX+1
SET OUT(OUTIX)="PID"_OSEP_$TRANSLATE(VA("PID"),"-","")_SSEP
+29 if $DATA(VADM(1))
SET OUTIX=OUTIX+1
SET OUT(OUTIX)="NAME"_OSEP_VADM(1)_SSEP
+30 if $DATA(VADM(5))
SET OUTIX=OUTIX+1
SET OUT(OUTIX)="SEX"_OSEP_$PIECE(VADM(5),"^")_SSEP
+31 if $GET(VADM(3))
SET OUTIX=OUTIX+1
SET OUT(OUTIX)="DOB"_OSEP_(17000000+VADM(3))_SSEP
+32 ; pt sensitivity
+33 ; ICR 3027
KILL PTSENS
if '$GET(DUZ)
SET DUZ=.5
DO PTSEC^DGSEC4(.PTSENS,FMPREF)
+34 if $DATA(PTSENS(1))#10
SET OUTIX=OUTIX+1
SET OUT(OUTIX)="PATIENT SENSITIVITY"_OSEP_PTSENS(1)_SSEP
+35 QUIT
GETACCNO(OUT,PATREFIEN,PROCREFIEN,OVERRIDE) ; RPC - MAGV GET ACCESSION NUM
+1 NEW OSEP,ISEP,SSEP,ATTARY,ATTIX,ATTDTA,ACCNUM
+2 SET OSEP=$$OUTSEP^MAGVRS41
SET ISEP=$$INPUTSEP^MAGVRS41
SET SSEP=$$STATSEP^MAGVRS41
+3 DO REFRESH^MAGVRS41(.ATTARY,2005.61,PROCREFIEN,$GET(PATREFIEN),$GET(OVERRIDE))
+4 ; an exception was found
IF ATTARY(1)
SET OUT(1)=ATTARY(1)
QUIT
+5 SET ATTIX=1
+6 FOR
SET ATTIX=$ORDER(ATTARY(ATTIX))
if 'ATTIX
QUIT
Begin DoDot:1
+7 SET ATTDTA=ATTARY(ATTIX)
+8 if $PIECE(ATTDTA,OSEP,1)="ACCESSION NUMBER"
SET ACCNUM=$PIECE(ATTDTA,OSEP,2)
+9 QUIT
End DoDot:1
if $DATA(ACCNUM)
QUIT
+10 SET OUT=$SELECT($GET(ACCNUM)'="":0_SSEP_ACCNUM,1:-99_SSEP_SSEP_"Accession number not defined")
+11 QUIT
GETPROCI(OUT,PATREFIEN,PROCREFIEN,OVERRIDE) ; RPC - MAGV GET PROCEDURE INFO
+1 NEW OSEP,ISEP,SSEP,PROCARY,ACCRETURN,ACCNUM,PROCARYIX,NAMVAL,SPCLTY,ACCNUM
+2 SET OSEP=$$OUTSEP^MAGVRS41
SET ISEP=$$INPUTSEP^MAGVRS41
SET SSEP=$$STATSEP^MAGVRS41
+3 DO GETPROCA(.PROCARY,$GET(PATREFIEN),$GET(PROCREFIEN),$GET(OVERRIDE))
+4 ; an exception was found
IF $GET(PROCARY(1))
SET OUT(1)=PROCARY(1)
QUIT
+5 SET PROCARYIX=1
+6 FOR
SET PROCARYIX=$ORDER(PROCARY(PROCARYIX))
if 'PROCARYIX
QUIT
Begin DoDot:1
+7 SET NAMVAL=$PIECE(PROCARY(PROCARYIX),SSEP,1)
+8 IF $PIECE(NAMVAL,OSEP,1)="PROCEDURE TYPE"
SET SPCLTY=$PIECE(NAMVAL,OSEP,2)
QUIT
+9 IF $PIECE(NAMVAL,OSEP,1)="ACCESSION NUMBER"
SET ACCNUM=$PIECE(NAMVAL,OSEP,2)
QUIT
+10 QUIT
End DoDot:1
+11 IF $GET(SPCLTY)=""
SET OUT(1)="-21"_SSEP_SSEP_"No specialty associated with procedure reference"
QUIT
+12 IF $GET(ACCNUM)=""
SET OUT(1)="-22"_SSEP_SSEP_"No accession number associated with procedure reference"
QUIT
+13 IF SPCLTY="RAD"
DO GETRPROC^MAGVRS81(.OUT,ACCNUM)
QUIT
+14 IF SPCLTY="CON"
DO GETCPROC^MAGVRS82(.OUT,ACCNUM)
QUIT
+15 SET OUT(1)="-199"_SSEP_SSEP_"Specialty "_SPCLTY_" not processed at this time"
QUIT
+16 QUIT
+17 ;
GETRPT(OUT,PATREFIEN,PROCREFIEN,OVERRIDE) ; RPC - MAGV GET REPORT
+1 NEW OSEP,ISEP,SSEP,ACCRETURN,ACCNUM,PROCARYIX,NAMVAL,SPCLTY,ACCNUM
+2 SET OSEP=$$OUTSEP^MAGVRS41
SET ISEP=$$INPUTSEP^MAGVRS41
SET SSEP=$$STATSEP^MAGVRS41
+3 DO GETPROCA(.PROCARY,$GET(PATREFIEN),$GET(PROCREFIEN),$GET(OVERRIDE))
+4 ; an exception was found
IF $GET(PROCARY(1))
SET OUT(1)=PROCARY(1)
QUIT
+5 SET PROCARYIX=1
+6 FOR
SET PROCARYIX=$ORDER(PROCARY(PROCARYIX))
if 'PROCARYIX
QUIT
Begin DoDot:1
+7 SET NAMVAL=$PIECE(PROCARY(PROCARYIX),SSEP,1)
+8 IF $PIECE(NAMVAL,OSEP,1)="PROCEDURE TYPE"
SET SPCLTY=$PIECE(NAMVAL,OSEP,2)
QUIT
+9 IF $PIECE(NAMVAL,OSEP,1)="ACCESSION NUMBER"
SET ACCNUM=$PIECE(NAMVAL,OSEP,2)
QUIT
+10 QUIT
End DoDot:1
+11 IF $GET(SPCLTY)=""
SET OUT(1)="-21"_SSEP_SSEP_"No specialty associated with procedure reference"
QUIT
+12 IF $GET(ACCNUM)=""
SET OUT(1)="-22"_SSEP_SSEP_"No accession number associated with procedure reference"
QUIT
+13 IF SPCLTY="RAD"
DO GETRRPT^MAGVRS81(.OUT,ACCNUM)
QUIT
+14 IF SPCLTY="CON"
DO GETCRPT^MAGVRS82(.OUT,ACCNUM)
QUIT
+15 SET OUT(1)="-199"_SSEP_SSEP_"Specialty "_SPCLTY_" not processed at this time"
QUIT
+16 QUIT
POP(ARY,NAME,VALUE) ; populate an array with a name value pair
+1 SET ARY($ORDER(ARY(" "),-1)+1)=NAME_OSEP_VALUE_SSEP
+2 QUIT
