- 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 Jan 18, 2025@03:11:22 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