- RAHLTCPU ; HIRMFO/GJC,SG - Rad/Nuc Med HL7 TCP/IP Bridge utilities;10/10/07
- ;;5.0;Radiology/Nuclear Medicine;**84,94**;Mar 16, 1998;Build 9
- ;
- LOCKX(RAERR,UNLOCK) ;lock/unlock the Rad/Nuc Med Patient record at one of two levels:
- ;If part of a printset (RAY3(25)=2) lock at the "DT" level
- ;Else lock at the "P" or case level
- ;Input: RADFN, RADTI, & RACNI are all assumed to be defined.
- ; UNLOCK: if defined the function unlocks the encounter at the appropriate level
- ;Returns: RAERR (lock attempt only) if $D(RAERR)#2 lock failed, else lock successful
- N RANODE,RAY3 S RAY3=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),RAY3(25)=$P(RAY3,U,25)
- S RANODE=$S(RAY3(25)=2:$NA(^RADPT(RADFN,"DT",RADTI)),1:$NA(^RADPT(RADFN,"DT",RADTI,"P",RACNI)))
- I $G(UNLOCK)=1 L -@RANODE Q
- L +@RANODE:DILOCKTM E S RAERR=$S(RAY3(25)=2:"Encounter",1:"Accession")_" locked within VistA"
- Q
- ;
- LOCKR(RAERR) ;lock/unlock the report associated with an exam record/
- ;Input: RARPT is assumed to be defined
- ;Return: RAERR will be set if the lock attempt failed, else RAERR will not be defined
- I $D(RARPT)#2,($D(^RARPT(RARPT,0))#2) D
- .D LOCK^DILF($NA(^RARPT(RARPT))) ;$T=1 if lock attained, else 0
- .S:'$T RAERR="Report: "_$P($G(^RARPT(RARPT,0)),U)_" locked within VistA Radiology" Q
- E S RAERR="The report record '"_$G(RARPT,"<UNDEFINED> RARPT")_"' is non-existent."
- Q
- ;
- ;
- ;##### 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.
- ;
- NEWIEN() ;
- 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
- RAHLTCPU ; HIRMFO/GJC,SG - Rad/Nuc Med HL7 TCP/IP Bridge utilities;10/10/07
- +1 ;;5.0;Radiology/Nuclear Medicine;**84,94**;Mar 16, 1998;Build 9
- +2 ;
- LOCKX(RAERR,UNLOCK) ;lock/unlock the Rad/Nuc Med Patient record at one of two levels:
- +1 ;If part of a printset (RAY3(25)=2) lock at the "DT" level
- +2 ;Else lock at the "P" or case level
- +3 ;Input: RADFN, RADTI, & RACNI are all assumed to be defined.
- +4 ; UNLOCK: if defined the function unlocks the encounter at the appropriate level
- +5 ;Returns: RAERR (lock attempt only) if $D(RAERR)#2 lock failed, else lock successful
- +6 NEW RANODE,RAY3
- SET RAY3=$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
- SET RAY3(25)=$PIECE(RAY3,U,25)
- +7 SET RANODE=$SELECT(RAY3(25)=2:$NAME(^RADPT(RADFN,"DT",RADTI)),1:$NAME(^RADPT(RADFN,"DT",RADTI,"P",RACNI)))
- +8 IF $GET(UNLOCK)=1
- LOCK -@RANODE
- QUIT
- +9 LOCK +@RANODE:DILOCKTM
- IF '$TEST
- SET RAERR=$SELECT(RAY3(25)=2:"Encounter",1:"Accession")_" locked within VistA"
- +10 QUIT
- +11 ;
- LOCKR(RAERR) ;lock/unlock the report associated with an exam record/
- +1 ;Input: RARPT is assumed to be defined
- +2 ;Return: RAERR will be set if the lock attempt failed, else RAERR will not be defined
- +3 IF $DATA(RARPT)#2
- IF ($DATA(^RARPT(RARPT,0))#2)
- Begin DoDot:1
- +4 ;$T=1 if lock attained, else 0
- DO LOCK^DILF($NAME(^RARPT(RARPT)))
- +5 IF '$TEST
- SET RAERR="Report: "_$PIECE($GET(^RARPT(RARPT,0)),U)_" locked within VistA Radiology"
- QUIT
- End DoDot:1
- +6 IF '$TEST
- SET RAERR="The report record '"_$GET(RARPT,"<UNDEFINED> RARPT")_"' is non-existent."
- +7 QUIT
- +8 ;
- +9 ;
- +10 ;##### ALLOCATES A NEW RECORD IN THE RAD/NUC MED REPORTS FILE (#74) AND LOCKS IT
- +11 ;
- +12 ; Return Values
- +13 ; =============
- +14 ; >0 IEN for the new record in the RAD/NUC MED REPORTS FILE (#74)
- +15 ;
- +16 ; Notes
- +17 ; =====
- +18 ;
- +19 ; The placeholder for the new record (^RARPT(IEN) node) is LOCKed
- +20 ; by this function. It is responsibility of the caller to unlock the
- +21 ; record after it is created or the record creation is canceled.
- +22 ;
- NEWIEN() ;
- +1 NEW IEN,NEWIEN,NODE
- +2 SET NEWIEN=0
- +3 ;---
- +4 FOR
- Begin DoDot:1
- +5 SET IEN=$ORDER(^RARPT(" "),-1)+1
- +6 ;--- If the record already exists, skip it
- +7 SET NODE=$NAME(^RARPT(IEN))
- IF $DATA(@NODE)
- QUIT
- +8 ;--- Lock the placeholder in order to make sure that nobody
- +9 ;--- else is trying to allocate it at the same time.
- +10 DO LOCK^DILF(NODE)
- IF '$TEST
- QUIT
- +11 ;--- Double check that the record has not been created after the
- +12 ;--- previous $D() check and the LOCK command (a race condition)
- +13 IF $DATA(@NODE)
- LOCK -@NODE
- QUIT
- +14 ;--- Success
- +15 SET NEWIEN=IEN
- +16 QUIT
- End DoDot:1
- IF NEWIEN
- QUIT
- +17 ;---
- +18 QUIT NEWIEN