Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RANPRO1

RANPRO1.m

Go to the documentation of this file.
  1. RANPRO1 ;BPFO/DTG - NEW RADIOLOGY PROCEDURE ; 27 Oct 2016 4:57 PM
  1. ;;5.0;Radiology/Nuclear Medicine;**138**;Mar 16, 1998;Build 22
  1. ;
  1. ; This section of the routine emulates DESC^RAUTL17 for parent and descendents
  1. ;
  1. DESC(RAD0,RAY) ; Detemine if a procedure qualifies as a descendent for this
  1. ; parent procedure. Descendent must be either a detailed or series
  1. ; type procedure, must be of same imaging type of the parent, and must
  1. ; not be inactive. Called from ^DD(71.1105,.01,0)
  1. ; 'RAD0' ien of parent procedure in file 71.11
  1. ; 'RAY' ien of pointed to procedure in file 71
  1. ; Returns: 'RA' i.e, 0:invalid procedure, 1:valid procedure
  1. ; RAPARNT: zero node of parent procedure
  1. ; RAPARNT(12): i-type of parent procedure
  1. ; RADESC : zero node of descendent procedure
  1. ; RADESC("I"): inactivation date (if any) of descendent
  1. ; RADESC(6) : procedure type of descendent
  1. ; RADESC(12) : i-type of descendent procedure
  1. Q:RAD0'>0!(RAY'>0) 0
  1. Q:'$D(^RAMRPF(71.11,RAD0,0))!('$D(^RAMIS(71,RAY,0))) 0
  1. N RA,RAI,RADESC,RAPARNT S RA=0
  1. S RAPARNT=$G(^RAMRPF(71.11,RAD0,0)),RAPARNT(12)=+$P(RAPARNT,U,12)
  1. S RADESC=$G(^RAMIS(71,RAY,0)),RADESC(6)=$P(RADESC,U,6)
  1. S RADESC(12)=$P(RADESC,U,12)
  1. S RADESC("I")=+$G(^RAMIS(71,RAY,"I"))
  1. S RAI=$S(RADESC("I")=0:1,RADESC("I")>DT:1,1:0)
  1. I RADESC(12)=RAPARNT(12),("^D^S^"[(U_RADESC(6)_U)),(RAI) S RA=1
  1. Q RA
  1. ;