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

RAMAGU03.m

Go to the documentation of this file. 
  1. RAMAGU03 ;HCIOFO/SG - ORDERS/EXAMS API (PROCEDURE UTILITIES) ; 2/24/09 3:44pm
  1.  ;;5.0;Radiology/Nuclear Medicine;**90**;Mar 16, 1998;Build 20
  1.  ;
  1.  Q
  1.  ;
  1.  ;***** CHECKS RADIOLOGY PROCEDURE AND MODIFIERS
  1.  ;
  1.  ; RAPROC        Radiology procedure and modifiers
  1.  ;                 ^01: Procedure IEN in file #71
  1.  ;                 ^02: Optional procedure modifiers (IENs in
  1.  ;                 ...  the PROCEDURE MODIFIERS file (#71.2))
  1.  ;                 ^nn:
  1.  ;
  1.  ; RAIMGTYI      Imaging type IEN (file #79.2) of the order/exam.
  1.  ;
  1.  ; RADTE         Date for procedure status check (active/inactive).
  1.  ;
  1.  ; [PROCTYPE]    If this parameter is defined and has a non-empty
  1.  ;               value, then only referenced types of procedures
  1.  ;               are allowed (see the TYPE OF PROCEDURE field (6)
  1.  ;               of the RAD/NUC MED PROCEDURES file (#71) for more
  1.  ;               details).
  1.  ;
  1.  ;                 B  Broad
  1.  ;                 D  Detailed
  1.  ;                 P  Parent
  1.  ;                 S  Series
  1.  ;
  1.  ;               For example, "BD" will allow 'broad' or 'detailed'
  1.  ;               procedures but exclude 'series' and 'parent' ones.
  1.  ;
  1.  ;               By default ($G(PROCTYPE)=""), all procedures are
  1.  ;               allowed.
  1.  ;
  1.  ; Return values:
  1.  ;       <0  Error descriptor (see $$ERROR^RAERR)
  1.  ;        0  Procedure and modifiers are valid
  1.  ;
  1. CHKPROC(RAPROC,RAIMGTYI,RADTE,PROCTYPE) ;
  1.  N ERRCNT,I,IENS,L,RABUF,RAMSG,RAINFO,RAMINFO,RC,TMP
  1.  S ERRCNT=0,RAINFO="Procedure IEN: "_(+RAPROC)
  1.  ;
  1.  ;=== Radiology procedure IEN
  1.  I RAPROC>0  S RC=0  D  S:RC<0 ERRCNT=ERRCNT+1
  1.  . S IENS=(+RAPROC)_","
  1.  . D GETS^DIQ(71,IENS,".01;6;12;100","I","RABUF","RAMSG")
  1.  . I $G(DIERR)  S RC=$$DBS^RAERR("RAMSG",-9,71,IENS)  Q
  1.  . S TMP=$G(RABUF(71,IENS,.01,"I"))
  1.  . S:TMP'="" RAINFO="Procedure: '"_TMP_"' (IEN="_(+RAPROC)_")"
  1.  . ;--- Imaging type IEN
  1.  . S TMP=+$G(RABUF(71,IENS,12,"I"))
  1.  . I TMP'>0  S RC=$$ERROR^RAERR(-19,,71,IENS,12)  Q
  1.  . ;--- Check if the procedure has required imaging type
  1.  . I TMP'=RAIMGTYI  S RC=$$ERROR^RAERR(-12)  Q
  1.  . ;--- Check if the procedure is/was active on requested date
  1.  . S TMP=$G(RABUF(71,IENS,100,"I"))\1
  1.  . I TMP>0,TMP<(RADTE\1)  D  Q
  1.  . . S RC=$$ERROR^RAERR(-17,,$$FMTE^XLFDT(RADTE))
  1.  . ;--- Check the procedure type if necessary
  1.  . D:$G(PROCTYPE)'=""
  1.  . . S TMP=$G(RABUF(71,IENS,6,"I"))
  1.  . . I TMP'=""  Q:PROCTYPE[TMP
  1.  . . S RC=$$ERROR^RAERR(-18,,TMP)
  1.  E  D ERROR^RAERR(-21,,$P(RAPROC,U))  S ERRCNT=ERRCNT+1
  1.  ;
  1.  ;=== Procedure modifier IENs
  1.  S L=$L(RAPROC,U)
  1.  F I=2:1:L  S TMP=$P(RAPROC,U,I),RC=0  D  S:RC<0 ERRCNT=ERRCNT+1
  1.  . Q:TMP=""
  1.  . I TMP'>0  S RC=$$ERROR^RAERR(-22,,TMP)  Q
  1.  . S IENS=(+TMP)_",",TMP=$$GET1^DIQ(71.2,IENS,.01,,,"RAMSG")
  1.  . I $G(DIERR)  S RC=$$DBS^RAERR("RAMSG",-9,71.2,IENS)  Q
  1.  . I TMP=""  S RC=$$ERROR^RAERR(-19,,71.2,IENS,.01)  Q
  1.  . S RAMINFO="Procedure modifier: '"_TMP_"' (IEN="_(+IENS)_")"
  1.  . ;--- Check the imaging type
  1.  . I $O(^RAMIS(71.2,"AB",RAIMGTYI,+IENS,0))'>0  D  Q
  1.  . . S RC=$$ERROR^RAERR(-39,RAMINFO)
  1.  ;
  1.  ;===
  1.  Q $S(ERRCNT>0:$$ERROR^RAERR(-20,RAINFO),1:0)
  1.  ;
  1.  ;***** TRANSLATES A PARENT PROCEDURE INTO THE LIST OF DESCENDENTS
  1.  ;
  1.  ; RAPIEN        IEN of a Radiology procedure in file #71
  1.  ;
  1.  ; .RAPLST       Reference to a local array where IENs and names
  1.  ;               of descendent procedures are returned to:
  1.  ;                 RAPLST(Seq#)=IEN^Name
  1.  ;
  1.  ; [.SNGLRPT]    Reference to a local variable that will reflect the
  1.  ;               value of the SINGLE REPORT field (18) of the parent
  1.  ;               procedure (1 for YES, 0 otherwise).
  1.  ;
  1.  ; Return values:
  1.  ;       <0  Error descriptor (see $$ERROR^RAERR)
  1.  ;        0  Procedure defined by the RAPIEN is not a parent one
  1.  ;       >0  Number of descendents in the RAPLST array
  1.  ;
  1. DESCPLST(RAPIEN,RAPLST,SNGLRPT) ;
  1.  N CNT,IENS,RABUF,RAMSG,RC,TMP
  1.  K RAPLST  S SNGLRPT=0
  1.  ;--- Get the procedure data
  1.  S IENS=RAPIEN_","
  1.  D GETS^DIQ(71,IENS,"6;18;300*","IE","RABUF","RAMSG")
  1.  Q:$G(DIERR) $$DBS^RAERR("RAMSG",-9,71,IENS)
  1.  ;--- Quit if not a "parent" procedure
  1.  Q:$G(RABUF(71,IENS,6,"I"))'="P" 0
  1.  ;--- Single report
  1.  S:$G(RABUF(71,IENS,18,"I"))="Y" SNGLRPT=1
  1.  ;--- Compile the list of descendents
  1.  S IENS="",CNT=0
  1.  F  S IENS=$O(RABUF(71.05,IENS))  Q:IENS=""  D
  1.  . S TMP=+$G(RABUF(71.05,IENS,.01,"I"))
  1.  . I TMP'>0  S RC=$$ERROR^RAERR(-19,,71.05,IENS,.01)  Q
  1.  . S CNT=CNT+1
  1.  . S RAPLST(CNT)=TMP_U_$G(RABUF(71.05,IENS,.01,"E"))
  1.  ;---
  1.  Q CNT