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

RAMAG03D.m

Go to the documentation of this file. 
  1. RAMAG03D ;HCIOFO/SG - ORDERS/EXAMS API (REGISTR. UTILS) ; 5/27/08 1:31pm
  1.  ;;5.0;Radiology/Nuclear Medicine;**90**;Mar 16, 1998;Build 20
  1.  ;
  1.  Q
  1.  ;
  1.  ;***** GENERATES NEW CASE NUMBER
  1.  ;
  1.  ; RADTE         Date of the exam (FileMan)
  1.  ;
  1.  ; [RATYPE]      IEN of the imaging type (file #79.2).
  1.  ;
  1.  ;               Currently, the Radiology package always uses
  1.  ;               IEN of the "GENERAL RADIOLOGY" record. This API
  1.  ;               does the same if the RATYPE parameter is not
  1.  ;               defined or not greater than 0.
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error descriptor (see $$ERROR^RAERR)
  1.  ;       >0  Case number (1-99999)
  1.  ;
  1. CASENUM(RADTE,RATYPE) ;
  1.  N %H,%T,%Y,RADTE99,RAII,RAJ,RALOCK,RAX,RAXX,RC,TMP,X,X1,X2
  1.  Q:$G(RADTE)'>0 $$IPVE^RAERR("RADTE")
  1.  ;--- Get the default imaging type
  1.  I $G(RATYPE)'>0  D  Q:'$D(^RA(79.2,RATYPE,0)) $$ERROR^RAERR(-36)
  1.  . S RATYPE=+$O(^RA(79.2,"B","GENERAL RADIOLOGY",0))
  1.  ;---
  1.  K TMP  S TMP(79.2,RATYPE_",",25)=""  ; "CN" node
  1.  S RC=$$LOCKFM^RALOCK(.TMP)
  1.  Q:RC $$LOCKERR^RAERR(RC,"next case number")
  1.  M RALOCK=TMP
  1.  D
  1.  . S X=$G(^RA(79.2,RATYPE,"CN"))
  1.  . D:(DT>$P(X,U,2))!(X>99999) CAL^RAREG1
  1.  . ;--- Double check that the number is not used
  1.  . S RAX=+^RA(79.2,RATYPE,"CN")  D DUP^RAREG1
  1.  . ;--- Recalculate if DUP returned a value bigger than 99999
  1.  . I RAX>99999  D  I RAX>99999  S RAX=$$ERROR^RAERR(-37)  Q
  1.  . . D CAL^RAREG1  S RAX=+^RA(79.2,RATYPE,"CN")  D DUP^RAREG1
  1.  . ;--- Get the next free case number and store it
  1.  . F RAJ=RAX+1:1  I '$D(^RADPT("AE",RAJ))  D  Q
  1.  . . S $P(^RA(79.2,RATYPE,"CN"),U)=RAJ
  1.  . ;--- If the next free case number for future use is
  1.  . ;--- greater than 99999,then recalculate again
  1.  . D:^RA(79.2,RATYPE,"CN")>99999 CAL^RAREG1
  1.  D UNLOCKFM^RALOCK(.RALOCK)
  1.  ;---
  1.  Q RAX
  1.  ;
  1.  ;+++++ DOUBLE CHECKS AND LOCKS THE EXAM DATE/TIME
  1.  ;
  1.  ; RADFN         Patient IEN (DFN)
  1.  ;
  1.  ; .RADTE        Reference to a local variable that stores the date
  1.  ;               of the exam (FileMan).
  1.  ;
  1.  ;               NOTE: The $$LOCKDT function can slightly change
  1.  ;                     the exam date/time. The new value is returned
  1.  ;                     in this parameter.
  1.  ;
  1.  ; [.RALOCK]     Reference to a local variable where identifiers
  1.  ;               of the locked exam date/time node are added to.
  1.  ;
  1.  ; [FLAGS]       Flags that control the execution (can be combined).
  1.  ;               See description of the flags "A" and "D" in the
  1.  ;               source code of the ^RAMAG routine.
  1.  ;
  1.  ; Return values:
  1.  ;       <0  Error descriptor (see $$ERROR^RAERR)
  1.  ;        0  Success
  1.  ;
  1. LOCKDT(RADFN,RADTE,RALOCK,FLAGS) ;
  1.  N EXAMSET,IENS,ORIGDATE,RADTI,RAI,RAIENS,RAMSG,RARC,RAROOT,TMP
  1.  S ORIGDATE=RADTE\1,RADTI=$$INVDTE^RAMAGU04(RADTE)
  1.  S RAIENS=","_RADFN_",",RAROOT=$$ROOT^DILFD(70.02,RAIENS,1)
  1.  S FLAGS=$G(FLAGS),RARC=0
  1.  ;
  1.  ;=== Lock the whole REGISTERED EXAMS multiple
  1.  K TMP  S TMP(70.02,RAIENS)=""
  1.  S RARC=$$LOCKFM^RALOCK(.TMP)
  1.  Q:RARC $$LOCKERR^RAERR(RARC,"patient's exams")
  1.  M RALOCK=TMP
  1.  ;
  1.  D
  1.  . ;--- Setup the error handler
  1.  . N $ESTACK,$ETRAP  D SETDEFEH^RAERR("RARC")
  1.  . ;--- Check if the patient already has exam(s) for this date/time
  1.  . I '$D(@RAROOT@(RADTI))  S RARC=0  D  Q:RARC<0
  1.  . . ;--- Check for a 'subset' date
  1.  . . F RAI=1:1:10  D  Q:RARC
  1.  . . . S TMP=$O(@RAROOT@("B",RADTE))
  1.  . . . I TMP'[RADTE,$P(RADTE,".",2),'$D(@RAROOT@(RADTI))  S RARC=1  Q
  1.  . . . ;--- Slightly modify the exam date/time
  1.  . . . S RADTE=$$FMADD^XLFDT(RADTE,,,1)  ; Add 1 minute
  1.  . . . S RADTI=$$INVDTE^RAMAGU04(RADTE)
  1.  . . ;--- Too many registered exams at almost the same date/time
  1.  . . S:'RARC RARC=$$ERROR^RAERR(-29)
  1.  . E  I $TR(FLAGS,"AD")=FLAGS  D  Q
  1.  . . ;--- By default, neither add to existing cases nor modify time
  1.  . . S RARC=$$ERROR^RAERR(-28,,$$FMTE^XLFDT(RADTE))
  1.  . E  S RARC=0  D  Q:RARC<0
  1.  . . F  D  Q:RARC  Q:'$D(@RAROOT@(RADTI))
  1.  . . . ;--- Check if the existing date/time record stores an exam set
  1.  . . . S IENS=RADTI_RAIENS
  1.  . . . S EXAMSET=+$$GET1^DIQ(70.02,IENS,5,"I",,"RAMSG")  ; EXAM SET
  1.  . . . I $G(DIERR)  S RARC=$$DBS^RAERR("RAMSG",-9,70.02,IENS)  Q
  1.  . . . I 'EXAMSET,FLAGS["A"  S RARC=1  Q
  1.  . . . I EXAMSET,FLAGS'["D"  S RARC=$$ERROR^RAERR(-54)  Q
  1.  . . . ;--- Never add a case to an exam set implicitly; modify the
  1.  . . . ;    date/time of the new case instead. Also, check for
  1.  . . . ;--- 'subset' dates. Make sure that the time part is there.
  1.  . . . F  D  Q:(TMP'[RADTE)&$P(RADTE,".",2)
  1.  . . . . ;--- Add 1 minute to the exam date/time
  1.  . . . . S RADTE=$$FMADD^XLFDT(RADTE,,,1)  ; Add 1 minute
  1.  . . . . S RADTI=$$INVDTE^RAMAGU04(RADTE)
  1.  . . . . S TMP=$O(@RAROOT@("B",RADTE))
  1.  . . . ;--- Check if the date is still the same
  1.  . . . S:(RADTE\1)'=ORIGDATE RARC=$$ERROR^RAERR(-29)
  1.  . ;--- Lock the date/time in the REGISTERED EXAMS multiple
  1.  . K TMP  S TMP(70.02,RADTI_RAIENS)=""
  1.  . S RARC=$$LOCKFM^RALOCK(.TMP)
  1.  . I RARC  S RARC=$$LOCKERR^RAERR(RARC,"exam date/time")  Q
  1.  . M RALOCK=TMP
  1.  ;
  1.  ;=== Unlock the REGISTERED EXAMS multiple
  1.  D UNLOCKFM^RALOCK(70.02,RAIENS)
  1.  K RALOCK(70.02,RAIENS)
  1.  ;===
  1.  Q $S(RARC<0:RARC,1:0)
  1.  ;
  1.  ;+++++ DISCARDS THE CHANGES IN CASE OF ERROR(S)
  1.  ;
  1.  ; RADFN         IEN of the patient
  1.  ;
  1.  ; RADTI         "Inverted" date/time of registered exam(s)
  1.  ;
  1.  ; Input variables:
  1.  ;   ^TMP($J,"RAREG1",...)
  1.  ;
  1. ROLLBACK(RADFN,RADTI) ;
  1.  N DA,DIK,RACASE,RAFDA,RAI,RAIENS,RAMSG,RAOIFN,RAOLST,TMP
  1.  ;
  1.  ;=== Delete incomplete exams
  1.  S RAI=0
  1.  F  S RAI=$O(^TMP($J,"RAREG1",RAI))  Q:RAI'>0  D
  1.  . S RACASE=^TMP($J,"RAREG1",RAI)
  1.  . S RAIENS=$$EXAMIENS^RAMAGU04(RACASE)
  1.  . ;--- Delete the Nuclear Medicine data
  1.  . K DA,DIK
  1.  . S DA=$$GET1^DIQ(70.03,RAIENS,500,"I",,"RAMSG")
  1.  . I DA>0  S DIK="^RADPTN("  D ^DIK
  1.  . ;--- Delete the incomplete record
  1.  . K DA,DIK
  1.  . D DA^DILF(RAIENS,.DA)
  1.  . S DIK=$$ROOT^DILFD(70.03,","_DA(1)_","_DA(2)_",")
  1.  . D ^DIK
  1.  . ;--- Restore order status to "pending"
  1.  . S RAOIFN=+$P(RACASE,U,4)
  1.  . I RAOIFN>0,'$D(RAOLST(RAOIFN))  S RAOLST(RAOIFN)=""  D
  1.  . . S TMP=$$OSTRLBCK^RAMAGU02(RAOIFN,5)
  1.  . ;--- Remove the reference from the list
  1.  . K ^TMP($J,"RAREG1",RAI)
  1.  ;
  1.  ;=== Delete incomplete date/time record
  1.  I RADFN>0,RADTI>0  D
  1.  . ;--- Check if the EXAMINATIONS multiple is not empty
  1.  . S TMP=$$ROOT^DILFD(70.03,","_RADTI_","_RADFN_",",1)
  1.  . Q:$O(@TMP@(0))>0
  1.  . ;--- Delete record from the REGISTERED EXAMS multiple
  1.  . K DA,DIK
  1.  . S DIK=$$ROOT^DILFD(70.02,","_RADFN_",")
  1.  . S DA=RADTI,DA(1)=RADFN   D ^DIK
  1.  ;
  1.  ;===
  1.  Q