- RAMAG06 ;HCIOFO/SG,GJC - ORDERS/EXAMS API (EXAM COMPLETION) ; 4/12/13 6:21pm
- ;;5.0;Radiology/Nuclear Medicine;**90,116**;Mar 16, 1998;Build 1
- ;
- 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-...")
- ; "SECDXCODE",#)
- ; "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)
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAMAG06 8161 printed Feb 19, 2025@00:03:09 Page 2
- RAMAG06 ;HCIOFO/SG,GJC - ORDERS/EXAMS API (EXAM COMPLETION) ; 4/12/13 6:21pm
- +1 ;;5.0;Radiology/Nuclear Medicine;**90,116**;Mar 16, 1998;Build 1
- +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 ; "SECDXCODE",#)
- +93 ; "SERVICE")
- +94 ; "TECH",#)
- +95 ; "TECHCOMM")
- +96 ; "WARD")
- +97 ;
- +98 ; Return values:
- +99 ; <0 Error descriptor (see $$ERROR^RAERR)
- +100 ; 0 Exam has been completed
- +101 ;
- 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)