- RANPRO1 ;BPFO/DTG - NEW RADIOLOGY PROCEDURE ; 27 Oct 2016 4:57 PM
- ;;5.0;Radiology/Nuclear Medicine;**138**;Mar 16, 1998;Build 22
- ;
- ; This section of the routine emulates DESC^RAUTL17 for parent and descendents
- ;
- DESC(RAD0,RAY) ; Detemine if a procedure qualifies as a descendent for this
- ; parent procedure. Descendent must be either a detailed or series
- ; type procedure, must be of same imaging type of the parent, and must
- ; not be inactive. Called from ^DD(71.1105,.01,0)
- ; 'RAD0' ien of parent procedure in file 71.11
- ; 'RAY' ien of pointed to procedure in file 71
- ; Returns: 'RA' i.e, 0:invalid procedure, 1:valid procedure
- ; RAPARNT: zero node of parent procedure
- ; RAPARNT(12): i-type of parent procedure
- ; RADESC : zero node of descendent procedure
- ; RADESC("I"): inactivation date (if any) of descendent
- ; RADESC(6) : procedure type of descendent
- ; RADESC(12) : i-type of descendent procedure
- Q:RAD0'>0!(RAY'>0) 0
- Q:'$D(^RAMRPF(71.11,RAD0,0))!('$D(^RAMIS(71,RAY,0))) 0
- N RA,RAI,RADESC,RAPARNT S RA=0
- S RAPARNT=$G(^RAMRPF(71.11,RAD0,0)),RAPARNT(12)=+$P(RAPARNT,U,12)
- S RADESC=$G(^RAMIS(71,RAY,0)),RADESC(6)=$P(RADESC,U,6)
- S RADESC(12)=$P(RADESC,U,12)
- S RADESC("I")=+$G(^RAMIS(71,RAY,"I"))
- S RAI=$S(RADESC("I")=0:1,RADESC("I")>DT:1,1:0)
- I RADESC(12)=RAPARNT(12),("^D^S^"[(U_RADESC(6)_U)),(RAI) S RA=1
- Q RA
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRANPRO1 1381 printed Feb 19, 2025@00:03:51 Page 2
- RANPRO1 ;BPFO/DTG - NEW RADIOLOGY PROCEDURE ; 27 Oct 2016 4:57 PM
- +1 ;;5.0;Radiology/Nuclear Medicine;**138**;Mar 16, 1998;Build 22
- +2 ;
- +3 ; This section of the routine emulates DESC^RAUTL17 for parent and descendents
- +4 ;
- DESC(RAD0,RAY) ; Detemine if a procedure qualifies as a descendent for this
- +1 ; parent procedure. Descendent must be either a detailed or series
- +2 ; type procedure, must be of same imaging type of the parent, and must
- +3 ; not be inactive. Called from ^DD(71.1105,.01,0)
- +4 ; 'RAD0' ien of parent procedure in file 71.11
- +5 ; 'RAY' ien of pointed to procedure in file 71
- +6 ; Returns: 'RA' i.e, 0:invalid procedure, 1:valid procedure
- +7 ; RAPARNT: zero node of parent procedure
- +8 ; RAPARNT(12): i-type of parent procedure
- +9 ; RADESC : zero node of descendent procedure
- +10 ; RADESC("I"): inactivation date (if any) of descendent
- +11 ; RADESC(6) : procedure type of descendent
- +12 ; RADESC(12) : i-type of descendent procedure
- +13 if RAD0'>0!(RAY'>0)
- QUIT 0
- +14 if '$DATA(^RAMRPF(71.11,RAD0,0))!('$DATA(^RAMIS(71,RAY,0)))
- QUIT 0
- +15 NEW RA,RAI,RADESC,RAPARNT
- SET RA=0
- +16 SET RAPARNT=$GET(^RAMRPF(71.11,RAD0,0))
- SET RAPARNT(12)=+$PIECE(RAPARNT,U,12)
- +17 SET RADESC=$GET(^RAMIS(71,RAY,0))
- SET RADESC(6)=$PIECE(RADESC,U,6)
- +18 SET RADESC(12)=$PIECE(RADESC,U,12)
- +19 SET RADESC("I")=+$GET(^RAMIS(71,RAY,"I"))
- +20 SET RAI=$SELECT(RADESC("I")=0:1,RADESC("I")>DT:1,1:0)
- +21 IF RADESC(12)=RAPARNT(12)
- IF ("^D^S^"[(U_RADESC(6)_U))
- IF (RAI)
- SET RA=1
- +22 QUIT RA
- +23 ;