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

RAUTL17.m

Go to the documentation of this file. 
  1. RAUTL17 ;HISC/DAD-RAD/NUC MED COMMON PROCEDURE FILE (#71.3) UTILITIES ;19 Apr 2019 3:32 PM
  1.  ;;5.0;Radiology/Nuclear Medicine;**158**;Mar 16, 1998;Build 2
  1. EN1 ; *** Get an imaging type
  1.  ; Input:  None
  1.  ; Output: The variable 'Y' will be one of the following
  1.  ;         -1 = No imaging type selected (up-arrow, time-out, etc.)
  1.  ;          0 = No active imaging types found
  1.  ;        IEN = IMAGING TYPE file (#79.2) IEN
  1.  N DIC,RAI,RAIMGTYI,X
  1.  ; *** Get active imaging types (must have at least one imaging
  1.  ;     location and at least one procedure to be active)
  1.  S (RAI,RAIMGTYI)=0
  1.  F  S RAIMGTYI=$O(^RA(79.2,RAIMGTYI)) Q:RAIMGTYI'>0  D
  1.  . I $O(^RAMIS(71,"AIMG",RAIMGTYI,0)),$O(^RA(79.1,"BIMG",RAIMGTYI,0)) D
  1.  .. S RAIMGTYI(RAIMGTYI)=1
  1.  .. Q
  1.  . Q
  1.  S RAIMGTYI=+$O(RAIMGTYI(0))
  1.  ; *** No active imaging types
  1.  I RAIMGTYI'>0 D  S Y=0 G EN1EXIT
  1.  . W !!?5,"No 'active' imaging types were found.  For an imaging"
  1.  . W !?5,"type to be active it must be assigned to at least one"
  1.  . W !?5,"imaging location and at least one procedure."
  1.  . Q
  1.  ; *** Only one active imaging type
  1.  I $O(RAIMGTYI(RAIMGTYI))'>0 S Y=RAIMGTYI G EN1EXIT
  1.  ; *** display the imaging types available for selection
  1.  W !,"Select one of the following imaging types:"
  1.  F  S RAI=$O(RAIMGTYI(RAI)) Q:RAI'>0  W !?3,$$GET1^DIQ(79.2,RAI_",",.01)
  1.  ; *** Prompt for active imaging type
  1.  K DIC S DIC="^RA(79.2,",DIC(0)="AEMQ",DIC("A")="Select IMAGING TYPE: "
  1.  S DIC("S")="I $G(RAIMGTYI(+Y))"
  1.  W ! D ^DIC S Y=+Y
  1. EN1EXIT Q
  1.  ;
  1. EN2(RAIMGTYI,RA71) ; *** Common procedure file error check
  1.  ; Input:  RAIMGTYI = IMAGING TYPE file (#79.2) IEN
  1.  ;         RA71 = PROCEDURE file (#71) IEN (Optional)
  1.  ; Output: Number_of_Common_Proccedures ^ $S(Duplicate_Sequence#:1,1:0)
  1.  ;
  1.  N RA713,RACNT,RAD0,RADUP,RASEQ
  1.  S (RASEQ,RACNT,RADUP)=0
  1.  F  S RASEQ=$O(^RAMIS(71.3,"AA",RAIMGTYI,RASEQ)) Q:RASEQ'>0  D
  1.  . S RA713=0
  1.  . F  S RA713=$O(^RAMIS(71.3,"AA",RAIMGTYI,RASEQ,RA713)) Q:RA713'>0  D
  1.  .. S RACNT=RACNT+1 I $G(RASEQ(RASEQ)) S RADUP=1
  1.  .. S RASEQ(RASEQ)=$S($G(RASEQ(RASEQ)):RASEQ(RASEQ)_U,1:"")_RA713
  1.  .. Q
  1.  . Q
  1.  I $G(RA71),RADUP'>0 D
  1.  . S RA713=0 K RASEQ
  1.  . F  S RA713=$O(^RAMIS(71.3,"B",RA71,RA713)) Q:RA713'>0  D
  1.  .. S RA713(0)=$G(^RAMIS(71.3,RA713,0)),RASEQ=$P(RA713(0),U,4)
  1.  .. I RASEQ S RASEQ(RASEQ)=""
  1.  .. Q
  1.  . S RASEQ=0
  1.  . F  S RASEQ=$O(RASEQ(RASEQ)) Q:RASEQ'>0!RADUP  D
  1.  .. I $O(^RAMIS(71.3,"AA",RAIMGTYI,RASEQ,0)) S RADUP=1
  1.  .. Q
  1.  . Q
  1.  Q RACNT_U_RADUP
  1.  ;
  1. EN3(D0) ; *** imaging type of a procedure
  1.  ; Input:  RAD/NUC MED PROCEDURE file (#71) IEN
  1.  ; Output: IMAGING TYPE file (#79.2) IEN
  1.  Q +$P($G(^RAMIS(71,+D0,0)),U,12)
  1.  ;
  1. EN5(RAD0,RAIMGTYI,RASEQ,SK) ; *** Update ^RAMIS(71.3,"AA", xref
  1.  ; Input:  RAD0  = RAD/NUC MED COMMON PROCEDURE file (#71.3) IEN
  1.  ;         RAPRC = PROCEDURE file (#71) IEN
  1.  ;         RASEQ = Sequence number
  1.  ;         SK    = Set/Kill flag: $S(SK="S":Set_xref,SK="K":Kill_xref)
  1.  I (RASEQ'>0)!(RAIMGTYI'>0) Q
  1.  I SK="S" S ^RAMIS(71.3,"AA",RAIMGTYI,RASEQ,RAD0)=""
  1.  I SK="K" K ^RAMIS(71.3,"AA",RAIMGTYI,RASEQ,RAD0)
  1.  Q
  1.  ;
  1. EN6(RAIMGTYI,RA71) ; *** Common procedure file error messages
  1.  ;Invoked when .01 field of file 71.3 is edited, allowing the user
  1.  ;to change the procedure that the .01 field points to
  1.  ; Input:  RAIMGTYI = IMAGING TYPE file (#79.2) IEN
  1.  ;         RA71 = PROCEDURE file (#71) IEN
  1.  N RA,RACNT,RADUP
  1.  S RA=$$EN2(RAIMGTYI,RA71),RACNT=$P(RA,U),RADUP=$P(RA,U,2)
  1.  I RACNT>40!RADUP D  K X
  1.  . N RATXT
  1.  . S RATXT(1)=""
  1.  . S RATXT(2)="Changing/ADDING this procedure would cause the following"
  1.  . S RATXT(3)="problem(s) in the Rad/Nuc Med Common Procedure file:"
  1.  . S RATXT(4)=""
  1.  . I RACNT>40 S RATXT(10)="   More than 40 common procedures with the same imaging type."
  1.  . I RADUP S RATXT(20)="   Two or more procedures with the same sequence number."
  1.  . S RATXT(30)=""
  1.  . S RATXT(31)="In order to change this procedure you must first"
  1.  . S RATXT(32)="inactivate it in the Rad/Nuc Med Common Procedure file."
  1.  . S RATXT(33)=""
  1.  . D EN^DDIOL(.RATXT)
  1.  . Q
  1.  Q
  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.05,.01,0)
  1.  ; 'RAD0' ien of parent procedure in file 71
  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(^RAMIS(71,RAD0,0))!('$D(^RAMIS(71,RAY,0))) 0
  1.  N RA,RAI,RADESC,RAPARNT S RA=0
  1.  S RAPARNT=$G(^RAMIS(71,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.  ;
  1. EN713(RAX) ;is this procedure from file 71 already a common procedure?
  1.  ;RAX = PROCEDURE [.01] field value from 71.3 (ptr to file 71)
  1.  ;
  1.  ;returns 1 if the PROCEDURE field value is not a duplicate, else 0
  1.  Q:+$O(^RAMIS(71.3,"B",+RAX,0))=0 1
  1.  D EN^DDIOL("`"_$P($G(^RAMIS(71,+RAX,0)),"^")_"' already exists as a Common Procedure.")
  1.  Q 0
  1.  ;