RAAPI ;HISC/GJC,RTK - API & function utilities ; 01 Jun 2012 10:56 AM
;;5.0;Radiology/Nuclear Medicine;**47,1004**;Mar 16, 1998;Build 21
;
;Integration Agreements
;----------------------
;$$NS^XUAF4(2171); $$KSP^XUPARAM(2541)
;
ACCNUM(RADFN,RADTI,RACNI) ; return the site specific accession number
;internal use for the VistA Radiology application
;
;input : RADFN=the DFN of the patient record in the PATIENT (#2) file
; RADTI=inverse date/time of the exam
; RACNI=the IEN of the case level record
;return: sss-mmddyy-case# (site specific accession number)
;
I RADFN=""!(RADTI="")!(RACNI="") Q "" ;all MUST be defined
N RAC,RAD,RAE S RAE=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) ;exam node
S RAC=9999999.9999-RADTI ;RAC=FM internal date/time
S RAD=$E(RAC,4,7)_$E(RAC,2,3)_"-"_+RAE ;mmddyy-case#
Q $P($$SITE^VASITE(),"^",3)_"-"_RAD ;SAF - get full station number for IHS instead of truncating at 3 characters
;Q $E($P($$NS^XUAF4($$KSP^XUPARAM("INST")),U,2),1,3)_"-"_RAD
;
ACCFIND(Y,RAA) ;
;
;input : Y=the accession number in either a 'sss-mmddyy-xxxxx' or
; 'mmddyy-xxxxx' format
; : RAA(n)=the array used to return the data in the following
; format RADFN_^_RADTI_^_RACNI
;
;return: n>0 successful, else n<0... 'n' is the number of array
; elements when successful. When unsuccessful (n<0) 'n' is
; a specific error dialog which is returned along with the
; invalid accession number.
;
; Examples:
; -1^"invalid site accession number format"^accession #
; -2^"invalid accession number format"^accession #
; -3^"no data associated with this accession number"^accession #
;
I $L(Y,"-")=3 Q:Y'?3N1"-"6N1"-"1.5N "-1^invalid site accession number format^"_Y
I $L(Y,"-")=2 Q:Y'?6N1"-"1.5N "-2^invalid accession number format^"_Y
N X S X=$S($L(Y,"-")=3:$NA(^RADPT("ADC1")),1:$NA(^RADPT("ADC")))
Q:$O(@X@(Y,0))'>0 "-3^no data associated with this accession number^"_Y
N RADFN,RADTI,RACNI,Z S:$D(U)#2=0 U="^"
S (RADFN,Z)=0 F S RADFN=$O(@X@(Y,RADFN)) Q:'RADFN D
.S RADTI=0 F S RADTI=$O(@X@(Y,RADFN,RADTI)) Q:'RADTI D
..S RACNI=0 F S RACNI=$O(@X@(Y,RADFN,RADTI,RACNI)) Q:'RACNI D
...S Z=Z+1,RAA(Z)=RADFN_U_RADTI_U_RACNI
...Q
..Q
.Q
Q Z ;success
;
ACCRPT(Y,RAA) ;return accession number(s) given file #74 pointer value - RTK
;
;input : Y=pointer to a record in file #74
; : RAA(n)=the array used to return the data.
;
;return: n>0 successful, n<0 unsuccessful
;
; When successful, 'n' is the number of array elements.
; If n=1 the single accession number is returned in RAA(1)
; If n>1, the "lead" accession number (for printsets) is
; returned in RAA(1) and subsequent ones are returned in
; RAA(2) thru RAA(n)
; Accession numbers are returned in either "mmddyy-case#" or
; "sss-mmddyy-case#" format
; When unsuccessful, n<0, an error message is
; returned along with the invalid file #74 pointer value.
;
K RAA N RADCN,RAOTHCS,RARPTIEN,Z S RARPTIEN=Y
I '$D(^RARPT(Y,0)) Q "-1^invalid file #74 pointer value^"_Y
S RADCN=$P($G(^RARPT(RARPTIEN,0)),U,1) ;day-case #
S Z=1,RAA(Z)=RADCN
F RAOTHCS=0:0 S RAOTHCS=$O(^RARPT(RARPTIEN,1,RAOTHCS)) Q:RAOTHCS'>0 D
.S Z=Z+1,RAA(Z)=$P($G(^RARPT(RARPTIEN,1,RAOTHCS,0)),U,1)
Q Z
;
SIUID() ; called from [RA REGISTER] template, creates the STUDY INSTANCE UID
; also called directly from RAMAG03C for exams created thru the importer
;
; IHS/CMI/DAY - Patch 1004 - Fix Study ID at non-Vista Imaging sites
; This patch is needed at sites that do not run Vista Imaging
; and do not have the MAGDRAHL routine installed. The original
; calls to MAGDRAHL have been replaced with BRADRAHL.
;
;This patch was modified by Stuart Frank, May 2012
;
;Check to see if Vista Imaging and MAG patch 49 are installed
;N MAGDRAHL ;saf - not needed
;S MAGDRAHL=0 ;saf - not needed
;S X="MAGDRAHL" X ^%ZOSF("TEST") I $T S MADGRAHL=1 ;saf - not needed
N MAGCHECK
S MAGCHECK=0
;I $G(^MAGD(2006.15,1,"UID ROOT"))]"",MAGDRAHL=1 S MAGCHECK=1 ;saf - replaced with line below
I $G(^MAGD(2006.15,1,"UID ROOT"))]"",$T(^MAGDRAHL)'="" S MAGCHECK=1
;
;If not installed, call BRADRAHL instead
N RASIUID
I MAGCHECK=0 D Q RASIUID
.; RADFN, RADTI and RACNI are set in RA REGISTER template/RAMAG03C
.N RASSAN
.S RASIUID=""
.; if SSAN exists use it to build RASIUID
.S RASSAN=$$SSANVAL^RAHLRU1(RADFN,RADTI,RACNI)
.I RASSAN'="" S RASIUID=$$STUDYUID^BRADRAHL(RADTI,RACNI,RASSAN) Q
.; else if RASSAN="" do the lines below to use the legacy acc #
.N RAC,RAD,RAE
.S RAE=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) ;exam node
.S RAC=9999999.9999-RADTI ;RAC=FM internal date/time
.S RAD=$E(RAC,4,7)_$E(RAC,2,3)_"-"_+RAE ;mmddyy-case#
.S RASIUID=$$STUDYUID^BRADRAHL(RADTI,RACNI,RAD)
;
;End patch 1004
;
; RADFN, RADTI and RACNI are set in RA REGISTER template/RAMAG03C
N RASSAN,RASIUID S RASIUID=""
; if SSAN exists use it to build RASIUID
S RASSAN=$$SSANVAL^RAHLRU1(RADFN,RADTI,RACNI)
I RASSAN'="" S RASIUID=$$STUDYUID^MAGDRAHL(RADTI,RACNI,RASSAN) Q RASIUID
; else if RASSAN="" do the lines below to use the legacy acc #
N RAC,RAD,RAE S RAE=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) ;exam node
S RAC=9999999.9999-RADTI ;RAC=FM internal date/time
S RAD=$E(RAC,4,7)_$E(RAC,2,3)_"-"_+RAE ;mmddyy-case#
S RASIUID=$$STUDYUID^MAGDRAHL(RADTI,RACNI,RAD)
Q RASIUID
;
GETSIUID(RADFN,RADTI,RACNI) ; return the value of the exam's SIUID
Q $G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SIUID"))
;
SIUIDFND(Y,RAA) ; return exam data for a given study instance UID
;input : Y=the study instance UID
; : RAA(1)=variable to hold the data in the following format:
; RADFN_^_RADTI_^_RACNI
;
;return: n=1 if successful, else n<-1 with error message
; When successful, n=1 and RAA(1) is returned in above format
; When unsuccessful 'n' is a specific error dialog
; which is returned along with the invalid study instance UID:
; -1^"no data associated with this study instance UID"^siuid
;
K RAA N RADFN,RADTI,RACNI S RASIUID=Y,Z=0
S RADFN=0 F S RADFN=$O(^RADPT("ASIUID",RASIUID,RADFN)) Q:'RADFN D
.S RADTI=0 F S RADTI=$O(^RADPT("ASIUID",RASIUID,RADFN,RADTI)) Q:'RADTI D
..S RACNI=0 F S RACNI=$O(^RADPT("ASIUID",RASIUID,RADFN,RADTI,RACNI)) Q:'RACNI D
...S Z=Z+1,RAA(Z)=RADFN_"^"_RADTI_"^"_RACNI
I Z=0 Q "-1^no data associated with this study instance UID^"_RASIUID
Q Z
RAAPI ;HISC/GJC,RTK - API & function utilities ; 01 Jun 2012 10:56 AM
+1 ;;5.0;Radiology/Nuclear Medicine;**47,1004**;Mar 16, 1998;Build 21
+2 ;
+3 ;Integration Agreements
+4 ;----------------------
+5 ;$$NS^XUAF4(2171); $$KSP^XUPARAM(2541)
+6 ;
ACCNUM(RADFN,RADTI,RACNI) ; return the site specific accession number
+1 ;internal use for the VistA Radiology application
+2 ;
+3 ;input : RADFN=the DFN of the patient record in the PATIENT (#2) file
+4 ; RADTI=inverse date/time of the exam
+5 ; RACNI=the IEN of the case level record
+6 ;return: sss-mmddyy-case# (site specific accession number)
+7 ;
+8 ;all MUST be defined
IF RADFN=""!(RADTI="")!(RACNI="")
QUIT ""
+9 ;exam node
NEW RAC,RAD,RAE
SET RAE=$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
+10 ;RAC=FM internal date/time
SET RAC=9999999.9999-RADTI
+11 ;mmddyy-case#
SET RAD=$EXTRACT(RAC,4,7)_$EXTRACT(RAC,2,3)_"-"_+RAE
+12 ;SAF - get full station number for IHS instead of truncating at 3 characters
QUIT $PIECE($$SITE^VASITE(),"^",3)_"-"_RAD
+13 ;Q $E($P($$NS^XUAF4($$KSP^XUPARAM("INST")),U,2),1,3)_"-"_RAD
+14 ;
ACCFIND(Y,RAA) ;
+1 ;
+2 ;input : Y=the accession number in either a 'sss-mmddyy-xxxxx' or
+3 ; 'mmddyy-xxxxx' format
+4 ; : RAA(n)=the array used to return the data in the following
+5 ; format RADFN_^_RADTI_^_RACNI
+6 ;
+7 ;return: n>0 successful, else n<0... 'n' is the number of array
+8 ; elements when successful. When unsuccessful (n<0) 'n' is
+9 ; a specific error dialog which is returned along with the
+10 ; invalid accession number.
+11 ;
+12 ; Examples:
+13 ; -1^"invalid site accession number format"^accession #
+14 ; -2^"invalid accession number format"^accession #
+15 ; -3^"no data associated with this accession number"^accession #
+16 ;
+17 IF $LENGTH(Y,"-")=3
IF Y'?3N1"-"6N1"-"1.5N
QUIT "-1^invalid site accession number format^"_Y
+18 IF $LENGTH(Y,"-")=2
IF Y'?6N1"-"1.5N
QUIT "-2^invalid accession number format^"_Y
+19 NEW X
SET X=$SELECT($LENGTH(Y,"-")=3:$NAME(^RADPT("ADC1")),1:$NAME(^RADPT("ADC")))
+20 IF $ORDER(@X@(Y,0))'>0
QUIT "-3^no data associated with this accession number^"_Y
+21 NEW RADFN,RADTI,RACNI,Z
IF $DATA(U)#2=0
SET U="^"
+22 SET (RADFN,Z)=0
FOR
SET RADFN=$ORDER(@X@(Y,RADFN))
IF 'RADFN
QUIT
Begin DoDot:1
+23 SET RADTI=0
FOR
SET RADTI=$ORDER(@X@(Y,RADFN,RADTI))
IF 'RADTI
QUIT
Begin DoDot:2
+24 SET RACNI=0
FOR
SET RACNI=$ORDER(@X@(Y,RADFN,RADTI,RACNI))
IF 'RACNI
QUIT
Begin DoDot:3
+25 SET Z=Z+1
SET RAA(Z)=RADFN_U_RADTI_U_RACNI
+26 QUIT
End DoDot:3
+27 QUIT
End DoDot:2
+28 QUIT
End DoDot:1
+29 ;success
QUIT Z
+30 ;
ACCRPT(Y,RAA) ;return accession number(s) given file #74 pointer value - RTK
+1 ;
+2 ;input : Y=pointer to a record in file #74
+3 ; : RAA(n)=the array used to return the data.
+4 ;
+5 ;return: n>0 successful, n<0 unsuccessful
+6 ;
+7 ; When successful, 'n' is the number of array elements.
+8 ; If n=1 the single accession number is returned in RAA(1)
+9 ; If n>1, the "lead" accession number (for printsets) is
+10 ; returned in RAA(1) and subsequent ones are returned in
+11 ; RAA(2) thru RAA(n)
+12 ; Accession numbers are returned in either "mmddyy-case#" or
+13 ; "sss-mmddyy-case#" format
+14 ; When unsuccessful, n<0, an error message is
+15 ; returned along with the invalid file #74 pointer value.
+16 ;
+17 KILL RAA
NEW RADCN,RAOTHCS,RARPTIEN,Z
SET RARPTIEN=Y
+18 IF '$DATA(^RARPT(Y,0))
QUIT "-1^invalid file #74 pointer value^"_Y
+19 ;day-case #
SET RADCN=$PIECE($GET(^RARPT(RARPTIEN,0)),U,1)
+20 SET Z=1
SET RAA(Z)=RADCN
+21 FOR RAOTHCS=0:0
SET RAOTHCS=$ORDER(^RARPT(RARPTIEN,1,RAOTHCS))
IF RAOTHCS'>0
QUIT
Begin DoDot:1
+22 SET Z=Z+1
SET RAA(Z)=$PIECE($GET(^RARPT(RARPTIEN,1,RAOTHCS,0)),U,1)
End DoDot:1
+23 QUIT Z
+24 ;
SIUID() ; called from [RA REGISTER] template, creates the STUDY INSTANCE UID
+1 ; also called directly from RAMAG03C for exams created thru the importer
+2 ;
+3 ; IHS/CMI/DAY - Patch 1004 - Fix Study ID at non-Vista Imaging sites
+4 ; This patch is needed at sites that do not run Vista Imaging
+5 ; and do not have the MAGDRAHL routine installed. The original
+6 ; calls to MAGDRAHL have been replaced with BRADRAHL.
+7 ;
+8 ;This patch was modified by Stuart Frank, May 2012
+9 ;
+10 ;Check to see if Vista Imaging and MAG patch 49 are installed
+11 ;N MAGDRAHL ;saf - not needed
+12 ;S MAGDRAHL=0 ;saf - not needed
+13 ;S X="MAGDRAHL" X ^%ZOSF("TEST") I $T S MADGRAHL=1 ;saf - not needed
+14 NEW MAGCHECK
+15 SET MAGCHECK=0
+16 ;I $G(^MAGD(2006.15,1,"UID ROOT"))]"",MAGDRAHL=1 S MAGCHECK=1 ;saf - replaced with line below
+17 IF $GET(^MAGD(2006.15,1,"UID ROOT"))]""
IF $TEXT(^MAGDRAHL)'=""
SET MAGCHECK=1
+18 ;
+19 ;If not installed, call BRADRAHL instead
+20 NEW RASIUID
+21 IF MAGCHECK=0
Begin DoDot:1
+22 ; RADFN, RADTI and RACNI are set in RA REGISTER template/RAMAG03C
+23 NEW RASSAN
+24 SET RASIUID=""
+25 ; if SSAN exists use it to build RASIUID
+26 SET RASSAN=$$SSANVAL^RAHLRU1(RADFN,RADTI,RACNI)
+27 IF RASSAN'=""
SET RASIUID=$$STUDYUID^BRADRAHL(RADTI,RACNI,RASSAN)
QUIT
+28 ; else if RASSAN="" do the lines below to use the legacy acc #
+29 NEW RAC,RAD,RAE
+30 ;exam node
SET RAE=$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
+31 ;RAC=FM internal date/time
SET RAC=9999999.9999-RADTI
+32 ;mmddyy-case#
SET RAD=$EXTRACT(RAC,4,7)_$EXTRACT(RAC,2,3)_"-"_+RAE
+33 SET RASIUID=$$STUDYUID^BRADRAHL(RADTI,RACNI,RAD)
End DoDot:1
QUIT RASIUID
+34 ;
+35 ;End patch 1004
+36 ;
+37 ; RADFN, RADTI and RACNI are set in RA REGISTER template/RAMAG03C
+38 NEW RASSAN,RASIUID
SET RASIUID=""
+39 ; if SSAN exists use it to build RASIUID
+40 SET RASSAN=$$SSANVAL^RAHLRU1(RADFN,RADTI,RACNI)
+41 IF RASSAN'=""
SET RASIUID=$$STUDYUID^MAGDRAHL(RADTI,RACNI,RASSAN)
QUIT RASIUID
+42 ; else if RASSAN="" do the lines below to use the legacy acc #
+43 ;exam node
NEW RAC,RAD,RAE
SET RAE=$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
+44 ;RAC=FM internal date/time
SET RAC=9999999.9999-RADTI
+45 ;mmddyy-case#
SET RAD=$EXTRACT(RAC,4,7)_$EXTRACT(RAC,2,3)_"-"_+RAE
+46 SET RASIUID=$$STUDYUID^MAGDRAHL(RADTI,RACNI,RAD)
+47 QUIT RASIUID
+48 ;
GETSIUID(RADFN,RADTI,RACNI) ; return the value of the exam's SIUID
+1 QUIT $GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SIUID"))
+2 ;
SIUIDFND(Y,RAA) ; return exam data for a given study instance UID
+1 ;input : Y=the study instance UID
+2 ; : RAA(1)=variable to hold the data in the following format:
+3 ; RADFN_^_RADTI_^_RACNI
+4 ;
+5 ;return: n=1 if successful, else n<-1 with error message
+6 ; When successful, n=1 and RAA(1) is returned in above format
+7 ; When unsuccessful 'n' is a specific error dialog
+8 ; which is returned along with the invalid study instance UID:
+9 ; -1^"no data associated with this study instance UID"^siuid
+10 ;
+11 KILL RAA
NEW RADFN,RADTI,RACNI
SET RASIUID=Y
SET Z=0
+12 SET RADFN=0
FOR
SET RADFN=$ORDER(^RADPT("ASIUID",RASIUID,RADFN))
IF 'RADFN
QUIT
Begin DoDot:1
+13 SET RADTI=0
FOR
SET RADTI=$ORDER(^RADPT("ASIUID",RASIUID,RADFN,RADTI))
IF 'RADTI
QUIT
Begin DoDot:2
+14 SET RACNI=0
FOR
SET RACNI=$ORDER(^RADPT("ASIUID",RASIUID,RADFN,RADTI,RACNI))
IF 'RACNI
QUIT
Begin DoDot:3
+15 SET Z=Z+1
SET RAA(Z)=RADFN_"^"_RADTI_"^"_RACNI
End DoDot:3
End DoDot:2
End DoDot:1
+16 IF Z=0
QUIT "-1^no data associated with this study instance UID^"_RASIUID
+17 QUIT Z
