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

RAMAGU13.m

Go to the documentation of this file.
  1. RAMAGU13 ;HCIOFO/SG - ORDERS/EXAMS API (MISC UTILITIES) ; 2/10/09 4:11pm
  1. ;;5.0;Radiology/Nuclear Medicine;**90**;Mar 16, 1998;Build 20
  1. ;
  1. Q
  1. ;
  1. ;***** CREATES A STUB IN THE NUC MED EXAM DATA FILE (#70.2)
  1. ;
  1. ; RACASE Examination identifiers
  1. ; ^01: IEN of the patient in the file #70 (RADFN)
  1. ; ^02: IEN in the REGISTERED EXAMS multiple (RADTI)
  1. ; ^03: IEN in the EXAMINATIONS multiple (RACNI)
  1. ;
  1. ; [RAPROCIEN] IEN of the Radiology procedure. By default
  1. ; ($G(RAPROCIEN)'>0), it is loaded from the exam
  1. ; record.
  1. ;
  1. ; [RADTE] Exam date. By default ($G(RADTE)'>0), it is
  1. ; loaded from the date/time record of the exam.
  1. ;
  1. ; [RACN] Case number. By default ($G(RACN)'>0), it is
  1. ; loaded from the exam record.
  1. ;
  1. ; Return Values:
  1. ; <0 Error descriptor (see $$ERROR^RAERR)
  1. ; 0 The record is not needed
  1. ; >0 IEN of the record of the NUC MED EXAM DATA file (#70.2)
  1. ;
  1. NMEDSTUB(RACASE,RAPROCIEN,RADTE,RACN) ;
  1. N IENS,RABUF,RAFDA,RAIENLST,RAIENS,RAMSG,RANMDIEN,RARC,TMP
  1. S RARC=0,RAIENS=$$EXAMIENS^RAMAGU04(RACASE)
  1. ;
  1. ;=== Check parameter values and load default ones if necessary
  1. S TMP="500" ; NUCLEAR MED DATA
  1. S:$G(RACN)'>0 TMP=TMP_";.01" ; CASE NUMBER
  1. S:$G(RAPROCIEN)'>0 TMP=TMP_";2" ; PROCEDURE
  1. D GETS^DIQ(70.03,RAIENS,TMP,"I","RABUF","RAMSG")
  1. Q:$G(DIERR) $$DBS^RAERR("RAMSG",-9,70.03,RAIENS)
  1. S:$G(RACN)'>0 RACN=$G(RABUF(70.03,RAIENS,.01,"I"))
  1. S:$G(RAPROCIEN)'>0 RAPROCIEN=$G(RABUF(70.03,RAIENS,2,"I"))
  1. S RANMDIEN=+$G(RABUF(70.03,RAIENS,500,"I"))
  1. ;--- Return IEN of the nuclear medicine record if it exists already
  1. I RANMDIEN>0 Q:$D(^RADPTN(RANMDIEN)) RANMDIEN
  1. ;--- Exam date/time
  1. I $G(RADTE)'>0 D Q:$G(DIERR) $$DBS^RAERR("RAMSG",-9,70.02,IENS)
  1. . S IENS=$P(RAIENS,",",2,4) ; Keep the trailing comma
  1. . S RADTE=$$GET1^DIQ(70.02,IENS,.01,"I",,"RAMSG")
  1. ;
  1. ;=== Check if the nuclear medicine record is needed
  1. S IENS=+RAPROCIEN_","
  1. ;--- Check the value of the RADIOPHARMACEUTICALS USED?
  1. ;--- field of the IMAGING TYPE file (#79.2)
  1. S TMP=$$GET1^DIQ(71,IENS,"#12:#5","I",,"RAMSG")
  1. Q:$G(DIERR) $$DBS^RAERR("RAMSG",-9,71,IENS)
  1. Q:TMP'="Y" 0
  1. ;--- Check the value of the SUPPRESS RADIOPHARM PROMPT
  1. ;--- field of the RAD/NUC MED PROCEDURES file (#71)
  1. S TMP=$$GET1^DIQ(71,IENS,2,"I",,"RAMSG")
  1. Q:$G(DIERR) $$DBS^RAERR("RAMSG",-9,71,IENS)
  1. Q:TMP 0
  1. ;
  1. ;=== Create the stub record
  1. S IENS="+1,"
  1. S RAFDA(70.2,IENS,.01)=$P(RACASE,U)
  1. S RAFDA(70.2,IENS,2)=RADTE
  1. S RAFDA(70.2,IENS,3)=RACN
  1. D UPDATE^DIE(,"RAFDA","RAIENLST","RAMSG")
  1. Q:$G(DIERR) $$DBS^RAERR("RAMSG",-9,70.2,IENS)
  1. S RANMDIEN=+RAIENLST(1)
  1. ;
  1. ;=== Store the pointer
  1. D
  1. . ;--- Setup the error handler
  1. . N $ESTACK,$ETRAP D SETDEFEH^RAERR("RARC")
  1. . ;--- Update the exam record
  1. . S RAFDA(70.03,RAIENS,500)=RANMDIEN
  1. . D FILE^DIE(,"RAFDA","RAMSG")
  1. . S:$G(DIERR) RARC=$$DBS^RAERR("RAMSG",-9,70.03,RAIENS)
  1. ;--- Remove the stray record if the pointer cannot be stored
  1. I RARC<0 D Q RARC
  1. . N DA,DIK S DIK="^RADPTN(",DA=RANMDIEN D ^DIK
  1. ;
  1. ;=== Success
  1. Q RANMDIEN
  1. ;
  1. ;***** SEARCHES FOR THE RAD/NUC MED REASON SYNONYM
  1. ;
  1. ; REASON Either IEN of a record of the RAD/NUC MED REASON
  1. ; file (#75.2) or a valid synonym (see SYNONYM field
  1. ; (3) of that file).
  1. ;
  1. ; [.TYPE] Reference to a local variable where internal and
  1. ; external values (separated by "^") of the TYPE OF
  1. ; REASON field (2) of the file #75.2 are returned to.
  1. ;
  1. ; Return Values:
  1. ; <0 Error descriptor (see $$ERROR^RAERR)
  1. ; >0 IEN of the record in the file #75.2
  1. ;
  1. RARSNIEN(REASON,TYPE) ;
  1. N IENS,RABUF,RAMSG,RC,TMP
  1. S TYPE="",RC=$$CHKREQ^RAUTL22("REASON") Q:RC<0 RC
  1. ;---
  1. I (+REASON)'=REASON D ;--- Synonym of the reason
  1. . ;--- Find the reason
  1. . D FIND^DIC(75.2,,"@;2IE",,REASON,2,"S",,,"RABUF","RAMSG")
  1. . I $G(DIERR) S RC=$$DBS^RAERR("RAMSG",-9,75.2) Q
  1. . S TMP=+$G(RABUF("DILIST",0))
  1. . ;--- No such synonym on file
  1. . I TMP<1 S RC=$$ERROR^RAERR(-33,,"synonym",75.2) Q
  1. . ;--- Ambiguous synonym
  1. . I TMP>1 S RC=$$ERROR^RAERR(-14,,"synonym",REASON) Q
  1. . ;--- Reason IEN and type
  1. . S TYPE=$G(RABUF("DILIST","ID",1,2,"I"))
  1. . S TYPE=TYPE_U_$G(RABUF("DILIST","ID",1,2,"E"))
  1. . S REASON=+RABUF("DILIST",2,1)
  1. E D ;--- Reason IEN
  1. . S IENS=REASON_","
  1. . D GETS^DIQ(75.2,IENS,"2","EI","RABUF","RAMSG")
  1. . I $G(DIERR) S RC=$$DBS^RAERR("RAMSG",-9,75.2,IENS) Q
  1. . S TYPE=$G(RABUF(75.2,IENS,2,"I"))_U_$G(RABUF(75.2,IENS,2,"E"))
  1. ;---
  1. Q $S(RC<0:RC,1:REASON)
  1. ;
  1. ;***** UPDATES VALUES OF THE MULTIPLE(S)
  1. ;
  1. ; .RAFDAM Reference to a local variable that stores field
  1. ; values prepared for storage (FileMan FDA array)
  1. ;
  1. ; RAIENS IENS of the main record that multiple values in
  1. ; the RAFDAM belong to
  1. ;
  1. ; [RAFLAGS] Flags for UPDATE^DIE
  1. ;
  1. ; Return values:
  1. ; <0 Error descriptor (see $$ERROR^RAERR)
  1. ; 0 Success
  1. ;
  1. UPDMULT(RAFDAM,RAIENS,RAFLAGS) ;
  1. N DA,DIK,ERR,IENS,RAFDA,RAMSG,RANODE,RARC,RASUBF
  1. S (RARC,RASUBF)=0,RAFLAGS=$G(RAFLAGS)
  1. F S RASUBF=$O(RAFDAM(RASUBF)) Q:RASUBF'>0 D Q:RARC<0
  1. . K RAFDA,RAMSG M RAFDA(RASUBF)=RAFDAM(RASUBF)
  1. . S IENS=","_RAIENS D DA^DILF(IENS,.DA)
  1. . S DIK=$$ROOT^DILFD(RASUBF,IENS,0,.ERR)
  1. . I $G(ERR)!(DIK="") S RARC=$$ERROR^RAERR(-50,,RASUBF,IENS) Q
  1. . S RANODE=$$CREF^DILF(DIK)
  1. . ;--- Delete the old data
  1. . D IXALL2^DIK ; Delete entries from cross-references
  1. . K @RANODE ; Clear the whole multiple
  1. . ;--- Store the new data
  1. . I $D(RAFDA)>1 D Q:RARC<0
  1. . . D UPDATE^DIE(RAFLAGS,"RAFDA",,"RAMSG")
  1. . . S:$G(DIERR) RARC=$$DBS^RAERR("RAMSG",-9,RASUBF,"*,"_RAIENS)
  1. . ;--- Remove subfile data from the source FDA
  1. . K:RAFLAGS'["S" RAFDAM(RASUBF)
  1. ;---
  1. Q $S(RARC<0:RARC,1:0)
  1. ;
  1. ;***** CHECKS IF THE LONG ACCESSION NUMBER SHOULD BE USED
  1. ;
  1. ; RAMDIV Radiology division IEN (file #79)
  1. ;
  1. ; Return values:
  1. ; 0 Use short accession number (MMDDYY-NNNNN)
  1. ; 1 Use long accession number (SSS-MMDDYY-NNNNN)
  1. ;
  1. USLNGACN(RAMDIV) ;
  1. Q:RAMDIV'>0 0
  1. N RAMSG
  1. ;--- Check the value of the USE SITE ACCESSION NUMBER? field (.131)
  1. ; of the RAD/NUC MED DIVISION file (#79). This field is exported
  1. ;--- by the patch RA*5*47. See the data dictionary for details.
  1. Q ($$GET1^DIQ(79,RAMDIV_",",.131,"I",,"RAMSG")="Y")