MAGDRPCC ;WOIFO/PMK - Imaging RPCs ; Mar 07, 2022@09:43:28
;;3.0;IMAGING;**138,305**;Mar 19, 2002;Build 3
;; 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
;
CONLKUP(OUT,ACNUMB) ; RPC = MAG DICOM LOOKUP CON STUDY
; Consult patient/study lookup
N A ;-------- array data from $$GETS^DIQ
N CPTIEN ;--- ien for file #81
N CPTCODE ;-- CPT code for the procedure
N CPTNAME ;-- CPT name for the procedure
N CPTSCHM ;-- CPT coding scheme
N DATETIME ;- timestamp
N DFN ;------ patient pointer
N EXAMSTS ;-- exam status (don't post images to CANCELLED exams)
N GMRCIEN ;-- IEN for REQUEST/CONSULTATION file (#123)
N GMRCIENS ;- GMRC concatenated with a comma (for GETS^DIQ results)
N PROCEDURE ; procedure (#123.3) <internal ^ external>
N PROCIEN ;-- radiology procedure ien in ^RAMIS(71)
N SERVICE ;-- request service (#123.5) <internal ^ external)>
N TIMESTAMP ; date/time of last activity
N VACODE ;--- VA code for the procedure
N VANAME ;--- VA name for the procedure
N VASCHM ;-- VA coding scheme
N IEN,X
; find the patient/study in ^GMR using the Consult Accession Number
K OUT
;
I $G(ACNUMB)="" S OUT(1)="-1,No Accession Number Specified" Q
;
S GMRCIEN=$$GMRCIEN^MAGDFCNV(ACNUMB),GMRCIENS=GMRCIEN_","
;
D GETS^DIQ(123,GMRCIEN,"**","EI","A")
I '$D(A) S OUT(1)="-2,Error in Accession Number Lookup" Q
;
; get patient demographics file pointer
S DFN=A(123,GMRCIENS,.02,"I")
;
; get the request service and procedure (if present)
S SERVICE=A(123,GMRCIENS,1,"I")_"^"_A(123,GMRCIENS,1,"E")
S X=A(123,GMRCIENS,4,"I") I X?1N.N1";GMR(123.3," S X=$P(X,";",1)
S PROCEDURE=X_"^"_A(123,GMRCIENS,4,"E")
I PROCEDURE="^" D ; consult
. S VACODE="C"_$P(SERVICE,"^",1)
. S VANAME=$P(SERVICE,"^",2)
. S VASCHM="99CON"
. Q
E D ; procedure
. S VACODE="P"_$P(PROCEDURE,"^",1)
. S VANAME=$P(PROCEDURE,"^",2)
. S VASCHM="99PROC"
. Q
;
; get CPT code and CPT name
S IEN=$$IREQUEST^MAGDHOW1(+SERVICE,+PROCEDURE)
I IEN S CPTIEN=$P(^MAG(2006.5831,IEN,0),"^",6)
E S CPTIEN=""
I CPTIEN'="" D
. S CPTCODE=$$GET1^DIQ(81,CPTIEN,.01)
. S CPTNAME=$$GET1^DIQ(81,CPTIEN,2)
. S CPTSCHM="C4"
. Q
E D ; use VA values for CPT
. S CPTCODE=VACODE
. S CPTNAME=VANAME
. S CPTSCHM=VASCHM
. Q
;
; get exam status
S EXAMSTS=A(123,GMRCIENS,8,"E")
;
S TIMESTAMP=A(123.02,"1,"_GMRCIENS,2,"I")
;
; stuff the data into the return array
;
S OUT(1)=1 ; OK
S OUT(2)=DFN
S OUT(3)=SERVICE
S OUT(4)=PROCEDURE
S OUT(5)=VACODE
S OUT(6)=VANAME
S OUT(7)=VASCHM
S OUT(8)=CPTCODE
S OUT(9)=CPTNAME
S OUT(10)=CPTSCHM
S OUT(11)=$G(TIMESTAMP)
S OUT(12)=EXAMSTS
S OUT(13)=$$STATNUMB^MAGDFCNV()
S OUT(14)=$$GMRCACN^MAGDFCNV(GMRCIEN)
S OUT(15)=GMRCIEN
Q
;
XMITSTAT(OUT,D0) ; RPC = MAG DICOM GET XMIT STATS
; return statistics array for a DICOM Export
N D1,STATUS,X
K OUT
I '$G(D0) S OUT="-1,IEN for DICOM OBJECT EXPORT file (#2006.574) is missing" Q
I '$D(^MAGDOUTP(2006.574,D0)) S OUT="-2,No entry #"_D0_" in DICOM OBJECT EXPORT file (#2006.574)" Q
S OUT=1 ; indicate output
S D1=0 F S D1=$O(^MAGDOUTP(2006.574,D0,1,D1)) Q:'D1 D
. S X=$G(^MAGDOUTP(2006.574,D0,1,D1,0))
. S STATUS=$P(X,"^",2)
. S OUT(STATUS)=($P($G(OUT(STATUS)),"^",1)+1)_"^"_STATUS
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDRPCC 4243 printed Nov 22, 2024@17:11:39 Page 2
MAGDRPCC ;WOIFO/PMK - Imaging RPCs ; Mar 07, 2022@09:43:28
+1 ;;3.0;IMAGING;**138,305**;Mar 19, 2002;Build 3
+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 ;
CONLKUP(OUT,ACNUMB) ; RPC = MAG DICOM LOOKUP CON STUDY
+1 ; Consult patient/study lookup
+2 ;-------- array data from $$GETS^DIQ
NEW A
+3 ;--- ien for file #81
NEW CPTIEN
+4 ;-- CPT code for the procedure
NEW CPTCODE
+5 ;-- CPT name for the procedure
NEW CPTNAME
+6 ;-- CPT coding scheme
NEW CPTSCHM
+7 ;- timestamp
NEW DATETIME
+8 ;------ patient pointer
NEW DFN
+9 ;-- exam status (don't post images to CANCELLED exams)
NEW EXAMSTS
+10 ;-- IEN for REQUEST/CONSULTATION file (#123)
NEW GMRCIEN
+11 ;- GMRC concatenated with a comma (for GETS^DIQ results)
NEW GMRCIENS
+12 ; procedure (#123.3) <internal ^ external>
NEW PROCEDURE
+13 ;-- radiology procedure ien in ^RAMIS(71)
NEW PROCIEN
+14 ;-- request service (#123.5) <internal ^ external)>
NEW SERVICE
+15 ; date/time of last activity
NEW TIMESTAMP
+16 ;--- VA code for the procedure
NEW VACODE
+17 ;--- VA name for the procedure
NEW VANAME
+18 ;-- VA coding scheme
NEW VASCHM
+19 NEW IEN,X
+20 ; find the patient/study in ^GMR using the Consult Accession Number
+21 KILL OUT
+22 ;
+23 IF $GET(ACNUMB)=""
SET OUT(1)="-1,No Accession Number Specified"
QUIT
+24 ;
+25 SET GMRCIEN=$$GMRCIEN^MAGDFCNV(ACNUMB)
SET GMRCIENS=GMRCIEN_","
+26 ;
+27 DO GETS^DIQ(123,GMRCIEN,"**","EI","A")
+28 IF '$DATA(A)
SET OUT(1)="-2,Error in Accession Number Lookup"
QUIT
+29 ;
+30 ; get patient demographics file pointer
+31 SET DFN=A(123,GMRCIENS,.02,"I")
+32 ;
+33 ; get the request service and procedure (if present)
+34 SET SERVICE=A(123,GMRCIENS,1,"I")_"^"_A(123,GMRCIENS,1,"E")
+35 SET X=A(123,GMRCIENS,4,"I")
IF X?1N.N1";GMR(123.3,"
SET X=$PIECE(X,";",1)
+36 SET PROCEDURE=X_"^"_A(123,GMRCIENS,4,"E")
+37 ; consult
IF PROCEDURE="^"
Begin DoDot:1
+38 SET VACODE="C"_$PIECE(SERVICE,"^",1)
+39 SET VANAME=$PIECE(SERVICE,"^",2)
+40 SET VASCHM="99CON"
+41 QUIT
End DoDot:1
+42 ; procedure
IF '$TEST
Begin DoDot:1
+43 SET VACODE="P"_$PIECE(PROCEDURE,"^",1)
+44 SET VANAME=$PIECE(PROCEDURE,"^",2)
+45 SET VASCHM="99PROC"
+46 QUIT
End DoDot:1
+47 ;
+48 ; get CPT code and CPT name
+49 SET IEN=$$IREQUEST^MAGDHOW1(+SERVICE,+PROCEDURE)
+50 IF IEN
SET CPTIEN=$PIECE(^MAG(2006.5831,IEN,0),"^",6)
+51 IF '$TEST
SET CPTIEN=""
+52 IF CPTIEN'=""
Begin DoDot:1
+53 SET CPTCODE=$$GET1^DIQ(81,CPTIEN,.01)
+54 SET CPTNAME=$$GET1^DIQ(81,CPTIEN,2)
+55 SET CPTSCHM="C4"
+56 QUIT
End DoDot:1
+57 ; use VA values for CPT
IF '$TEST
Begin DoDot:1
+58 SET CPTCODE=VACODE
+59 SET CPTNAME=VANAME
+60 SET CPTSCHM=VASCHM
+61 QUIT
End DoDot:1
+62 ;
+63 ; get exam status
+64 SET EXAMSTS=A(123,GMRCIENS,8,"E")
+65 ;
+66 SET TIMESTAMP=A(123.02,"1,"_GMRCIENS,2,"I")
+67 ;
+68 ; stuff the data into the return array
+69 ;
+70 ; OK
SET OUT(1)=1
+71 SET OUT(2)=DFN
+72 SET OUT(3)=SERVICE
+73 SET OUT(4)=PROCEDURE
+74 SET OUT(5)=VACODE
+75 SET OUT(6)=VANAME
+76 SET OUT(7)=VASCHM
+77 SET OUT(8)=CPTCODE
+78 SET OUT(9)=CPTNAME
+79 SET OUT(10)=CPTSCHM
+80 SET OUT(11)=$GET(TIMESTAMP)
+81 SET OUT(12)=EXAMSTS
+82 SET OUT(13)=$$STATNUMB^MAGDFCNV()
+83 SET OUT(14)=$$GMRCACN^MAGDFCNV(GMRCIEN)
+84 SET OUT(15)=GMRCIEN
+85 QUIT
+86 ;
XMITSTAT(OUT,D0) ; RPC = MAG DICOM GET XMIT STATS
+1 ; return statistics array for a DICOM Export
+2 NEW D1,STATUS,X
+3 KILL OUT
+4 IF '$GET(D0)
SET OUT="-1,IEN for DICOM OBJECT EXPORT file (#2006.574) is missing"
QUIT
+5 IF '$DATA(^MAGDOUTP(2006.574,D0))
SET OUT="-2,No entry #"_D0_" in DICOM OBJECT EXPORT file (#2006.574)"
QUIT
+6 ; indicate output
SET OUT=1
+7 SET D1=0
FOR
SET D1=$ORDER(^MAGDOUTP(2006.574,D0,1,D1))
if 'D1
QUIT
Begin DoDot:1
+8 SET X=$GET(^MAGDOUTP(2006.574,D0,1,D1,0))
+9 SET STATUS=$PIECE(X,"^",2)
+10 SET OUT(STATUS)=($PIECE($GET(OUT(STATUS)),"^",1)+1)_"^"_STATUS
+11 QUIT
End DoDot:1
+12 QUIT
