RAMAG06 ;HCIOFO/SG - ORDERS/EXAMS API (EXAM COMPLETION) ; 3/6/09 4:20pm
;;5.0;Radiology/Nuclear Medicine;**90**;Mar 16, 1998;Build 20
;
Q
;
;##### COMPLETES THE EXAM
;
; .RAPARAMS Reference to the API descriptor
; (see the ^RA01 routine for details)
;
; RACASE Exam/case identifiers
; ^01: IEN of the patient in the file #70 (RADFN)
; ^02: IEN in the REGISTERED EXAMS multiple (RADTI)
; ^03: IEN in the EXAMINATIONS multiple (RACNI)
;
; [.RAMISC] Reference to a local array containing miscellaneous
; exam parameters.
;
; See the ^RAMAG routine for additional important
; details regarding this parameter.
;
; RAMISC(
;
; "ACLHIST", Text for the ADDITIONAL CLINICAL HISTORY field
; Seq#) (400) of the RAD/NUC MED REPORTS file (#74).
; Required: No
; Default: undefined
;
; "FLAGS") Flags that control the execution (see the ^RAMAG
; routine for details). Supported flags: "F", "S".
; Required: No
; Default: undefined
;
; "IMPRESSION", Text for the IMPRESSION TEXT field (300) of the
; Seq#) file #74.
; Required: Site and/or imaging type specific
; Default: undefined
;
; "PROBSTAT") Free text value for the PROBLEM STATEMENT field
; (25) of the file #74. If this parameter is defined
; and not empty (space characters are not counted),
; then the PROBLEM DRAFT status is assigned to the
; report.
; Required: No
; Default: undefined
;
; "REPORT", Text for the REPORT TEXT field (200)
; Seq#) of the file #74.
; Required: Yes
; Default: undefined
;
; "RPTDTE") Internal date value (FileMan) for the REPORTED
; DATE field (8) of the file #74. The date must be
; exact. If time is provided, it is ignored.
; Required: Yes
; Default: undefined
;
; "RPTSTATUS") Internal value for the REPORT STATUS field (5) of
; the file #74. Currently, only "V" (Verified) and
; "EF" (Electronically Filed) codes are supported.
; Required: Yes
; Default: "V"
;
; "TRANSCRST") Internal value for the TRANSCRIPTIONIST field (11)
; of the file #74: IEN in the NEW PERSON file (#200).
; Required: No
; Default: undefined
;
; "VERDTE") Internal date value (FileMan) for the VERIFIED DATE
; field (7) of the file #74. The date must be exact.
; Required: No
; Default: undefined
;
; "VERPHYS") Internal value for the VERIFYING PHYSICIAN field
; (9) of the file #74: IEN in the NEW PERSON file
; (#200).
; Required: No
; Default: undefined
;
; "BEDSECT") If any of these optional parameters are defined,
; "CMUSED") their values replace the existing ones assigned
; "COMPLICAT") by the $$REGISTER^RAMAG03 and $$EXAMINED^RAMAG07.
; "CONTMEDIA",#)
; "CPTMODS",#)
; "EXAMCAT")
; "FILMSIZE",#)
; "PRIMCAM")
; "PRIMDXCODE")
; "PRIMINTRES")
; "PRIMINTSTF")
; "PRINCLIN")
; "RDPHARMS",#,"RDPH-...")
; "SERVICE")
; "TECH",#)
; "TECHCOMM")
; "WARD")
;
; Return values:
; <0 Error descriptor (see $$ERROR^RAERR)
; 0 Exam has been completed
;
COMPLETE(RAPARAMS,RACASE,RAMISC) ;
N RACN ; Case number
N RACNI ; IEN of the exam in the EXAMINATIONS multiple
N RADFN ; IEN of the patient in the file #70
N RADTE ; Date/time of the exam
N RADTI ; Inverted date/time of the exam
N RAIENS ; IENS of the exam record
N RAIMGTYI ; Imaging type IEN (file #79.2)
N RAMSPSDEFS ; Data for miscellaneous parameters validation
N RANMDIEN ; IEN of the nuclear medicine data (file #70.2)
N RAOIFN ; IEN of the order (file #75.1)
N RAPROCIEN ; Radiology procedure IEN
N RPTIEN ; IEN of the report (file #74)
;
N RACTION,RALOCK,RAMSG,RAPOST,RAPRIEN,RARC,RARCP,RATRKCMB,TMP
D:$G(RAPARAMS("DEBUG"))>1
. D W^RAMAGU11("$$COMPLETE^RAMAG06","!!")
. D VARS^RAMAGU11("RACASE")
. D ZW^RAUTL22("RAMISC")
S (RARC,RARCP)=0
;
;--- Validate case identifiers
S RARC=$$CHKREQ^RAUTL22("RACASE") Q:RARC<0 RARC
S RARC=$$CHKEXMID^RAMAGU04(RACASE) Q:RARC<0 RARC
S RADFN=$P(RACASE,U),RADTI=$P(RACASE,U,2),RACNI=$P(RACASE,U,3)
S RAIENS=$$EXAMIENS^RAMAGU04(RACASE)
;
;--- Get the order IEN
S RAOIFN=$$GET1^DIQ(70.03,RAIENS,11,"I",,"RAMSG")
Q:$G(DIERR) $$DBS^RAERR("RAMSG",-9,70.03,RAIENS)
Q:RAOIFN'>0 $$ERROR^RAERR(-19,,70.03,RAIENS,11)
;
;--- Create the report stub if necessary
S RPTIEN=$$RPTSTUB^RAMAGU12(RACASE,.RADTE,.RACN)
Q:RPTIEN<0 RPTIEN
;
;--- Lock affected objects
K TMP
S TMP(70.03,RAIENS)=""
S TMP(74,RPTIEN_",")=""
S TMP(75.1,RAOIFN_",")=""
S RARC=$$LOCKFM^RALOCK(.TMP)
Q:RARC $$LOCKERR^RAERR(RARC,"exam/order/report")
M RALOCK=TMP
;
D
. ;--- Setup the error handler
. N $ESTACK,$ETRAP D SETDEFEH^RAERR("RARC")
. ;
. ;--- Initialize variables
. N EXMST,RAFDA,RAFDAM
. D LDMSPRMS^RAMAGU01(.RAMSPSDEFS)
. S RACTION="EC"
. ;
. ;--- Load exam properties
. S RARC=$$EXAMVARS^RAMAGU04(RAIENS) Q:RARC<0
. ;
. ;--- Get descriptor of the desired exam status
. S EXMST=$$EXMSTINF^RAMAGU06("^^9",RAIMGTYI)
. I EXMST<0 S RARC=EXMST Q
. ;
. ;--- Validate general parameters
. S RARC=$$VAL70^RAMAGU08(RAIENS,+EXMST,.RACTION,.RAMISC,.RAFDAM)
. I RARC<0 S RARC=$$ERROR^RAERR(-11) Q
. Q:RACTION="" ;--- Exam already has requested status
. S RARC=$$VAL74^RAMAGU10(RPTIEN_",",RACTION,.RAMISC,.RAFDAM)
. I RARC<0 S RARC=$$ERROR^RAERR(-11) Q
. ;
. ;--- Nuclear medicine (including parameter validation)
. S RARC=$$NUCMED^RAMAG06A(RACASE,RACTION,.RAMISC,.RAFDAM) Q:RARC<0
. S RANMDIEN=RARC
. ;
. ;--- Pre-processing
. S RARC=$$EDTPRE^RAMAG06A(RACTION,.RATRKCMB,.RAPRIEN) Q:RARC<0
. K RAFDAM("RACNT"),RAFDAM("RAIENS")
. ;
. ;--- Update the exam record
. K RAFDA,RAMSG M RAFDA(70.03)=RAFDAM(70.03) K RAFDAM(70.03)
. I $D(RAFDA)>1 D Q:RARC<0 S RAPOST=1
. . D FILE^DIE(,"RAFDA","RAMSG")
. . S:$G(DIERR) RARC=$$DBS^RAERR("RAMSG",-9,70.03,RAIENS)
. ;
. ;--- Update the nuclear medicine data
. K RAFDA,RAMSG M RAFDA(70.21)=RAFDAM(70.21) K RAFDAM(70.21)
. I $D(RAFDA)>1 D Q:RARC<0 S RAPOST=1
. . S RARC=$$UPDMULT^RAMAGU13(.RAFDA,RANMDIEN_",")
. ;
. ;--- Update the report record
. K RAFDA,RAMSG M RAFDA(74)=RAFDAM(74) K RAFDAM(74)
. I $D(RAFDA)>1 D Q:RARC<0 S RAPOST=1
. . D FILE^DIE(,"RAFDA","RAMSG")
. . S:$G(DIERR) RARC=$$DBS^RAERR("RAMSG",-9,74,RPTIEN_",")
. ;
. ;--- Update multiples of the exam record
. I $D(RAFDAM)>1 D Q:RARC<0 S RAPOST=1
. . S RARC=$$UPDMULT^RAMAGU13(.RAFDAM,RAIENS)
. ;
. ;--- Report status
. S TMP=$G(RAMISC("PROBSTAT"))
. S RARC=$$UPDRPTST^RAMAGU12(RPTIEN,$G(RAMISC("RPTSTATUS")),TMP)
. Q:RARC<0
. ;--- Exam status
. S TMP=$$TRFLAGS^RAUTL22($G(RAMISC("FLAGS")),"F","F")
. S RARC=$$UPDEXMST^RAMAGU05(RACASE,EXMST,TMP) Q:RARC<0
. ;--- Activity log
. S TMP=$G(RAMISC("TECHCOMM"))
. S RARC=$$UPDEXMAL^RAMAGU05(RACASE,"C",TMP)
;
;--- Post-processing is performed and notifications are sent if any
; changes to the case have been made (even if its status has not
;--- been changed to 'COMPLETE').
D:$G(RAPOST)
. N $ESTACK,$ETRAP
. D SETDEFEH^RAERR("RARCP")
. S RARCP=$$EDTPST^RAMAG06A(RACTION,RATRKCMB,.RAPRIEN)
;
;--- Error handling and cleanup
D UNLOCKFM^RALOCK(.RALOCK)
Q $S(RARC<0:RARC,RARCP<0:RARCP,1:0)
RAMAG06 ;HCIOFO/SG - ORDERS/EXAMS API (EXAM COMPLETION) ; 3/6/09 4:20pm
+1 ;;5.0;Radiology/Nuclear Medicine;**90**;Mar 16, 1998;Build 20
+2 ;
+3 QUIT
+4 ;
+5 ;##### COMPLETES THE EXAM
+6 ;
+7 ; .RAPARAMS Reference to the API descriptor
+8 ; (see the ^RA01 routine for details)
+9 ;
+10 ; RACASE Exam/case identifiers
+11 ; ^01: IEN of the patient in the file #70 (RADFN)
+12 ; ^02: IEN in the REGISTERED EXAMS multiple (RADTI)
+13 ; ^03: IEN in the EXAMINATIONS multiple (RACNI)
+14 ;
+15 ; [.RAMISC] Reference to a local array containing miscellaneous
+16 ; exam parameters.
+17 ;
+18 ; See the ^RAMAG routine for additional important
+19 ; details regarding this parameter.
+20 ;
+21 ; RAMISC(
+22 ;
+23 ; "ACLHIST", Text for the ADDITIONAL CLINICAL HISTORY field
+24 ; Seq#) (400) of the RAD/NUC MED REPORTS file (#74).
+25 ; Required: No
+26 ; Default: undefined
+27 ;
+28 ; "FLAGS") Flags that control the execution (see the ^RAMAG
+29 ; routine for details). Supported flags: "F", "S".
+30 ; Required: No
+31 ; Default: undefined
+32 ;
+33 ; "IMPRESSION", Text for the IMPRESSION TEXT field (300) of the
+34 ; Seq#) file #74.
+35 ; Required: Site and/or imaging type specific
+36 ; Default: undefined
+37 ;
+38 ; "PROBSTAT") Free text value for the PROBLEM STATEMENT field
+39 ; (25) of the file #74. If this parameter is defined
+40 ; and not empty (space characters are not counted),
+41 ; then the PROBLEM DRAFT status is assigned to the
+42 ; report.
+43 ; Required: No
+44 ; Default: undefined
+45 ;
+46 ; "REPORT", Text for the REPORT TEXT field (200)
+47 ; Seq#) of the file #74.
+48 ; Required: Yes
+49 ; Default: undefined
+50 ;
+51 ; "RPTDTE") Internal date value (FileMan) for the REPORTED
+52 ; DATE field (8) of the file #74. The date must be
+53 ; exact. If time is provided, it is ignored.
+54 ; Required: Yes
+55 ; Default: undefined
+56 ;
+57 ; "RPTSTATUS") Internal value for the REPORT STATUS field (5) of
+58 ; the file #74. Currently, only "V" (Verified) and
+59 ; "EF" (Electronically Filed) codes are supported.
+60 ; Required: Yes
+61 ; Default: "V"
+62 ;
+63 ; "TRANSCRST") Internal value for the TRANSCRIPTIONIST field (11)
+64 ; of the file #74: IEN in the NEW PERSON file (#200).
+65 ; Required: No
+66 ; Default: undefined
+67 ;
+68 ; "VERDTE") Internal date value (FileMan) for the VERIFIED DATE
+69 ; field (7) of the file #74. The date must be exact.
+70 ; Required: No
+71 ; Default: undefined
+72 ;
+73 ; "VERPHYS") Internal value for the VERIFYING PHYSICIAN field
+74 ; (9) of the file #74: IEN in the NEW PERSON file
+75 ; (#200).
+76 ; Required: No
+77 ; Default: undefined
+78 ;
+79 ; "BEDSECT") If any of these optional parameters are defined,
+80 ; "CMUSED") their values replace the existing ones assigned
+81 ; "COMPLICAT") by the $$REGISTER^RAMAG03 and $$EXAMINED^RAMAG07.
+82 ; "CONTMEDIA",#)
+83 ; "CPTMODS",#)
+84 ; "EXAMCAT")
+85 ; "FILMSIZE",#)
+86 ; "PRIMCAM")
+87 ; "PRIMDXCODE")
+88 ; "PRIMINTRES")
+89 ; "PRIMINTSTF")
+90 ; "PRINCLIN")
+91 ; "RDPHARMS",#,"RDPH-...")
+92 ; "SERVICE")
+93 ; "TECH",#)
+94 ; "TECHCOMM")
+95 ; "WARD")
+96 ;
+97 ; Return values:
+98 ; <0 Error descriptor (see $$ERROR^RAERR)
+99 ; 0 Exam has been completed
+100 ;
COMPLETE(RAPARAMS,RACASE,RAMISC) ;
+1 ; Case number
NEW RACN
+2 ; IEN of the exam in the EXAMINATIONS multiple
NEW RACNI
+3 ; IEN of the patient in the file #70
NEW RADFN
+4 ; Date/time of the exam
NEW RADTE
+5 ; Inverted date/time of the exam
NEW RADTI
+6 ; IENS of the exam record
NEW RAIENS
+7 ; Imaging type IEN (file #79.2)
NEW RAIMGTYI
+8 ; Data for miscellaneous parameters validation
NEW RAMSPSDEFS
+9 ; IEN of the nuclear medicine data (file #70.2)
NEW RANMDIEN
+10 ; IEN of the order (file #75.1)
NEW RAOIFN
+11 ; Radiology procedure IEN
NEW RAPROCIEN
+12 ; IEN of the report (file #74)
NEW RPTIEN
+13 ;
+14 NEW RACTION,RALOCK,RAMSG,RAPOST,RAPRIEN,RARC,RARCP,RATRKCMB,TMP
+15 IF $GET(RAPARAMS("DEBUG"))>1
Begin DoDot:1
+16 DO W^RAMAGU11("$$COMPLETE^RAMAG06","!!")
+17 DO VARS^RAMAGU11("RACASE")
+18 DO ZW^RAUTL22("RAMISC")
End DoDot:1
+19 SET (RARC,RARCP)=0
+20 ;
+21 ;--- Validate case identifiers
+22 SET RARC=$$CHKREQ^RAUTL22("RACASE")
IF RARC<0
QUIT RARC
+23 SET RARC=$$CHKEXMID^RAMAGU04(RACASE)
IF RARC<0
QUIT RARC
+24 SET RADFN=$PIECE(RACASE,U)
SET RADTI=$PIECE(RACASE,U,2)
SET RACNI=$PIECE(RACASE,U,3)
+25 SET RAIENS=$$EXAMIENS^RAMAGU04(RACASE)
+26 ;
+27 ;--- Get the order IEN
+28 SET RAOIFN=$$GET1^DIQ(70.03,RAIENS,11,"I",,"RAMSG")
+29 IF $GET(DIERR)
QUIT $$DBS^RAERR("RAMSG",-9,70.03,RAIENS)
+30 IF RAOIFN'>0
QUIT $$ERROR^RAERR(-19,,70.03,RAIENS,11)
+31 ;
+32 ;--- Create the report stub if necessary
+33 SET RPTIEN=$$RPTSTUB^RAMAGU12(RACASE,.RADTE,.RACN)
+34 IF RPTIEN<0
QUIT RPTIEN
+35 ;
+36 ;--- Lock affected objects
+37 KILL TMP
+38 SET TMP(70.03,RAIENS)=""
+39 SET TMP(74,RPTIEN_",")=""
+40 SET TMP(75.1,RAOIFN_",")=""
+41 SET RARC=$$LOCKFM^RALOCK(.TMP)
+42 IF RARC
QUIT $$LOCKERR^RAERR(RARC,"exam/order/report")
+43 MERGE RALOCK=TMP
+44 ;
+45 Begin DoDot:1
+46 ;--- Setup the error handler
+47 NEW $ESTACK,$ETRAP
DO SETDEFEH^RAERR("RARC")
+48 ;
+49 ;--- Initialize variables
+50 NEW EXMST,RAFDA,RAFDAM
+51 DO LDMSPRMS^RAMAGU01(.RAMSPSDEFS)
+52 SET RACTION="EC"
+53 ;
+54 ;--- Load exam properties
+55 SET RARC=$$EXAMVARS^RAMAGU04(RAIENS)
IF RARC<0
QUIT
+56 ;
+57 ;--- Get descriptor of the desired exam status
+58 SET EXMST=$$EXMSTINF^RAMAGU06("^^9",RAIMGTYI)
+59 IF EXMST<0
SET RARC=EXMST
QUIT
+60 ;
+61 ;--- Validate general parameters
+62 SET RARC=$$VAL70^RAMAGU08(RAIENS,+EXMST,.RACTION,.RAMISC,.RAFDAM)
+63 IF RARC<0
SET RARC=$$ERROR^RAERR(-11)
QUIT
+64 ;--- Exam already has requested status
IF RACTION=""
QUIT
+65 SET RARC=$$VAL74^RAMAGU10(RPTIEN_",",RACTION,.RAMISC,.RAFDAM)
+66 IF RARC<0
SET RARC=$$ERROR^RAERR(-11)
QUIT
+67 ;
+68 ;--- Nuclear medicine (including parameter validation)
+69 SET RARC=$$NUCMED^RAMAG06A(RACASE,RACTION,.RAMISC,.RAFDAM)
IF RARC<0
QUIT
+70 SET RANMDIEN=RARC
+71 ;
+72 ;--- Pre-processing
+73 SET RARC=$$EDTPRE^RAMAG06A(RACTION,.RATRKCMB,.RAPRIEN)
IF RARC<0
QUIT
+74 KILL RAFDAM("RACNT"),RAFDAM("RAIENS")
+75 ;
+76 ;--- Update the exam record
+77 KILL RAFDA,RAMSG
MERGE RAFDA(70.03)=RAFDAM(70.03)
KILL RAFDAM(70.03)
+78 IF $DATA(RAFDA)>1
Begin DoDot:2
+79 DO FILE^DIE(,"RAFDA","RAMSG")
+80 IF $GET(DIERR)
SET RARC=$$DBS^RAERR("RAMSG",-9,70.03,RAIENS)
End DoDot:2
IF RARC<0
QUIT
SET RAPOST=1
+81 ;
+82 ;--- Update the nuclear medicine data
+83 KILL RAFDA,RAMSG
MERGE RAFDA(70.21)=RAFDAM(70.21)
KILL RAFDAM(70.21)
+84 IF $DATA(RAFDA)>1
Begin DoDot:2
+85 SET RARC=$$UPDMULT^RAMAGU13(.RAFDA,RANMDIEN_",")
End DoDot:2
IF RARC<0
QUIT
SET RAPOST=1
+86 ;
+87 ;--- Update the report record
+88 KILL RAFDA,RAMSG
MERGE RAFDA(74)=RAFDAM(74)
KILL RAFDAM(74)
+89 IF $DATA(RAFDA)>1
Begin DoDot:2
+90 DO FILE^DIE(,"RAFDA","RAMSG")
+91 IF $GET(DIERR)
SET RARC=$$DBS^RAERR("RAMSG",-9,74,RPTIEN_",")
End DoDot:2
IF RARC<0
QUIT
SET RAPOST=1
+92 ;
+93 ;--- Update multiples of the exam record
+94 IF $DATA(RAFDAM)>1
Begin DoDot:2
+95 SET RARC=$$UPDMULT^RAMAGU13(.RAFDAM,RAIENS)
End DoDot:2
IF RARC<0
QUIT
SET RAPOST=1
+96 ;
+97 ;--- Report status
+98 SET TMP=$GET(RAMISC("PROBSTAT"))
+99 SET RARC=$$UPDRPTST^RAMAGU12(RPTIEN,$GET(RAMISC("RPTSTATUS")),TMP)
+100 IF RARC<0
QUIT
+101 ;--- Exam status
+102 SET TMP=$$TRFLAGS^RAUTL22($GET(RAMISC("FLAGS")),"F","F")
+103 SET RARC=$$UPDEXMST^RAMAGU05(RACASE,EXMST,TMP)
IF RARC<0
QUIT
+104 ;--- Activity log
+105 SET TMP=$GET(RAMISC("TECHCOMM"))
+106 SET RARC=$$UPDEXMAL^RAMAGU05(RACASE,"C",TMP)
End DoDot:1
+107 ;
+108 ;--- Post-processing is performed and notifications are sent if any
+109 ; changes to the case have been made (even if its status has not
+110 ;--- been changed to 'COMPLETE').
+111 IF $GET(RAPOST)
Begin DoDot:1
+112 NEW $ESTACK,$ETRAP
+113 DO SETDEFEH^RAERR("RARCP")
+114 SET RARCP=$$EDTPST^RAMAG06A(RACTION,RATRKCMB,.RAPRIEN)
End DoDot:1
+115 ;
+116 ;--- Error handling and cleanup
+117 DO UNLOCKFM^RALOCK(.RALOCK)
+118 QUIT $SELECT(RARC<0:RARC,RARCP<0:RARCP,1:0)
