RAMAG03D ;HCIOFO/SG - ORDERS/EXAMS API (REGISTR. UTILS) ; 5/27/08 1:31pm
;;5.0;Radiology/Nuclear Medicine;**90**;Mar 16, 1998;Build 20
;
Q
;
;***** GENERATES NEW CASE NUMBER
;
; RADTE Date of the exam (FileMan)
;
; [RATYPE] IEN of the imaging type (file #79.2).
;
; Currently, the Radiology package always uses
; IEN of the "GENERAL RADIOLOGY" record. This API
; does the same if the RATYPE parameter is not
; defined or not greater than 0.
;
; Return Values:
; <0 Error descriptor (see $$ERROR^RAERR)
; >0 Case number (1-99999)
;
CASENUM(RADTE,RATYPE) ;
N %H,%T,%Y,RADTE99,RAII,RAJ,RALOCK,RAX,RAXX,RC,TMP,X,X1,X2
Q:$G(RADTE)'>0 $$IPVE^RAERR("RADTE")
;--- Get the default imaging type
I $G(RATYPE)'>0 D Q:'$D(^RA(79.2,RATYPE,0)) $$ERROR^RAERR(-36)
. S RATYPE=+$O(^RA(79.2,"B","GENERAL RADIOLOGY",0))
;---
K TMP S TMP(79.2,RATYPE_",",25)="" ; "CN" node
S RC=$$LOCKFM^RALOCK(.TMP)
Q:RC $$LOCKERR^RAERR(RC,"next case number")
M RALOCK=TMP
D
. S X=$G(^RA(79.2,RATYPE,"CN"))
. D:(DT>$P(X,U,2))!(X>99999) CAL^RAREG1
. ;--- Double check that the number is not used
. S RAX=+^RA(79.2,RATYPE,"CN") D DUP^RAREG1
. ;--- Recalculate if DUP returned a value bigger than 99999
. I RAX>99999 D I RAX>99999 S RAX=$$ERROR^RAERR(-37) Q
. . D CAL^RAREG1 S RAX=+^RA(79.2,RATYPE,"CN") D DUP^RAREG1
. ;--- Get the next free case number and store it
. F RAJ=RAX+1:1 I '$D(^RADPT("AE",RAJ)) D Q
. . S $P(^RA(79.2,RATYPE,"CN"),U)=RAJ
. ;--- If the next free case number for future use is
. ;--- greater than 99999,then recalculate again
. D:^RA(79.2,RATYPE,"CN")>99999 CAL^RAREG1
D UNLOCKFM^RALOCK(.RALOCK)
;---
Q RAX
;
;+++++ DOUBLE CHECKS AND LOCKS THE EXAM DATE/TIME
;
; RADFN Patient IEN (DFN)
;
; .RADTE Reference to a local variable that stores the date
; of the exam (FileMan).
;
; NOTE: The $$LOCKDT function can slightly change
; the exam date/time. The new value is returned
; in this parameter.
;
; [.RALOCK] Reference to a local variable where identifiers
; of the locked exam date/time node are added to.
;
; [FLAGS] Flags that control the execution (can be combined).
; See description of the flags "A" and "D" in the
; source code of the ^RAMAG routine.
;
; Return values:
; <0 Error descriptor (see $$ERROR^RAERR)
; 0 Success
;
LOCKDT(RADFN,RADTE,RALOCK,FLAGS) ;
N EXAMSET,IENS,ORIGDATE,RADTI,RAI,RAIENS,RAMSG,RARC,RAROOT,TMP
S ORIGDATE=RADTE\1,RADTI=$$INVDTE^RAMAGU04(RADTE)
S RAIENS=","_RADFN_",",RAROOT=$$ROOT^DILFD(70.02,RAIENS,1)
S FLAGS=$G(FLAGS),RARC=0
;
;=== Lock the whole REGISTERED EXAMS multiple
K TMP S TMP(70.02,RAIENS)=""
S RARC=$$LOCKFM^RALOCK(.TMP)
Q:RARC $$LOCKERR^RAERR(RARC,"patient's exams")
M RALOCK=TMP
;
D
. ;--- Setup the error handler
. N $ESTACK,$ETRAP D SETDEFEH^RAERR("RARC")
. ;--- Check if the patient already has exam(s) for this date/time
. I '$D(@RAROOT@(RADTI)) S RARC=0 D Q:RARC<0
. . ;--- Check for a 'subset' date
. . F RAI=1:1:10 D Q:RARC
. . . S TMP=$O(@RAROOT@("B",RADTE))
. . . I TMP'[RADTE,$P(RADTE,".",2),'$D(@RAROOT@(RADTI)) S RARC=1 Q
. . . ;--- Slightly modify the exam date/time
. . . S RADTE=$$FMADD^XLFDT(RADTE,,,1) ; Add 1 minute
. . . S RADTI=$$INVDTE^RAMAGU04(RADTE)
. . ;--- Too many registered exams at almost the same date/time
. . S:'RARC RARC=$$ERROR^RAERR(-29)
. E I $TR(FLAGS,"AD")=FLAGS D Q
. . ;--- By default, neither add to existing cases nor modify time
. . S RARC=$$ERROR^RAERR(-28,,$$FMTE^XLFDT(RADTE))
. E S RARC=0 D Q:RARC<0
. . F D Q:RARC Q:'$D(@RAROOT@(RADTI))
. . . ;--- Check if the existing date/time record stores an exam set
. . . S IENS=RADTI_RAIENS
. . . S EXAMSET=+$$GET1^DIQ(70.02,IENS,5,"I",,"RAMSG") ; EXAM SET
. . . I $G(DIERR) S RARC=$$DBS^RAERR("RAMSG",-9,70.02,IENS) Q
. . . I 'EXAMSET,FLAGS["A" S RARC=1 Q
. . . I EXAMSET,FLAGS'["D" S RARC=$$ERROR^RAERR(-54) Q
. . . ;--- Never add a case to an exam set implicitly; modify the
. . . ; date/time of the new case instead. Also, check for
. . . ;--- 'subset' dates. Make sure that the time part is there.
. . . F D Q:(TMP'[RADTE)&$P(RADTE,".",2)
. . . . ;--- Add 1 minute to the exam date/time
. . . . S RADTE=$$FMADD^XLFDT(RADTE,,,1) ; Add 1 minute
. . . . S RADTI=$$INVDTE^RAMAGU04(RADTE)
. . . . S TMP=$O(@RAROOT@("B",RADTE))
. . . ;--- Check if the date is still the same
. . . S:(RADTE\1)'=ORIGDATE RARC=$$ERROR^RAERR(-29)
. ;--- Lock the date/time in the REGISTERED EXAMS multiple
. K TMP S TMP(70.02,RADTI_RAIENS)=""
. S RARC=$$LOCKFM^RALOCK(.TMP)
. I RARC S RARC=$$LOCKERR^RAERR(RARC,"exam date/time") Q
. M RALOCK=TMP
;
;=== Unlock the REGISTERED EXAMS multiple
D UNLOCKFM^RALOCK(70.02,RAIENS)
K RALOCK(70.02,RAIENS)
;===
Q $S(RARC<0:RARC,1:0)
;
;+++++ DISCARDS THE CHANGES IN CASE OF ERROR(S)
;
; RADFN IEN of the patient
;
; RADTI "Inverted" date/time of registered exam(s)
;
; Input variables:
; ^TMP($J,"RAREG1",...)
;
ROLLBACK(RADFN,RADTI) ;
N DA,DIK,RACASE,RAFDA,RAI,RAIENS,RAMSG,RAOIFN,RAOLST,TMP
;
;=== Delete incomplete exams
S RAI=0
F S RAI=$O(^TMP($J,"RAREG1",RAI)) Q:RAI'>0 D
. S RACASE=^TMP($J,"RAREG1",RAI)
. S RAIENS=$$EXAMIENS^RAMAGU04(RACASE)
. ;--- Delete the Nuclear Medicine data
. K DA,DIK
. S DA=$$GET1^DIQ(70.03,RAIENS,500,"I",,"RAMSG")
. I DA>0 S DIK="^RADPTN(" D ^DIK
. ;--- Delete the incomplete record
. K DA,DIK
. D DA^DILF(RAIENS,.DA)
. S DIK=$$ROOT^DILFD(70.03,","_DA(1)_","_DA(2)_",")
. D ^DIK
. ;--- Restore order status to "pending"
. S RAOIFN=+$P(RACASE,U,4)
. I RAOIFN>0,'$D(RAOLST(RAOIFN)) S RAOLST(RAOIFN)="" D
. . S TMP=$$OSTRLBCK^RAMAGU02(RAOIFN,5)
. ;--- Remove the reference from the list
. K ^TMP($J,"RAREG1",RAI)
;
;=== Delete incomplete date/time record
I RADFN>0,RADTI>0 D
. ;--- Check if the EXAMINATIONS multiple is not empty
. S TMP=$$ROOT^DILFD(70.03,","_RADTI_","_RADFN_",",1)
. Q:$O(@TMP@(0))>0
. ;--- Delete record from the REGISTERED EXAMS multiple
. K DA,DIK
. S DIK=$$ROOT^DILFD(70.02,","_RADFN_",")
. S DA=RADTI,DA(1)=RADFN D ^DIK
;
;===
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAMAG03D 6486 printed Sep 23, 2025@20:12:55 Page 2
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
+2 ;
+3 QUIT
+4 ;
+5 ;***** GENERATES NEW CASE NUMBER
+6 ;
+7 ; RADTE Date of the exam (FileMan)
+8 ;
+9 ; [RATYPE] IEN of the imaging type (file #79.2).
+10 ;
+11 ; Currently, the Radiology package always uses
+12 ; IEN of the "GENERAL RADIOLOGY" record. This API
+13 ; does the same if the RATYPE parameter is not
+14 ; defined or not greater than 0.
+15 ;
+16 ; Return Values:
+17 ; <0 Error descriptor (see $$ERROR^RAERR)
+18 ; >0 Case number (1-99999)
+19 ;
CASENUM(RADTE,RATYPE) ;
+1 NEW %H,%T,%Y,RADTE99,RAII,RAJ,RALOCK,RAX,RAXX,RC,TMP,X,X1,X2
+2 if $GET(RADTE)'>0
QUIT $$IPVE^RAERR("RADTE")
+3 ;--- Get the default imaging type
+4 IF $GET(RATYPE)'>0
Begin DoDot:1
+5 SET RATYPE=+$ORDER(^RA(79.2,"B","GENERAL RADIOLOGY",0))
End DoDot:1
if '$DATA(^RA(79.2,RATYPE,0))
QUIT $$ERROR^RAERR(-36)
+6 ;---
+7 ; "CN" node
KILL TMP
SET TMP(79.2,RATYPE_",",25)=""
+8 SET RC=$$LOCKFM^RALOCK(.TMP)
+9 if RC
QUIT $$LOCKERR^RAERR(RC,"next case number")
+10 MERGE RALOCK=TMP
+11 Begin DoDot:1
+12 SET X=$GET(^RA(79.2,RATYPE,"CN"))
+13 if (DT>$PIECE(X,U,2))!(X>99999)
DO CAL^RAREG1
+14 ;--- Double check that the number is not used
+15 SET RAX=+^RA(79.2,RATYPE,"CN")
DO DUP^RAREG1
+16 ;--- Recalculate if DUP returned a value bigger than 99999
+17 IF RAX>99999
Begin DoDot:2
+18 DO CAL^RAREG1
SET RAX=+^RA(79.2,RATYPE,"CN")
DO DUP^RAREG1
End DoDot:2
IF RAX>99999
SET RAX=$$ERROR^RAERR(-37)
QUIT
+19 ;--- Get the next free case number and store it
+20 FOR RAJ=RAX+1:1
IF '$DATA(^RADPT("AE",RAJ))
Begin DoDot:2
+21 SET $PIECE(^RA(79.2,RATYPE,"CN"),U)=RAJ
End DoDot:2
QUIT
+22 ;--- If the next free case number for future use is
+23 ;--- greater than 99999,then recalculate again
+24 if ^RA(79.2,RATYPE,"CN")>99999
DO CAL^RAREG1
End DoDot:1
+25 DO UNLOCKFM^RALOCK(.RALOCK)
+26 ;---
+27 QUIT RAX
+28 ;
+29 ;+++++ DOUBLE CHECKS AND LOCKS THE EXAM DATE/TIME
+30 ;
+31 ; RADFN Patient IEN (DFN)
+32 ;
+33 ; .RADTE Reference to a local variable that stores the date
+34 ; of the exam (FileMan).
+35 ;
+36 ; NOTE: The $$LOCKDT function can slightly change
+37 ; the exam date/time. The new value is returned
+38 ; in this parameter.
+39 ;
+40 ; [.RALOCK] Reference to a local variable where identifiers
+41 ; of the locked exam date/time node are added to.
+42 ;
+43 ; [FLAGS] Flags that control the execution (can be combined).
+44 ; See description of the flags "A" and "D" in the
+45 ; source code of the ^RAMAG routine.
+46 ;
+47 ; Return values:
+48 ; <0 Error descriptor (see $$ERROR^RAERR)
+49 ; 0 Success
+50 ;
LOCKDT(RADFN,RADTE,RALOCK,FLAGS) ;
+1 NEW EXAMSET,IENS,ORIGDATE,RADTI,RAI,RAIENS,RAMSG,RARC,RAROOT,TMP
+2 SET ORIGDATE=RADTE\1
SET RADTI=$$INVDTE^RAMAGU04(RADTE)
+3 SET RAIENS=","_RADFN_","
SET RAROOT=$$ROOT^DILFD(70.02,RAIENS,1)
+4 SET FLAGS=$GET(FLAGS)
SET RARC=0
+5 ;
+6 ;=== Lock the whole REGISTERED EXAMS multiple
+7 KILL TMP
SET TMP(70.02,RAIENS)=""
+8 SET RARC=$$LOCKFM^RALOCK(.TMP)
+9 if RARC
QUIT $$LOCKERR^RAERR(RARC,"patient's exams")
+10 MERGE RALOCK=TMP
+11 ;
+12 Begin DoDot:1
+13 ;--- Setup the error handler
+14 NEW $ESTACK,$ETRAP
DO SETDEFEH^RAERR("RARC")
+15 ;--- Check if the patient already has exam(s) for this date/time
+16 IF '$DATA(@RAROOT@(RADTI))
SET RARC=0
Begin DoDot:2
+17 ;--- Check for a 'subset' date
+18 FOR RAI=1:1:10
Begin DoDot:3
+19 SET TMP=$ORDER(@RAROOT@("B",RADTE))
+20 IF TMP'[RADTE
IF $PIECE(RADTE,".",2)
IF '$DATA(@RAROOT@(RADTI))
SET RARC=1
QUIT
+21 ;--- Slightly modify the exam date/time
+22 ; Add 1 minute
SET RADTE=$$FMADD^XLFDT(RADTE,,,1)
+23 SET RADTI=$$INVDTE^RAMAGU04(RADTE)
End DoDot:3
if RARC
QUIT
+24 ;--- Too many registered exams at almost the same date/time
+25 if 'RARC
SET RARC=$$ERROR^RAERR(-29)
End DoDot:2
if RARC<0
QUIT
+26 IF '$TEST
IF $TRANSLATE(FLAGS,"AD")=FLAGS
Begin DoDot:2
+27 ;--- By default, neither add to existing cases nor modify time
+28 SET RARC=$$ERROR^RAERR(-28,,$$FMTE^XLFDT(RADTE))
End DoDot:2
QUIT
+29 IF '$TEST
SET RARC=0
Begin DoDot:2
+30 FOR
Begin DoDot:3
+31 ;--- Check if the existing date/time record stores an exam set
+32 SET IENS=RADTI_RAIENS
+33 ; EXAM SET
SET EXAMSET=+$$GET1^DIQ(70.02,IENS,5,"I",,"RAMSG")
+34 IF $GET(DIERR)
SET RARC=$$DBS^RAERR("RAMSG",-9,70.02,IENS)
QUIT
+35 IF 'EXAMSET
IF FLAGS["A"
SET RARC=1
QUIT
+36 IF EXAMSET
IF FLAGS'["D"
SET RARC=$$ERROR^RAERR(-54)
QUIT
+37 ;--- Never add a case to an exam set implicitly; modify the
+38 ; date/time of the new case instead. Also, check for
+39 ;--- 'subset' dates. Make sure that the time part is there.
+40 FOR
Begin DoDot:4
+41 ;--- Add 1 minute to the exam date/time
+42 ; Add 1 minute
SET RADTE=$$FMADD^XLFDT(RADTE,,,1)
+43 SET RADTI=$$INVDTE^RAMAGU04(RADTE)
+44 SET TMP=$ORDER(@RAROOT@("B",RADTE))
End DoDot:4
if (TMP'[RADTE)&$PIECE(RADTE,".",2)
QUIT
+45 ;--- Check if the date is still the same
+46 if (RADTE\1)'=ORIGDATE
SET RARC=$$ERROR^RAERR(-29)
End DoDot:3
if RARC
QUIT
if '$DATA(@RAROOT@(RADTI))
QUIT
End DoDot:2
if RARC<0
QUIT
+47 ;--- Lock the date/time in the REGISTERED EXAMS multiple
+48 KILL TMP
SET TMP(70.02,RADTI_RAIENS)=""
+49 SET RARC=$$LOCKFM^RALOCK(.TMP)
+50 IF RARC
SET RARC=$$LOCKERR^RAERR(RARC,"exam date/time")
QUIT
+51 MERGE RALOCK=TMP
End DoDot:1
+52 ;
+53 ;=== Unlock the REGISTERED EXAMS multiple
+54 DO UNLOCKFM^RALOCK(70.02,RAIENS)
+55 KILL RALOCK(70.02,RAIENS)
+56 ;===
+57 QUIT $SELECT(RARC<0:RARC,1:0)
+58 ;
+59 ;+++++ DISCARDS THE CHANGES IN CASE OF ERROR(S)
+60 ;
+61 ; RADFN IEN of the patient
+62 ;
+63 ; RADTI "Inverted" date/time of registered exam(s)
+64 ;
+65 ; Input variables:
+66 ; ^TMP($J,"RAREG1",...)
+67 ;
ROLLBACK(RADFN,RADTI) ;
+1 NEW DA,DIK,RACASE,RAFDA,RAI,RAIENS,RAMSG,RAOIFN,RAOLST,TMP
+2 ;
+3 ;=== Delete incomplete exams
+4 SET RAI=0
+5 FOR
SET RAI=$ORDER(^TMP($JOB,"RAREG1",RAI))
if RAI'>0
QUIT
Begin DoDot:1
+6 SET RACASE=^TMP($JOB,"RAREG1",RAI)
+7 SET RAIENS=$$EXAMIENS^RAMAGU04(RACASE)
+8 ;--- Delete the Nuclear Medicine data
+9 KILL DA,DIK
+10 SET DA=$$GET1^DIQ(70.03,RAIENS,500,"I",,"RAMSG")
+11 IF DA>0
SET DIK="^RADPTN("
DO ^DIK
+12 ;--- Delete the incomplete record
+13 KILL DA,DIK
+14 DO DA^DILF(RAIENS,.DA)
+15 SET DIK=$$ROOT^DILFD(70.03,","_DA(1)_","_DA(2)_",")
+16 DO ^DIK
+17 ;--- Restore order status to "pending"
+18 SET RAOIFN=+$PIECE(RACASE,U,4)
+19 IF RAOIFN>0
IF '$DATA(RAOLST(RAOIFN))
SET RAOLST(RAOIFN)=""
Begin DoDot:2
+20 SET TMP=$$OSTRLBCK^RAMAGU02(RAOIFN,5)
End DoDot:2
+21 ;--- Remove the reference from the list
+22 KILL ^TMP($JOB,"RAREG1",RAI)
End DoDot:1
+23 ;
+24 ;=== Delete incomplete date/time record
+25 IF RADFN>0
IF RADTI>0
Begin DoDot:1
+26 ;--- Check if the EXAMINATIONS multiple is not empty
+27 SET TMP=$$ROOT^DILFD(70.03,","_RADTI_","_RADFN_",",1)
+28 if $ORDER(@TMP@(0))>0
QUIT
+29 ;--- Delete record from the REGISTERED EXAMS multiple
+30 KILL DA,DIK
+31 SET DIK=$$ROOT^DILFD(70.02,","_RADFN_",")
+32 SET DA=RADTI
SET DA(1)=RADFN
DO ^DIK
End DoDot:1
+33 ;
+34 ;===
+35 QUIT
