RARIC ;HISC/FPT,GJC AISC/SAW-Radiologic Image Capture and Display Routine ;08/05/08 14:35
;;5.0;Radiology/Nuclear Medicine;**23,27,101,47**;Mar 16, 1998;Build 21
;
;In response to: Remedy #330689 (Tucson); PSPO 1460
;
;Supported IA #2053 FILE/UPDATE^DIE
;Supported IA #2054 LOCK^DILF
;Supported IA #10103 $$NOW^XLFDT
;
CREATE ; >>create new stub entry in file 74<<
; --------------------------------------------------------------------
; IA: 1178 (the value of RARPT is currently null) If no report entry is
; created, RARPT is set to null or negative (negative w/report)
;
;input variables
; RADTE - ext. date/time of exam, RADFN - patient DFN,
; RADTI - int. date/time of exam), RACN - case number &
; RACNI - IEN of case record
; RATIMEOUT - An integer representing the number of seconds
; in which the process attempts to gain access
; to the node in question. RATIMEOUT is set ONLY
; on the Imaging Gateway side. All other applications
; calling the CREATE entry point will not have
; RATIMEOUT set and will use a default timeout
; value set at 1E9.
;
; Note: Imaging (Gateway) sets and kills RATIMEOUT.
;
;output variables
; RARPT - IEN of the report: null if error; or positive
;
; lock the exam node; quit if the lock fails
S RARPT="" S U=$G(U,"^")
L +^RADPT(RADFN,"DT",RADTI,"P",RACNI,0):$G(RATIMEOUT,1E9) E S RARPT="-1^radiology exam locked" Q
;
; Set RAY2 to the REGISTERED EXAMS node.
; Set RAY3 to the EXAMINATIONS node.
N RAY2,RAY3 S RAY2=$G(^RADPT(RADFN,"DT",RADTI,0))
S RAY3=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
;
;
; 1 - If the Imaging value of the case number does not match
; the case number on disk quit. 2 - Quit if the exam was purged.
; =================================================================
I $P(RAY3,U)'=RACN D UNLOCXAM Q ; - 1
I $P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"PURGE")),U)>0 D UNLOCXAM Q ; - 2
;
;
; If a report was created for this case while waiting
; to access the exam node (timeout) set RARPT, unlock
; the exam node & exit (XIT).
; =================================================================
S RARPT=$P(RAY3,U,17)
I RARPT D UNLOCXAM Q
;
;
; Create the accession number. The format may be that
; of the legacy accession or it may be (w/p47) a site
; specific accession (SSAN). Check if patch RA*5.0*47
; has been installed.
;
; Because we entered the Radiology application through
; a foreign source the following package wide Radiology
; variables must be defined: RAMDIV & RAMDV
; =================================================================
N RACESION,RAMDIV,RAMDV
S RAMDIV=+$P(RAY2,U,3),RAMDV=$S($D(^RA(79,RAMDIV,.1)):^(.1),1:"")
I $P(RAY3,U,31)'="" D ; use SSAN
.S RACESION=$P(RAY3,U,31)
.Q
; else use the legacy accession
E S RACESION=$E(RADTE,4,7)_$E(RADTE,2,3)_"-"_RACN
;
;
N RA1,RAERR,RAFDA,RAFDAIEN,RAIEN,RAPRTSET,RAMEMARR,RATXT,RAX,RAXIT,RAY
;
; Check if this case is part of a print set.
; =================================================================
; D EN2^RAUTL20(.RAMEMARR) is a silent call!
; RAMEMARR = # of descendents
; RAMEMARR(n)=case #^procedure IEN^report text IEN^exam status IEN
; (where 'n' is RACNI)
; If printset RAPRTSET=1, else RAPRTSET=0
D EN2^RAUTL20(.RAMEMARR) ; is this case part of a print set ?
;
;
; Find the next available RAD/NUC MED REPORTS IEN, lock that record
; & file the report specific data into that new report record.
; =================================================================
S RAFDAIEN(1)=$$NEWIEN()
;
; ** Note: ^RARPT(RAFDAIEN(1)) is locked; it is up to **
; ** YOU to unlock the record before the process quits **
;
S RAY="+1",RAX="RAFDA(74,"""_RAY_","")"
S @RAX@(.01)=RACESION
S @RAX@(2)=RADFN
S @RAX@(3)=(9999999.9999-RADTI)
S @RAX@(4)=RACN
S @RAX@(6)=DT
;
;The filing of report text is no longer required.
;K RATXT("RPT") S RATXT("RPT",1)="Images collected."
;S @RAX@(200)="RATXT(""RPT"")"
;
; Create the Activity Log (74.01) sub-file record.
S RAX="RAFDA(74.01,""+2,"_RAY_","")"
S @RAX@(.01)=$$NOW^XLFDT()
S @RAX@(2)=$S($D(RAESIG)#2:"V",1:"C")
S @RAX@(3)=$S($G(RAVERF):RAVERF,1:DUZ)
D UPDATE^DIE("","RAFDA","RAFDAIEN","RAERR")
;
;
; If there happened to be an error when calling UPDATE^DIE
; kill off the stub report record.
; =================================================================
I $D(RAERR("DIERR"))#2,($D(^RARPT(RAFDAIEN(1),0))#2) D D XIT Q
.D DELRPT(RAFDAIEN(1)) ;note: RARPT is null
.QUIT
;
;
;
; ** 70.03 - set report text field in the EXAMINATIONS node - 70.03 **
; ** 70.03 - locked at the top of RARIC - 70.03 **
; =================================================================
K RAERR,RAFDA,RAIEN,RATXT
;
S RAIEN=RACNI_","_RADTI_","_RADFN_","
S RAFDA(70.03,RAIEN,17)=RAFDAIEN(1)
D FILE^DIE("","RAFDA","RAERR")
;
; the REPORT TEXT field was not set correctly
I $D(RAERR("DIERR"))#2 D DELRPT(RAFDAIEN(1)) D XIT Q
;
;
;the report record has been created, set RARPT = RAFDAIEN(1)
S RARPT=RAFDAIEN(1)
;
;
; create a var RARIC to suppress display of info msg from PTR^RARTE2
; PTR^RARTE2 requires that RARPT the IEN of an existing report record.
; =================================================================
N RARPTN S RARPTN=$P(^RARPT(RARPT,0),U)
I RAPRTSET N RARIC S RARIC=1 D PTR^RARTE2
; don't have to check raxit, since we're quitting now
;
;
XIT ;exit the CREATE subroutine
; =================================================================
;Unlock the case node & unlock the report.
D UNLOCXAM L -^RARPT(RAFDAIEN(1))
QUIT
;
;
PTR ; associate images with a radiology report record
; --------------------------------------------------------------------
;
; input: RARPT - IEN of Rad/NM Report file #74
; MAGGP - IEN of record in file 2005 pointed to by a report
;
; returns: Y=0 - variable MAGGP does not exist
; Y=-1 - FileMan could not create an entry (may be -1 w/report)
; Y>0 - FileMan created an entry
;
S Y=0 Q:$G(MAGGP)'>0
L +^RARPT(RARPT):$G(DILOCKTM,5)
I '$T S Y="-1^radiology report locked" Q ;lock failed...
N RAFDA,RAIEN,RARSLT
S RAFDA(74.02005,"+1,"_RARPT_",",.01)=MAGGP
D UPDATE^DIE(,"RAFDA","RAIEN","RARSLT")
I $D(RARSLT("DIERR"))#2 D
.S Y=-1 ;RAIEN(1) undef
.QUIT
E I RAIEN(1)>0 S Y=RAIEN(1)
L -^RARPT(RARPT)
QUIT
;
;
DELRPT(Y) ; delete a report (RARIC). The report record should
;be locked by the software calling this function.
; --------------------------------------------------------------------
; Input: Y = the IEN of the report record
;
K RAERR,RAFDA S RAFDA(74,Y_",",.01)="@"
D FILE^DIE("","RAFDA","RAERR") K RAERR,RAFDA
Q
;
;
NEWIEN() ; ##### ALLOCATES A NEW RECORD IN THE RAD/NUC MED REPORTS FILE
; (#74) AND LOCKS IT
; --------------------------------------------------------------------
; Return Values
; =============
; >0 IEN for the new record in the RAD/NUC MED REPORTS FILE (#74)
;
; Notes
; =====
;
; The placeholder for the new record (^RARPT(IEN) node) is LOCKed
; by this function. It is responsibility of the caller to unlock the
; record after it is created or the record creation is canceled.
;
N IEN,NEWIEN,NODE
S NEWIEN=0
;---
F D Q:NEWIEN
. S IEN=$O(^RARPT(" "),-1)+1
. ;--- If the record already exists, skip it
. S NODE=$NA(^RARPT(IEN)) Q:$D(@NODE)
. ;--- Lock the placeholder in order to make sure that nobody
. ;--- else is trying to allocate it at the same time.
. D LOCK^DILF(NODE) E Q
. ;--- Double check that the record has not been created after the
. ;--- previous $D() check and the LOCK command (a race condition)
. I $D(@NODE) L -@NODE Q
. ;--- Success
. S NEWIEN=IEN
. Q
;---
Q NEWIEN
;
;
UNLOCXAM ;Unlock the EXAMINATION node locked by this process.
; --------------------------------------------------------------------
L -^RADPT(RADFN,"DT",RADTI,"P",RACNI,0) QUIT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRARIC 8126 printed Apr 09, 2024@21:42:15 Page 2
RARIC ;HISC/FPT,GJC AISC/SAW-Radiologic Image Capture and Display Routine ;08/05/08 14:35
+1 ;;5.0;Radiology/Nuclear Medicine;**23,27,101,47**;Mar 16, 1998;Build 21
+2 ;
+3 ;In response to: Remedy #330689 (Tucson); PSPO 1460
+4 ;
+5 ;Supported IA #2053 FILE/UPDATE^DIE
+6 ;Supported IA #2054 LOCK^DILF
+7 ;Supported IA #10103 $$NOW^XLFDT
+8 ;
CREATE ; >>create new stub entry in file 74<<
+1 ; --------------------------------------------------------------------
+2 ; IA: 1178 (the value of RARPT is currently null) If no report entry is
+3 ; created, RARPT is set to null or negative (negative w/report)
+4 ;
+5 ;input variables
+6 ; RADTE - ext. date/time of exam, RADFN - patient DFN,
+7 ; RADTI - int. date/time of exam), RACN - case number &
+8 ; RACNI - IEN of case record
+9 ; RATIMEOUT - An integer representing the number of seconds
+10 ; in which the process attempts to gain access
+11 ; to the node in question. RATIMEOUT is set ONLY
+12 ; on the Imaging Gateway side. All other applications
+13 ; calling the CREATE entry point will not have
+14 ; RATIMEOUT set and will use a default timeout
+15 ; value set at 1E9.
+16 ;
+17 ; Note: Imaging (Gateway) sets and kills RATIMEOUT.
+18 ;
+19 ;output variables
+20 ; RARPT - IEN of the report: null if error; or positive
+21 ;
+22 ; lock the exam node; quit if the lock fails
+23 SET RARPT=""
SET U=$GET(U,"^")
+24 LOCK +^RADPT(RADFN,"DT",RADTI,"P",RACNI,0):$GET(RATIMEOUT,1E9)
IF '$TEST
SET RARPT="-1^radiology exam locked"
QUIT
+25 ;
+26 ; Set RAY2 to the REGISTERED EXAMS node.
+27 ; Set RAY3 to the EXAMINATIONS node.
+28 NEW RAY2,RAY3
SET RAY2=$GET(^RADPT(RADFN,"DT",RADTI,0))
+29 SET RAY3=$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
+30 ;
+31 ;
+32 ; 1 - If the Imaging value of the case number does not match
+33 ; the case number on disk quit. 2 - Quit if the exam was purged.
+34 ; =================================================================
+35 ; - 1
IF $PIECE(RAY3,U)'=RACN
DO UNLOCXAM
QUIT
+36 ; - 2
IF $PIECE($GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"PURGE")),U)>0
DO UNLOCXAM
QUIT
+37 ;
+38 ;
+39 ; If a report was created for this case while waiting
+40 ; to access the exam node (timeout) set RARPT, unlock
+41 ; the exam node & exit (XIT).
+42 ; =================================================================
+43 SET RARPT=$PIECE(RAY3,U,17)
+44 IF RARPT
DO UNLOCXAM
QUIT
+45 ;
+46 ;
+47 ; Create the accession number. The format may be that
+48 ; of the legacy accession or it may be (w/p47) a site
+49 ; specific accession (SSAN). Check if patch RA*5.0*47
+50 ; has been installed.
+51 ;
+52 ; Because we entered the Radiology application through
+53 ; a foreign source the following package wide Radiology
+54 ; variables must be defined: RAMDIV & RAMDV
+55 ; =================================================================
+56 NEW RACESION,RAMDIV,RAMDV
+57 SET RAMDIV=+$PIECE(RAY2,U,3)
SET RAMDV=$SELECT($DATA(^RA(79,RAMDIV,.1)):^(.1),1:"")
+58 ; use SSAN
IF $PIECE(RAY3,U,31)'=""
Begin DoDot:1
+59 SET RACESION=$PIECE(RAY3,U,31)
+60 QUIT
End DoDot:1
+61 ; else use the legacy accession
+62 IF '$TEST
SET RACESION=$EXTRACT(RADTE,4,7)_$EXTRACT(RADTE,2,3)_"-"_RACN
+63 ;
+64 ;
+65 NEW RA1,RAERR,RAFDA,RAFDAIEN,RAIEN,RAPRTSET,RAMEMARR,RATXT,RAX,RAXIT,RAY
+66 ;
+67 ; Check if this case is part of a print set.
+68 ; =================================================================
+69 ; D EN2^RAUTL20(.RAMEMARR) is a silent call!
+70 ; RAMEMARR = # of descendents
+71 ; RAMEMARR(n)=case #^procedure IEN^report text IEN^exam status IEN
+72 ; (where 'n' is RACNI)
+73 ; If printset RAPRTSET=1, else RAPRTSET=0
+74 ; is this case part of a print set ?
DO EN2^RAUTL20(.RAMEMARR)
+75 ;
+76 ;
+77 ; Find the next available RAD/NUC MED REPORTS IEN, lock that record
+78 ; & file the report specific data into that new report record.
+79 ; =================================================================
+80 SET RAFDAIEN(1)=$$NEWIEN()
+81 ;
+82 ; ** Note: ^RARPT(RAFDAIEN(1)) is locked; it is up to **
+83 ; ** YOU to unlock the record before the process quits **
+84 ;
+85 SET RAY="+1"
SET RAX="RAFDA(74,"""_RAY_","")"
+86 SET @RAX@(.01)=RACESION
+87 SET @RAX@(2)=RADFN
+88 SET @RAX@(3)=(9999999.9999-RADTI)
+89 SET @RAX@(4)=RACN
+90 SET @RAX@(6)=DT
+91 ;
+92 ;The filing of report text is no longer required.
+93 ;K RATXT("RPT") S RATXT("RPT",1)="Images collected."
+94 ;S @RAX@(200)="RATXT(""RPT"")"
+95 ;
+96 ; Create the Activity Log (74.01) sub-file record.
+97 SET RAX="RAFDA(74.01,""+2,"_RAY_","")"
+98 SET @RAX@(.01)=$$NOW^XLFDT()
+99 SET @RAX@(2)=$SELECT($DATA(RAESIG)#2:"V",1:"C")
+100 SET @RAX@(3)=$SELECT($GET(RAVERF):RAVERF,1:DUZ)
+101 DO UPDATE^DIE("","RAFDA","RAFDAIEN","RAERR")
+102 ;
+103 ;
+104 ; If there happened to be an error when calling UPDATE^DIE
+105 ; kill off the stub report record.
+106 ; =================================================================
+107 IF $DATA(RAERR("DIERR"))#2
IF ($DATA(^RARPT(RAFDAIEN(1),0))#2)
Begin DoDot:1
+108 ;note: RARPT is null
DO DELRPT(RAFDAIEN(1))
+109 QUIT
End DoDot:1
DO XIT
QUIT
+110 ;
+111 ;
+112 ;
+113 ; ** 70.03 - set report text field in the EXAMINATIONS node - 70.03 **
+114 ; ** 70.03 - locked at the top of RARIC - 70.03 **
+115 ; =================================================================
+116 KILL RAERR,RAFDA,RAIEN,RATXT
+117 ;
+118 SET RAIEN=RACNI_","_RADTI_","_RADFN_","
+119 SET RAFDA(70.03,RAIEN,17)=RAFDAIEN(1)
+120 DO FILE^DIE("","RAFDA","RAERR")
+121 ;
+122 ; the REPORT TEXT field was not set correctly
+123 IF $DATA(RAERR("DIERR"))#2
DO DELRPT(RAFDAIEN(1))
DO XIT
QUIT
+124 ;
+125 ;
+126 ;the report record has been created, set RARPT = RAFDAIEN(1)
+127 SET RARPT=RAFDAIEN(1)
+128 ;
+129 ;
+130 ; create a var RARIC to suppress display of info msg from PTR^RARTE2
+131 ; PTR^RARTE2 requires that RARPT the IEN of an existing report record.
+132 ; =================================================================
+133 NEW RARPTN
SET RARPTN=$PIECE(^RARPT(RARPT,0),U)
+134 IF RAPRTSET
NEW RARIC
SET RARIC=1
DO PTR^RARTE2
+135 ; don't have to check raxit, since we're quitting now
+136 ;
+137 ;
XIT ;exit the CREATE subroutine
+1 ; =================================================================
+2 ;Unlock the case node & unlock the report.
+3 DO UNLOCXAM
LOCK -^RARPT(RAFDAIEN(1))
+4 QUIT
+5 ;
+6 ;
PTR ; associate images with a radiology report record
+1 ; --------------------------------------------------------------------
+2 ;
+3 ; input: RARPT - IEN of Rad/NM Report file #74
+4 ; MAGGP - IEN of record in file 2005 pointed to by a report
+5 ;
+6 ; returns: Y=0 - variable MAGGP does not exist
+7 ; Y=-1 - FileMan could not create an entry (may be -1 w/report)
+8 ; Y>0 - FileMan created an entry
+9 ;
+10 SET Y=0
if $GET(MAGGP)'>0
QUIT
+11 LOCK +^RARPT(RARPT):$GET(DILOCKTM,5)
+12 ;lock failed...
IF '$TEST
SET Y="-1^radiology report locked"
QUIT
+13 NEW RAFDA,RAIEN,RARSLT
+14 SET RAFDA(74.02005,"+1,"_RARPT_",",.01)=MAGGP
+15 DO UPDATE^DIE(,"RAFDA","RAIEN","RARSLT")
+16 IF $DATA(RARSLT("DIERR"))#2
Begin DoDot:1
+17 ;RAIEN(1) undef
SET Y=-1
+18 QUIT
End DoDot:1
+19 IF '$TEST
IF RAIEN(1)>0
SET Y=RAIEN(1)
+20 LOCK -^RARPT(RARPT)
+21 QUIT
+22 ;
+23 ;
DELRPT(Y) ; delete a report (RARIC). The report record should
+1 ;be locked by the software calling this function.
+2 ; --------------------------------------------------------------------
+3 ; Input: Y = the IEN of the report record
+4 ;
+5 KILL RAERR,RAFDA
SET RAFDA(74,Y_",",.01)="@"
+6 DO FILE^DIE("","RAFDA","RAERR")
KILL RAERR,RAFDA
+7 QUIT
+8 ;
+9 ;
NEWIEN() ; ##### ALLOCATES A NEW RECORD IN THE RAD/NUC MED REPORTS FILE
+1 ; (#74) AND LOCKS IT
+2 ; --------------------------------------------------------------------
+3 ; Return Values
+4 ; =============
+5 ; >0 IEN for the new record in the RAD/NUC MED REPORTS FILE (#74)
+6 ;
+7 ; Notes
+8 ; =====
+9 ;
+10 ; The placeholder for the new record (^RARPT(IEN) node) is LOCKed
+11 ; by this function. It is responsibility of the caller to unlock the
+12 ; record after it is created or the record creation is canceled.
+13 ;
+14 NEW IEN,NEWIEN,NODE
+15 SET NEWIEN=0
+16 ;---
+17 FOR
Begin DoDot:1
+18 SET IEN=$ORDER(^RARPT(" "),-1)+1
+19 ;--- If the record already exists, skip it
+20 SET NODE=$NAME(^RARPT(IEN))
if $DATA(@NODE)
QUIT
+21 ;--- Lock the placeholder in order to make sure that nobody
+22 ;--- else is trying to allocate it at the same time.
+23 DO LOCK^DILF(NODE)
IF '$TEST
QUIT
+24 ;--- Double check that the record has not been created after the
+25 ;--- previous $D() check and the LOCK command (a race condition)
+26 IF $DATA(@NODE)
LOCK -@NODE
QUIT
+27 ;--- Success
+28 SET NEWIEN=IEN
+29 QUIT
End DoDot:1
if NEWIEN
QUIT
+30 ;---
+31 QUIT NEWIEN
+32 ;
+33 ;
UNLOCXAM ;Unlock the EXAMINATION node locked by this process.
+1 ; --------------------------------------------------------------------
+2 LOCK -^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)
QUIT
+3 ;
