ISIJRPT ; ISI/JHC - ISIRAD Report Entry functions ; 10/17/2022
;;1.1;ESL ISI IMAGING;**102,106,110**;Dec 21, 2022;Build 41
;; This routine is the property of ViTel Net, and should not be modified.
;; This software is a medical device and is subject to FDA regulation.
;; Modifications to this software may only be made under the terms of
;; 21CFR820 regulation. 21CFR Subpart A 820.1: "The failure to comply
;; with any applicable provision in this part renders a device
;; adulterated under section 501(h) of the act. Such a device,
;; as well as any person responsible for the failure to comply,
;; is subject to regulatory action."
; Reference to DAYCASE^MAGJUTL6 in ICR #7407
; Reference to File #2006.69 in ICR #7410
;
Q
;
ERR ;
N ERR S ERR=$$EC^%ZOSV S @MAGGRY@(0)="0^4~"_ERR
D @^%ZOSF("ERRTN")
Q:$Q 1 Q
;
; rpc ISIJ REPORT ENTER -- initialize report enter window
;
RPTOPEN(MAGGRY,PARAMS) ;
; PARAMS: TXID ^ CASEID [ | CASEID-2 | etc. ] -- (one or more Cases accepted for input)
; TXID: 0: View only; 1: EDIT report; 2: AMEND report
; CASEID: RADFN ^ RADTI ^ RACNI ^ RARPT ("normal" identifier for VistARad)
; Reply message:
; # Lines to follow (0-n) ^ Reply Code ~ Reply display text
; Reply Code- 0-Normal; 3-Abnormal; 4-Error
; Exams List:
; Text | Case ID | "Active" flag ^ DX Code flag ^ Required elements flag ^ Case # ^ CPT ^ Procedure
; Report data follows (for Amend pathway & Edit Draft pathways):
; *REPORT Start for REPORT
; (1:N lines of text follow)
; *REPORT_END End
; *IMPRESSION Start
; (1:N lines of text follow)
; *IMPRESSION_END end
; *DXCODE Start
; Code ^ Text (1:N lines of follow)
; *DXCODE_END end
;
;
N $ETRAP,$ESTACK S $ETRAP="D ERR^ISIJRPT"
N CASEID,DAYCASE,MAGLST,REPLY,TXID,PIPE
N RADFN,RADTI,RACNI,RARPT,RASTCAT,RASTORD,REQFLAGS,REQFLG
N ACTIVE,EDITFLAG,EXAMS,IEXAM,NEXAMS,PSETS,PSETCT
N LINECT,ICT,OUT,RPTSTAT,STATCT,GETRPT,TXTYPE
S LINECT=0,REPLY="",TXTYPE="",REQFLAGS=0
S PIPE="|"
S TXID=+PARAMS,RADFN=+$P(PARAMS,U,2),RADTI=$P(PARAMS,U,3),RACNI=+$P(PARAMS,U,4)
S MAGLST="ISIJRPC" S MAGGRY=$NA(^TMP($J,MAGLST)) K @MAGGRY
N DIQUIET S DIQUIET=1 D DT^DICRW
I RADFN,RADTI,RACNI,$D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) ; ICR 65
E S REPLY="0^4~Invalid Request; no Exam found for input data. ("_PARAMS_") errcode*1" G RPTOPENZ
;
; verify user type is valid for Editing a report
I +TXID D
. I +MAGJOB("USER",1)
. E S REPLY="0^4~Only a radiologist may edit a report. ("_PARAMS_") errcode*1a" G RPTOPENZ
;
; init array of exams to be processed
S EXAMS(1)="|"_$P($P(PARAMS,PIPE),U,2,5)
F IEXAM=2:1 S CASEID=$P(PARAMS,PIPE,IEXAM) Q:CASEID="" D I REPLY]"" G RPTOPENZ
. I +CASEID'=RADFN S REPLY="0^4~Invalid Request; multiple exams for different patients. ("_PARAMS_") errcode*2" Q
. S EXAMS(IEXAM)="|"_CASEID
S NEXAMS=IEXAM-1
;
I NEXAMS>1 D I REPLY]"" G RPTOPENZ
. I "^2^0^"[TXID S REPLY="0^4~Invalid Request; only one exam allowed for View or Amend. ("_PARAMS_") errcode*3" Q
;
; get all needed data for each exam
F IEXAM=1:1:NEXAMS S CASEID=$P(EXAMS(IEXAM),PIPE,2) D
. S $P(EXAMS(IEXAM),PIPE)=$$GETDATA^ISIJRPT2(.CASEID,0) ; caseid updated if rarpt not available w/ input caseid (Cat. "R" exams)
. S $P(EXAMS(IEXAM),PIPE,2)=CASEID
;
; EXAMS(n) = Exam_DATA | dfn^dti^cni^rarpt | ACTIVE_flag ^ EDIT_flag
; Exam_DATA:
; PrtSetCase# ^ PROC ^ DAYCASE ^ RASTNAM ^ CPT ^ MODIF ^ RASTCAT ^ RPT STATUS ^ DXCODE-IMPRESSION_FLAGS
;
; get rid of input "duplicate" pset exams, if any
I NEXAMS>1 D
. F IEXAM=1:1:NEXAMS S X=$P(EXAMS(IEXAM),PIPE),T=+X D:T
. . I $D(PSETS(T)) K EXAMS(IEXAM) S NEXAMS=NEXAMS-1 Q
. . S PSETS(T)=IEXAM
;
; get display data for printset members of "final" exams list
S IEXAM=0
F S IEXAM=$O(EXAMS(IEXAM)) Q:'IEXAM I +EXAMS(IEXAM) D ; printset member
. S PSETCT=0,EXAMS(IEXAM,PSETCT)=0
. S T=EXAMS(IEXAM)
. S DAYCASE=$P(T,U,3)
. S T=$P(EXAMS(IEXAM),PIPE,2)
. S RADFN=$P(T,U,1),RADTI=$P(T,U,2),RACNI=$P(T,U,3)
. S PSETS=$$DAYCASE^MAGJUTL6(RADFN,RADTI,RACNI) ; list of pset members' acns
. F I=1:1:$L(PSETS,U) S T=$P(PSETS,U,I) I T'=DAYCASE D ; n/a for starting case #
. . S X=$$DAYCASE3^MAGJUTL6(T) ; get caseid for this pset member
. . I +X S X=$$GETDATA^ISIJRPT2(X,1),PSETCT=PSETCT+1,EXAMS(IEXAM,PSETCT)=X,EXAMS(IEXAM,0)=PSETCT
;
; verify individual exams OK to proceed
S IEXAM=0,GETRPT=0
F S IEXAM=$O(EXAMS(IEXAM)) Q:'IEXAM D I REPLY]"" G RPTOPENZ
. S X=$P(EXAMS(IEXAM),PIPE),CASEID=$P(EXAMS(IEXAM),PIPE,2)
. S RASTCAT=$P(X,U,7),RPTSTAT=$P(X,U,8),REQFLG=$P(X,U,9),DAYCASE=$P(X,U,3)
. ; 1st check if user has required locks
. D I REPLY]"" Q
. . N LOCKSTAT,LTYPE
. . S LOCKSTAT="",LTYPE=$S(RASTCAT="E":"Exam",1:"Report")
. . I +TXID S LOCKSTAT=$$LOCKCHK(CASEID,RASTCAT,DAYCASE)
. . I +LOCKSTAT!(RASTCAT="C"&'TXID) ; ok: Locked, or View a Complete report
. . E D Q ; got a problem
. . . I LOCKSTAT="" S REPLY="0^3~"_LTYPE_" not locked; no report entry/edit allowed. errcode*4"
. . . E S REPLY="0^3~"_LTYPE_" locked by "_LOCKSTAT_"; no report entry/edit allowed. errcode*4a"
. . ; verify Tx type and Exam Status lines up; set active/editflag values
. . S STATCT(RASTCAT)=$G(STATCT(RASTCAT))+1 ; count by status code
. . I RASTCAT="W" S REPLY="0^4~Report entry not supported for Exam Status WAITING. ("_PARAMS_") errcode*7" Q
. . I RASTCAT="E",(TXID=1) S ACTIVE=1,EDITFLAG=0,TXTYPE="New" Q
. . I RASTCAT="R",(TXID=1) S ACTIVE=1,EDITFLAG=0,TXTYPE="New" Q
. . I RASTCAT="I",(TXID=1) S ACTIVE=1,EDITFLAG=$S(RPTSTAT="":0,1:1),TXTYPE=$S(EDITFLAG:"Edit",1:"New") Q ; assume for "I": no rpt, or D/PD/R rpt
. . I RASTCAT="C",'TXID S ACTIVE=-1,EDITFLAG=3,TXTYPE="View" Q ; view only
. . I RASTCAT="C",(TXID=2) S ACTIVE=1,EDITFLAG=2,TXTYPE="Amend" Q ; amend report
. . S REPLY="0^4~Request ("_$S(TXID=1:"Edit",TXID=2:"Amend",1:"View")_") not supported for this Exam Status code ("_RASTCAT_"); no report entry/edit allowed. ("_PARAMS_") errcode*5" Q
. S $P(EXAMS(IEXAM),PIPE,3)=ACTIVE_U_EDITFLAG
. I EDITFLAG,'GETRPT S GETRPT=CASEID ; report text to return
. I REQFLAGS<11,+REQFLG S REQFLAGS=$S(REQFLG=11:11,REQFLAGS=REQFLG:REQFLG,1:REQFLAGS+REQFLG)
;
; verify: multiple exams OK, based on exam/report statuses
I NEXAMS>1 D I REPLY]"" G RPTOPENZ ; if mult exams, statuses must align acceptably
. S RASTCAT="" F I=0:1 S RASTCAT=$O(STATCT(RASTCAT)) Q:RASTCAT=""
. I I>1 S REPLY="0^4~Multiple exams with different statuses not allowed. ("_PARAMS_") errcode*6" Q
. I $D(STATCT("C")) S REPLY="0^4~Multiple exams with status COMPLETE not allowed. ("_PARAMS_") errcode*8" Q
. I $D(STATCT("E")) Q ; good to go
. I $D(STATCT("I")) D Q:REPLY]"" ; ok if Zero or 1 exam has a ~draft report
. . S IEXAM=0 N CT
. . F S IEXAM=$O(EXAMS(IEXAM)) Q:'IEXAM D I REPLY]"" Q ; allow if only 1 exam has a report (D/PD/R)
. . . S RPTSTAT=$P($P(EXAMS(IEXAM),PIPE),U,8),T=$S(RPTSTAT="":0,1:1),CT(T)=$G(CT(T))+1
. . . I $G(CT(1))>1 S REPLY="0^4~Multiple exams with unverified reports not allowed. ("_PARAMS_") errcode*9" Q
;
; assemble output lines
S IEXAM=0
F S IEXAM=$O(EXAMS(IEXAM)) Q:'IEXAM D
. S LINECT=LINECT+1,OUT(LINECT)=$$ONELINE(EXAMS(IEXAM),REQFLAGS)
. S PSETCT=+$G(EXAMS(IEXAM,0)) I PSETCT D ; printset members
. . F ICT=1:1:PSETCT D
. . . I ICT=1 S LINECT=LINECT+1,OUT(LINECT)=" Includes:"_PIPE_PIPE_0_U
. . . S LINECT=LINECT+1,OUT(LINECT)=$$ONELINE(EXAMS(IEXAM,ICT))
;
; get report text, if applicable
I GETRPT D I REPLY]"" G RPTOPENZ
. N ZJ D RPTSTAT^ISIJDCU1(.ZJ,GETRPT,LINECT)
. I $P($G(ZJ(0)),U)=-1 D Q:REPLY]""
. . S LINECT=0,REPLY="0^4~Error occurred: "_ZJ(0)_" ("_PARAMS_") errcode*10"
. I +ZJ(0) S LINECT=ZJ(0) K ZJ(0) M OUT=ZJ
;
RPTOPENZ ;
I REPLY="" M @MAGGRY=OUT S REPLY=LINECT_U_"0~Report entry results ("_TXTYPE_" report)"
S @MAGGRY@(0)=REPLY
Q
;
ONELINE(EXAM,REQFLAGS) ; Format output lines--details at rpc entry point
N X,LINE,T
N ACTIVE,EDITFLAG
S REQFLAGS=$G(REQFLAGS)
S T=$P(EXAM,PIPE,3),ACTIVE=+$P(T,U),EDITFLAG=$P(T,U,2)
S X=$P(EXAM,PIPE)
S LINE=$S(+ACTIVE:"",1:" ") ; indent text for non-active exam
I ACTIVE=-1 S ACTIVE=0 ; View-only not really active
S LINE=LINE_$P(X,U,3)_" ("_$P(X,U,4)_") "_$P(X,U,2) ; Acn, status, proc
S T=$P(X,U,6) I T]"" S LINE=LINE_" ("_$P(X,U,6)_")" ; modif
S T=$S(ACTIVE:$P(EXAM,PIPE,2),1:"") ; caseid string
S LINE=LINE_PIPE_T_PIPE ;
S LINE=LINE_+ACTIVE_U ; active flag
S LINE=LINE_REQFLAGS_U_EDITFLAG ; Dx Code/Impression required; "active" exam
I ACTIVE S LINE=LINE_U_$P(X,U,3)_U_$P(X,U,5)_U_$P(X,U,2) ; Acn, CPT, Proc
Q LINE
;
; rpc ISIJ LOCK REPORT -- lock protection for draft reports entry
;
RPTLOCK(MAGGRY,PARAMS) ; Lock or UNlock exams
; Locks done here are solely for exams in status "I" or "C"
; PARAMS: TXID ^ CASEID [ | CASEID-2 | etc. ] -- (one or more Cases accepted for LOCK)
; TXID: 1: Lock (1 or more OK); 0: Unlock (UNLOCK only one at a time)
; 11: Lock (1 or more OK); 10: Unlock ( ditto )
; * 11 & 10 apply only to Status Code "R" exams
; CASEID: RADFN ^ RADTI ^ RACNI ^ RARPT ("normal" identifier for VistARad)
; Reply message:
; Reply Code ~ Reply display text
; Reply Code: 0-Normal; 3-Abnormal; 4-Error
; Note re TXID=11--this locks exams of vistarad category "R", which normally
; have no images when initiating the report, and therefore no RARPT entry yet
; the pre-processing detects this state, and calls ^raric to create it
N $ETRAP,$ESTACK S $ETRAP="D ERR^ISIJRPT"
N CASEID,DAYCASE,MAGLST,REPLY,TXID,PIPE
N RADFN,RADTI,RACNI,RARPT,RASTCAT,RASTORD
N NLOCKS,ACTIVE,EDITFLAG,EXAMS,IEXAM,NEXAMS,PSETS,PSETCT
N LINECT,ICT,OUT,RPTSTAT,STATCT,GETRPT,LOCKED,CT
N CREATRPT,RCODE,LOCKEDEX
S PIPE="|"
S REPLY="",NLOCKS=0
S TXID=+PARAMS,RADFN=+$P(PARAMS,U,2),RADTI=$P(PARAMS,U,3),RACNI=+$P(PARAMS,U,4)
S MAGLST="ISIJRPC" S MAGGRY=$NA(^TMP($J,MAGLST)) K @MAGGRY
N DIQUIET S DIQUIET=1 D DT^DICRW
I RADFN,RADTI,RACNI,$D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) ; ICR 65
E S REPLY="4~Invalid Request; no Exam found for input data. ("_PARAMS_") errcode*19" G RPTLOCKZ
I TXID=0!(TXID=1)!(TXID=10)!(TXID=11)
E S REPLY="4~Invalid Request; unrecognized input txid. ("_PARAMS_") errcode*19b" G RPTLOCKZ
S RCODE=0 I TXID=10!(TXID=11) S RCODE=1 ; flag for Status Type "R" management, in case Ex Status not reliable
I TXID=0!(TXID=10) D I REPLY]"" G RPTLOCKZ
. S X=$P(PARAMS,PIPE,2) I X=""
. E S REPLY="4~Invalid Request; Unlock only one exam per request. ("_PARAMS_") errcode*20a" G RPTLOCKZ
;
; EXAMS array contents as described above, except pipe-piece 3 tracks Locks for: Report_Lev ^ Exam_lev
; init array of exams to be processed
S EXAMS(1)="|"_$P($P(PARAMS,PIPE),U,2,5)
F IEXAM=2:1 S CASEID=$P(PARAMS,PIPE,IEXAM) Q:CASEID="" D I REPLY]"" G RPTLOCKZ
. I +CASEID'=RADFN S REPLY="4~Invalid Request; multiple exams for different patients. ("_PARAMS_") errcode*21" Q
. S EXAMS(IEXAM)="|"_CASEID
S NEXAMS=IEXAM-1
;
; get all needed data for each exam; RARPT will be created if applicable, returned in caseid value
F IEXAM=1:1:NEXAMS S CASEID=$P(EXAMS(IEXAM),PIPE,2) D I REPLY]"" G RPTLOCKZ
. S RARPT=+$P(CASEID,U,4),CREATRPT=0
. I TXID=11,'RARPT S CREATRPT=1
. S X=$$GETDATA^ISIJRPT2(.CASEID,0,CREATRPT) ; 1--flag to create rarpt when needed; note .CaseId is updated when rarpt is created
. I $P(X,U)=-1 S REPLY="4~"_$P(X,U,2,99) Q ; error detected
. S $P(EXAMS(IEXAM),PIPE)=X,$P(EXAMS(IEXAM),PIPE,2)=CASEID ; store updated caseid in array
. I CREATRPT,(+$P(CASEID,U,4)) S T=$P(EXAMS(IEXAM),PIPE,3),$P(T,U,2)=1,$P(EXAMS(IEXAM),PIPE,3)=T ; exam lock was opened in getdata; save incase need to unlock if error
;
; process UNLOCKs here--only one exam per call allowed
I TXID=0!(TXID=10) D G RPTLOCKZ
. S CASEID=$P(EXAMS(1),PIPE,2),RARPT=$P(CASEID,U,4)
. I RARPT
. E S REPLY="4~Invalid Request; caseid string missing rarpt value. ("_PARAMS_") errcode*22a" Q
. S X=$P(EXAMS(1),PIPE),DAYCASE=$P(X,U,3),RASTCAT=$P(X,U,7)
. I "^I^C^"[RASTCAT D Q:REPLY]""
. . I TXID=0
. . E S REPLY="4~Invalid Request; Exam status must be 'Ready for Interp' for this unlock request. ("_PARAMS_") errcode*22c" Q
. I RASTCAT="R" D Q:REPLY]""
. . I TXID=10
. . E S REPLY="4~Invalid Request; Exam status must be Interpreted or Complete for this unlock request. ("_PARAMS_") errcode*22d" Q
. I $$LOCKCHK(CASEID,RASTCAT,DAYCASE) D Q
. . D UNLOCKRP^ISIJRPT2(RARPT) ; unlock report level
. . I +RCODE D UNLOCKEX^ISIJRPT2(CASEID) ; unlock exam level for "R" category exams
. . S REPLY="0~Exam unlocked."_"-"_RASTCAT_"-"
. E S REPLY="4~Invalid Request; exam/report was not locked by user. ("_PARAMS_"-"_RASTCAT_"-"_") errcode*22b"
;
; process lock request(s)
; get rid of input "duplicate" pset exams, if any
I NEXAMS>1 D
. F IEXAM=1:1:NEXAMS S X=$P(EXAMS(IEXAM),PIPE),T=+X D:T
. . I $D(PSETS(T)) K EXAMS(IEXAM) S NEXAMS=NEXAMS-1 Q
. . S PSETS(T)=IEXAM
;
; verify user type is valid for doing a lock
I +MAGJOB("USER",1)
E S REPLY="4~Only a radiologist may lock a report. ("_PARAMS_") errcode*21a" G RPTLOCKZ
;
; verify exam status is valid for doing a lock
S IEXAM=0
F S IEXAM=$O(EXAMS(IEXAM)) Q:'IEXAM D I REPLY]"" G RPTLOCKZ
. S X=$P(EXAMS(IEXAM),PIPE),RASTCAT=$P(X,U,7),RPTSTAT=$P(X,U,8)
. S T=$S(RPTSTAT="":0,1:1),CT(T)=$G(CT(T))+1
. I $G(CT(1))>1 S REPLY="4~Cannot lock multiple exams having unverified reports. ("_PARAMS_") errcode*23f" Q
. I RASTCAT]"",("^I^C^R^"[RASTCAT)
. E S REPLY="4~Invalid Report Lock request--exam status must be Complete, Ready for Interp, or Interpreted. ("_PARAMS_") errcode*23" Q
. I RASTCAT="R" D Q:REPLY]""
. . I TXID'=11 S REPLY="4~Invalid Report Lock request--Invalid TxID code for 'Ready for Interp' exam. ("_PARAMS_") errcode*23d" Q
. I TXID=11 D Q:REPLY]""
. . I RASTCAT'="R" S REPLY="4~Invalid Report Lock request--TxID code valid only for 'Ready for Interp' exams. ("_PARAMS_") errcode*23e" Q
. S STATCT(RASTCAT)=$G(STATCT(RASTCAT))+1
I $G(STATCT("C"))>1!($G(STATCT("C"))&($G(STATCT("I"))!$G(STATCT("R")))) D G RPTLOCKZ
. S REPLY="4~Invalid Report Lock request--Complete exam cannot be edited with another exam. ("_PARAMS_") errcode*23a" Q
I $G(STATCT("R"))&$G(STATCT("I")) D G RPTLOCKZ
. S REPLY="4~Invalid Report Lock request--Ready for Interp exam cannot be edited with another exam. ("_PARAMS_") errcode*23c" Q
;
; make sure not already locked by me
S IEXAM=0
F S IEXAM=$O(EXAMS(IEXAM)) Q:'IEXAM D I REPLY]"" G RPTLOCKZ
. S CASEID=$P(EXAMS(IEXAM),PIPE,2)
. S X=$P(EXAMS(IEXAM),PIPE),RASTCAT=$P(X,U,7),DAYCASE=$P(X,U,3)
. S T=$$LOCKCHK(CASEID,RASTCAT,DAYCASE) ; for Category "R" exams, we assume this (report) lock happened only if the Exam lock also succeeded
. I T S REPLY="4~Invalid Request; exam/report already locked by user. ("_PARAMS_"-"_RASTCAT_"-"_") errcode*23b"
;
; obtain locks for the active exams
S IEXAM=0
F S IEXAM=$O(EXAMS(IEXAM)) Q:'IEXAM D I REPLY]"" G RPTLOCKZ
. S CASEID=$P(EXAMS(IEXAM),PIPE,2),RARPT=$P(CASEID,U,4)
. I RCODE D Q:'LOCKEDEX
. . S X=$P(EXAMS(IEXAM),PIPE),RASTCAT=$P(X,U,7)
. . D LOCKEX(CASEID,RASTCAT,.LOCKEDEX) ; lock at exam level for Category "R" exams only
. . I LOCKEDEX
. . E S REPLY="3~Unable to lock exam for report entry/edit; try again later; code*24a." Q
. D LOCKRPT(RARPT,.LOCKED) ; ALL exams require report level lock
. I LOCKED S $P(EXAMS(IEXAM),PIPE,3)=1_U,NLOCKS=NLOCKS+1
. E D Q
. . I RCODE D UNLOCKEX^ISIJRPT2(CASEID) ; undo the exam lock
. . S REPLY="3~Unable to lock report for entry/edit; try again later; code*24b." Q
S REPLY="0~Report"_$S(NLOCKS>1:"s",1:"")_" locked for entry/edit."
;
RPTLOCKZ ;
I +REPLY>0 D ; clear up locks, if need be
. D UNLOCKEM^ISIJRPT2(RCODE,NLOCKS)
S @MAGGRY@(0)=REPLY
Q
;
LOCKRPT(RARPT,LOCKED) ; for input rarpt, return success/fail for lock attempt
S LOCKED=0
I 'RARPT
E D
. L +^RARPT(RARPT):2 ; this is sufficient to protect all printset members (both ISIRad and roll'n scroll)
. I D
. . S ^TMP("RAD LOCKS","ISI",$J,DUZ,"^RARPT(",RARPT)=$P($G(MAGJOB("USER",1)),U,3)
. . S LOCKED=1 ; success
. ;
Q
;
LOCKEX(CASEID,RASTCAT,LOCKED) ; for input caseid, return success/fail for lock attempt
; 1) Lock the Exam level--this will persist for the report entry session (protects Tech field update)
; Return: Lock successful 0/1
N RADFN,RADTI,RACNI
S LOCKED=0
I RASTCAT="R"
E S LOCKED=LOCKED_U_"Invalid exam status for 'R-category' exam lock operation. errcode*25a" Q
S RADFN=$P(CASEID,U),RADTI=$P(CASEID,U,2),RACNI=$P(CASEID,U,3)
L +^RADPT(RADFN,"DT",RADTI,"P",RACNI,0):2
I S LOCKED=1
E S LOCKED=0_U_"Unable to obtain exam lock; errcode*25c"
Q
;
LOCKCHK(CASEID,RASTCAT,DAYCASE) ; does current user have a lock?
; Return: 1=Locked by me; nil=not locked; INI[:R] or Text=Locked/Reserved by other
N OK,RARPT
S OK="",RARPT=$P(CASEID,U,4)
I RASTCAT="E" D ; Should have been locked by "normal" exam lock
. S X=$$CHKLOCK^MAGJLS2B(RARPT,DAYCASE)
. S OK=($P(X,U,2)=1) ; Exam locked by Client
. I 'OK S OK=$P(X,U) ; initials of other user, or nil
E I RASTCAT]"",("^I^C^R^"[RASTCAT) D ; lock would be the "report entry" lock per this module
. L +^RARPT(RARPT,"checklock"):0
. I D L -^RARPT(RARPT,"checklock")
. . I $D(^TMP("RAD LOCKS","ISI",$J,DUZ,"^RARPT(",RARPT)) S OK=1 ; locked by me
. . E S OK="" Q ; not locked
. E S OK="another user"
Q OK
;
READYINT(IMGTYP) ; "Ready for Interpretation" feature enabled? -- P106 enhancement
; --> If is enabled for input Type of Imaging, returns field # & data value to stuff into Exam Record
; current (perhaps only) user is RTT: called by ISIRAD03
;
N FIELD,FILE,REPLY,VALUE,X
S REPLY=""
S X=$P(^MAG(2006.69,1,"ISI"),U,7,8)
I +X=$G(IMGTYP) D ; does apply to this Imaging Type
. S X=$P(X,U,2)
. S VALUE=$P(X,";",1),FILE=$P(X,";",2)
. S FIELD=$S(FILE="RA(78.6,":18,1:"") ; <*> thus far, we only use #78.6 Camera/Equip/Rm
. I FIELD=""!(VALUE="") S REPLY="-1^Invalid 'Ready for Interpretation' setting in MAG VISTARAD SITE PARAMETERS file." Q
. S REPLY=FIELD_U_VALUE
Q:$Q REPLY Q
;
END ;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HISIJRPT 18431 printed Apr 09, 2024@21:46:31 Page 2
ISIJRPT ; ISI/JHC - ISIRAD Report Entry functions ; 10/17/2022
+1 ;;1.1;ESL ISI IMAGING;**102,106,110**;Dec 21, 2022;Build 41
+2 ;; This routine is the property of ViTel Net, and should not be modified.
+3 ;; This software is a medical device and is subject to FDA regulation.
+4 ;; Modifications to this software may only be made under the terms of
+5 ;; 21CFR820 regulation. 21CFR Subpart A 820.1: "The failure to comply
+6 ;; with any applicable provision in this part renders a device
+7 ;; adulterated under section 501(h) of the act. Such a device,
+8 ;; as well as any person responsible for the failure to comply,
+9 ;; is subject to regulatory action."
+10 ; Reference to DAYCASE^MAGJUTL6 in ICR #7407
+11 ; Reference to File #2006.69 in ICR #7410
+12 ;
+13 QUIT
+14 ;
ERR ;
+1 NEW ERR
SET ERR=$$EC^%ZOSV
SET @MAGGRY@(0)="0^4~"_ERR
+2 DO @^%ZOSF("ERRTN")
+3 if $QUIT
QUIT 1
QUIT
+4 ;
+5 ; rpc ISIJ REPORT ENTER -- initialize report enter window
+6 ;
RPTOPEN(MAGGRY,PARAMS) ;
+1 ; PARAMS: TXID ^ CASEID [ | CASEID-2 | etc. ] -- (one or more Cases accepted for input)
+2 ; TXID: 0: View only; 1: EDIT report; 2: AMEND report
+3 ; CASEID: RADFN ^ RADTI ^ RACNI ^ RARPT ("normal" identifier for VistARad)
+4 ; Reply message:
+5 ; # Lines to follow (0-n) ^ Reply Code ~ Reply display text
+6 ; Reply Code- 0-Normal; 3-Abnormal; 4-Error
+7 ; Exams List:
+8 ; Text | Case ID | "Active" flag ^ DX Code flag ^ Required elements flag ^ Case # ^ CPT ^ Procedure
+9 ; Report data follows (for Amend pathway & Edit Draft pathways):
+10 ; *REPORT Start for REPORT
+11 ; (1:N lines of text follow)
+12 ; *REPORT_END End
+13 ; *IMPRESSION Start
+14 ; (1:N lines of text follow)
+15 ; *IMPRESSION_END end
+16 ; *DXCODE Start
+17 ; Code ^ Text (1:N lines of follow)
+18 ; *DXCODE_END end
+19 ;
+20 ;
+21 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERR^ISIJRPT"
+22 NEW CASEID,DAYCASE,MAGLST,REPLY,TXID,PIPE
+23 NEW RADFN,RADTI,RACNI,RARPT,RASTCAT,RASTORD,REQFLAGS,REQFLG
+24 NEW ACTIVE,EDITFLAG,EXAMS,IEXAM,NEXAMS,PSETS,PSETCT
+25 NEW LINECT,ICT,OUT,RPTSTAT,STATCT,GETRPT,TXTYPE
+26 SET LINECT=0
SET REPLY=""
SET TXTYPE=""
SET REQFLAGS=0
+27 SET PIPE="|"
+28 SET TXID=+PARAMS
SET RADFN=+$PIECE(PARAMS,U,2)
SET RADTI=$PIECE(PARAMS,U,3)
SET RACNI=+$PIECE(PARAMS,U,4)
+29 SET MAGLST="ISIJRPC"
SET MAGGRY=$NAME(^TMP($JOB,MAGLST))
KILL @MAGGRY
+30 NEW DIQUIET
SET DIQUIET=1
DO DT^DICRW
+31 ; ICR 65
IF RADFN
IF RADTI
IF RACNI
IF $DATA(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
+32 IF '$TEST
SET REPLY="0^4~Invalid Request; no Exam found for input data. ("_PARAMS_") errcode*1"
GOTO RPTOPENZ
+33 ;
+34 ; verify user type is valid for Editing a report
+35 IF +TXID
Begin DoDot:1
+36 IF +MAGJOB("USER",1)
+37 IF '$TEST
SET REPLY="0^4~Only a radiologist may edit a report. ("_PARAMS_") errcode*1a"
GOTO RPTOPENZ
End DoDot:1
+38 ;
+39 ; init array of exams to be processed
+40 SET EXAMS(1)="|"_$PIECE($PIECE(PARAMS,PIPE),U,2,5)
+41 FOR IEXAM=2:1
SET CASEID=$PIECE(PARAMS,PIPE,IEXAM)
if CASEID=""
QUIT
Begin DoDot:1
+42 IF +CASEID'=RADFN
SET REPLY="0^4~Invalid Request; multiple exams for different patients. ("_PARAMS_") errcode*2"
QUIT
+43 SET EXAMS(IEXAM)="|"_CASEID
End DoDot:1
IF REPLY]""
GOTO RPTOPENZ
+44 SET NEXAMS=IEXAM-1
+45 ;
+46 IF NEXAMS>1
Begin DoDot:1
+47 IF "^2^0^"[TXID
SET REPLY="0^4~Invalid Request; only one exam allowed for View or Amend. ("_PARAMS_") errcode*3"
QUIT
End DoDot:1
IF REPLY]""
GOTO RPTOPENZ
+48 ;
+49 ; get all needed data for each exam
+50 FOR IEXAM=1:1:NEXAMS
SET CASEID=$PIECE(EXAMS(IEXAM),PIPE,2)
Begin DoDot:1
+51 ; caseid updated if rarpt not available w/ input caseid (Cat. "R" exams)
SET $PIECE(EXAMS(IEXAM),PIPE)=$$GETDATA^ISIJRPT2(.CASEID,0)
+52 SET $PIECE(EXAMS(IEXAM),PIPE,2)=CASEID
End DoDot:1
+53 ;
+54 ; EXAMS(n) = Exam_DATA | dfn^dti^cni^rarpt | ACTIVE_flag ^ EDIT_flag
+55 ; Exam_DATA:
+56 ; PrtSetCase# ^ PROC ^ DAYCASE ^ RASTNAM ^ CPT ^ MODIF ^ RASTCAT ^ RPT STATUS ^ DXCODE-IMPRESSION_FLAGS
+57 ;
+58 ; get rid of input "duplicate" pset exams, if any
+59 IF NEXAMS>1
Begin DoDot:1
+60 FOR IEXAM=1:1:NEXAMS
SET X=$PIECE(EXAMS(IEXAM),PIPE)
SET T=+X
if T
Begin DoDot:2
+61 IF $DATA(PSETS(T))
KILL EXAMS(IEXAM)
SET NEXAMS=NEXAMS-1
QUIT
+62 SET PSETS(T)=IEXAM
End DoDot:2
End DoDot:1
+63 ;
+64 ; get display data for printset members of "final" exams list
+65 SET IEXAM=0
+66 ; printset member
FOR
SET IEXAM=$ORDER(EXAMS(IEXAM))
if 'IEXAM
QUIT
IF +EXAMS(IEXAM)
Begin DoDot:1
+67 SET PSETCT=0
SET EXAMS(IEXAM,PSETCT)=0
+68 SET T=EXAMS(IEXAM)
+69 SET DAYCASE=$PIECE(T,U,3)
+70 SET T=$PIECE(EXAMS(IEXAM),PIPE,2)
+71 SET RADFN=$PIECE(T,U,1)
SET RADTI=$PIECE(T,U,2)
SET RACNI=$PIECE(T,U,3)
+72 ; list of pset members' acns
SET PSETS=$$DAYCASE^MAGJUTL6(RADFN,RADTI,RACNI)
+73 ; n/a for starting case #
FOR I=1:1:$LENGTH(PSETS,U)
SET T=$PIECE(PSETS,U,I)
IF T'=DAYCASE
Begin DoDot:2
+74 ; get caseid for this pset member
SET X=$$DAYCASE3^MAGJUTL6(T)
+75 IF +X
SET X=$$GETDATA^ISIJRPT2(X,1)
SET PSETCT=PSETCT+1
SET EXAMS(IEXAM,PSETCT)=X
SET EXAMS(IEXAM,0)=PSETCT
End DoDot:2
End DoDot:1
+76 ;
+77 ; verify individual exams OK to proceed
+78 SET IEXAM=0
SET GETRPT=0
+79 FOR
SET IEXAM=$ORDER(EXAMS(IEXAM))
if 'IEXAM
QUIT
Begin DoDot:1
+80 SET X=$PIECE(EXAMS(IEXAM),PIPE)
SET CASEID=$PIECE(EXAMS(IEXAM),PIPE,2)
+81 SET RASTCAT=$PIECE(X,U,7)
SET RPTSTAT=$PIECE(X,U,8)
SET REQFLG=$PIECE(X,U,9)
SET DAYCASE=$PIECE(X,U,3)
+82 ; 1st check if user has required locks
+83 Begin DoDot:2
+84 NEW LOCKSTAT,LTYPE
+85 SET LOCKSTAT=""
SET LTYPE=$SELECT(RASTCAT="E":"Exam",1:"Report")
+86 IF +TXID
SET LOCKSTAT=$$LOCKCHK(CASEID,RASTCAT,DAYCASE)
+87 ; ok: Locked, or View a Complete report
IF +LOCKSTAT!(RASTCAT="C"&'TXID)
+88 ; got a problem
IF '$TEST
Begin DoDot:3
+89 IF LOCKSTAT=""
SET REPLY="0^3~"_LTYPE_" not locked; no report entry/edit allowed. errcode*4"
+90 IF '$TEST
SET REPLY="0^3~"_LTYPE_" locked by "_LOCKSTAT_"; no report entry/edit allowed. errcode*4a"
End DoDot:3
QUIT
+91 ; verify Tx type and Exam Status lines up; set active/editflag values
+92 ; count by status code
SET STATCT(RASTCAT)=$GET(STATCT(RASTCAT))+1
+93 IF RASTCAT="W"
SET REPLY="0^4~Report entry not supported for Exam Status WAITING. ("_PARAMS_") errcode*7"
QUIT
+94 IF RASTCAT="E"
IF (TXID=1)
SET ACTIVE=1
SET EDITFLAG=0
SET TXTYPE="New"
QUIT
+95 IF RASTCAT="R"
IF (TXID=1)
SET ACTIVE=1
SET EDITFLAG=0
SET TXTYPE="New"
QUIT
+96 ; assume for "I": no rpt, or D/PD/R rpt
IF RASTCAT="I"
IF (TXID=1)
SET ACTIVE=1
SET EDITFLAG=$SELECT(RPTSTAT="":0,1:1)
SET TXTYPE=$SELECT(EDITFLAG:"Edit",1:"New")
QUIT
+97 ; view only
IF RASTCAT="C"
IF 'TXID
SET ACTIVE=-1
SET EDITFLAG=3
SET TXTYPE="View"
QUIT
+98 ; amend report
IF RASTCAT="C"
IF (TXID=2)
SET ACTIVE=1
SET EDITFLAG=2
SET TXTYPE="Amend"
QUIT
+99 SET REPLY="0^4~Request ("_$SELECT(TXID=1:"Edit",TXID=2:"Amend",1:"View")_") not supported for this Exam Status code ("_RASTCAT_"); no report entry/edit allowed. ("_PARAMS_") errcode*5"
QUIT
End DoDot:2
IF REPLY]""
QUIT
+100 SET $PIECE(EXAMS(IEXAM),PIPE,3)=ACTIVE_U_EDITFLAG
+101 ; report text to return
IF EDITFLAG
IF 'GETRPT
SET GETRPT=CASEID
+102 IF REQFLAGS<11
IF +REQFLG
SET REQFLAGS=$SELECT(REQFLG=11:11,REQFLAGS=REQFLG:REQFLG,1:REQFLAGS+REQFLG)
End DoDot:1
IF REPLY]""
GOTO RPTOPENZ
+103 ;
+104 ; verify: multiple exams OK, based on exam/report statuses
+105 ; if mult exams, statuses must align acceptably
IF NEXAMS>1
Begin DoDot:1
+106 SET RASTCAT=""
FOR I=0:1
SET RASTCAT=$ORDER(STATCT(RASTCAT))
if RASTCAT=""
QUIT
+107 IF I>1
SET REPLY="0^4~Multiple exams with different statuses not allowed. ("_PARAMS_") errcode*6"
QUIT
+108 IF $DATA(STATCT("C"))
SET REPLY="0^4~Multiple exams with status COMPLETE not allowed. ("_PARAMS_") errcode*8"
QUIT
+109 ; good to go
IF $DATA(STATCT("E"))
QUIT
+110 ; ok if Zero or 1 exam has a ~draft report
IF $DATA(STATCT("I"))
Begin DoDot:2
+111 SET IEXAM=0
NEW CT
+112 ; allow if only 1 exam has a report (D/PD/R)
FOR
SET IEXAM=$ORDER(EXAMS(IEXAM))
if 'IEXAM
QUIT
Begin DoDot:3
+113 SET RPTSTAT=$PIECE($PIECE(EXAMS(IEXAM),PIPE),U,8)
SET T=$SELECT(RPTSTAT="":0,1:1)
SET CT(T)=$GET(CT(T))+1
+114 IF $GET(CT(1))>1
SET REPLY="0^4~Multiple exams with unverified reports not allowed. ("_PARAMS_") errcode*9"
QUIT
End DoDot:3
IF REPLY]""
QUIT
End DoDot:2
if REPLY]""
QUIT
End DoDot:1
IF REPLY]""
GOTO RPTOPENZ
+115 ;
+116 ; assemble output lines
+117 SET IEXAM=0
+118 FOR
SET IEXAM=$ORDER(EXAMS(IEXAM))
if 'IEXAM
QUIT
Begin DoDot:1
+119 SET LINECT=LINECT+1
SET OUT(LINECT)=$$ONELINE(EXAMS(IEXAM),REQFLAGS)
+120 ; printset members
SET PSETCT=+$GET(EXAMS(IEXAM,0))
IF PSETCT
Begin DoDot:2
+121 FOR ICT=1:1:PSETCT
Begin DoDot:3
+122 IF ICT=1
SET LINECT=LINECT+1
SET OUT(LINECT)=" Includes:"_PIPE_PIPE_0_U
+123 SET LINECT=LINECT+1
SET OUT(LINECT)=$$ONELINE(EXAMS(IEXAM,ICT))
End DoDot:3
End DoDot:2
End DoDot:1
+124 ;
+125 ; get report text, if applicable
+126 IF GETRPT
Begin DoDot:1
+127 NEW ZJ
DO RPTSTAT^ISIJDCU1(.ZJ,GETRPT,LINECT)
+128 IF $PIECE($GET(ZJ(0)),U)=-1
Begin DoDot:2
+129 SET LINECT=0
SET REPLY="0^4~Error occurred: "_ZJ(0)_" ("_PARAMS_") errcode*10"
End DoDot:2
if REPLY]""
QUIT
+130 IF +ZJ(0)
SET LINECT=ZJ(0)
KILL ZJ(0)
MERGE OUT=ZJ
End DoDot:1
IF REPLY]""
GOTO RPTOPENZ
+131 ;
RPTOPENZ ;
+1 IF REPLY=""
MERGE @MAGGRY=OUT
SET REPLY=LINECT_U_"0~Report entry results ("_TXTYPE_" report)"
+2 SET @MAGGRY@(0)=REPLY
+3 QUIT
+4 ;
ONELINE(EXAM,REQFLAGS) ; Format output lines--details at rpc entry point
+1 NEW X,LINE,T
+2 NEW ACTIVE,EDITFLAG
+3 SET REQFLAGS=$GET(REQFLAGS)
+4 SET T=$PIECE(EXAM,PIPE,3)
SET ACTIVE=+$PIECE(T,U)
SET EDITFLAG=$PIECE(T,U,2)
+5 SET X=$PIECE(EXAM,PIPE)
+6 ; indent text for non-active exam
SET LINE=$SELECT(+ACTIVE:"",1:" ")
+7 ; View-only not really active
IF ACTIVE=-1
SET ACTIVE=0
+8 ; Acn, status, proc
SET LINE=LINE_$PIECE(X,U,3)_" ("_$PIECE(X,U,4)_") "_$PIECE(X,U,2)
+9 ; modif
SET T=$PIECE(X,U,6)
IF T]""
SET LINE=LINE_" ("_$PIECE(X,U,6)_")"
+10 ; caseid string
SET T=$SELECT(ACTIVE:$PIECE(EXAM,PIPE,2),1:"")
+11 ;
SET LINE=LINE_PIPE_T_PIPE
+12 ; active flag
SET LINE=LINE_+ACTIVE_U
+13 ; Dx Code/Impression required; "active" exam
SET LINE=LINE_REQFLAGS_U_EDITFLAG
+14 ; Acn, CPT, Proc
IF ACTIVE
SET LINE=LINE_U_$PIECE(X,U,3)_U_$PIECE(X,U,5)_U_$PIECE(X,U,2)
+15 QUIT LINE
+16 ;
+17 ; rpc ISIJ LOCK REPORT -- lock protection for draft reports entry
+18 ;
RPTLOCK(MAGGRY,PARAMS) ; Lock or UNlock exams
+1 ; Locks done here are solely for exams in status "I" or "C"
+2 ; PARAMS: TXID ^ CASEID [ | CASEID-2 | etc. ] -- (one or more Cases accepted for LOCK)
+3 ; TXID: 1: Lock (1 or more OK); 0: Unlock (UNLOCK only one at a time)
+4 ; 11: Lock (1 or more OK); 10: Unlock ( ditto )
+5 ; * 11 & 10 apply only to Status Code "R" exams
+6 ; CASEID: RADFN ^ RADTI ^ RACNI ^ RARPT ("normal" identifier for VistARad)
+7 ; Reply message:
+8 ; Reply Code ~ Reply display text
+9 ; Reply Code: 0-Normal; 3-Abnormal; 4-Error
+10 ; Note re TXID=11--this locks exams of vistarad category "R", which normally
+11 ; have no images when initiating the report, and therefore no RARPT entry yet
+12 ; the pre-processing detects this state, and calls ^raric to create it
+13 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERR^ISIJRPT"
+14 NEW CASEID,DAYCASE,MAGLST,REPLY,TXID,PIPE
+15 NEW RADFN,RADTI,RACNI,RARPT,RASTCAT,RASTORD
+16 NEW NLOCKS,ACTIVE,EDITFLAG,EXAMS,IEXAM,NEXAMS,PSETS,PSETCT
+17 NEW LINECT,ICT,OUT,RPTSTAT,STATCT,GETRPT,LOCKED,CT
+18 NEW CREATRPT,RCODE,LOCKEDEX
+19 SET PIPE="|"
+20 SET REPLY=""
SET NLOCKS=0
+21 SET TXID=+PARAMS
SET RADFN=+$PIECE(PARAMS,U,2)
SET RADTI=$PIECE(PARAMS,U,3)
SET RACNI=+$PIECE(PARAMS,U,4)
+22 SET MAGLST="ISIJRPC"
SET MAGGRY=$NAME(^TMP($JOB,MAGLST))
KILL @MAGGRY
+23 NEW DIQUIET
SET DIQUIET=1
DO DT^DICRW
+24 ; ICR 65
IF RADFN
IF RADTI
IF RACNI
IF $DATA(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
+25 IF '$TEST
SET REPLY="4~Invalid Request; no Exam found for input data. ("_PARAMS_") errcode*19"
GOTO RPTLOCKZ
+26 IF TXID=0!(TXID=1)!(TXID=10)!(TXID=11)
+27 IF '$TEST
SET REPLY="4~Invalid Request; unrecognized input txid. ("_PARAMS_") errcode*19b"
GOTO RPTLOCKZ
+28 ; flag for Status Type "R" management, in case Ex Status not reliable
SET RCODE=0
IF TXID=10!(TXID=11)
SET RCODE=1
+29 IF TXID=0!(TXID=10)
Begin DoDot:1
+30 SET X=$PIECE(PARAMS,PIPE,2)
IF X=""
+31 IF '$TEST
SET REPLY="4~Invalid Request; Unlock only one exam per request. ("_PARAMS_") errcode*20a"
GOTO RPTLOCKZ
End DoDot:1
IF REPLY]""
GOTO RPTLOCKZ
+32 ;
+33 ; EXAMS array contents as described above, except pipe-piece 3 tracks Locks for: Report_Lev ^ Exam_lev
+34 ; init array of exams to be processed
+35 SET EXAMS(1)="|"_$PIECE($PIECE(PARAMS,PIPE),U,2,5)
+36 FOR IEXAM=2:1
SET CASEID=$PIECE(PARAMS,PIPE,IEXAM)
if CASEID=""
QUIT
Begin DoDot:1
+37 IF +CASEID'=RADFN
SET REPLY="4~Invalid Request; multiple exams for different patients. ("_PARAMS_") errcode*21"
QUIT
+38 SET EXAMS(IEXAM)="|"_CASEID
End DoDot:1
IF REPLY]""
GOTO RPTLOCKZ
+39 SET NEXAMS=IEXAM-1
+40 ;
+41 ; get all needed data for each exam; RARPT will be created if applicable, returned in caseid value
+42 FOR IEXAM=1:1:NEXAMS
SET CASEID=$PIECE(EXAMS(IEXAM),PIPE,2)
Begin DoDot:1
+43 SET RARPT=+$PIECE(CASEID,U,4)
SET CREATRPT=0
+44 IF TXID=11
IF 'RARPT
SET CREATRPT=1
+45 ; 1--flag to create rarpt when needed; note .CaseId is updated when rarpt is created
SET X=$$GETDATA^ISIJRPT2(.CASEID,0,CREATRPT)
+46 ; error detected
IF $PIECE(X,U)=-1
SET REPLY="4~"_$PIECE(X,U,2,99)
QUIT
+47 ; store updated caseid in array
SET $PIECE(EXAMS(IEXAM),PIPE)=X
SET $PIECE(EXAMS(IEXAM),PIPE,2)=CASEID
+48 ; exam lock was opened in getdata; save incase need to unlock if error
IF CREATRPT
IF (+$PIECE(CASEID,U,4))
SET T=$PIECE(EXAMS(IEXAM),PIPE,3)
SET $PIECE(T,U,2)=1
SET $PIECE(EXAMS(IEXAM),PIPE,3)=T
End DoDot:1
IF REPLY]""
GOTO RPTLOCKZ
+49 ;
+50 ; process UNLOCKs here--only one exam per call allowed
+51 IF TXID=0!(TXID=10)
Begin DoDot:1
+52 SET CASEID=$PIECE(EXAMS(1),PIPE,2)
SET RARPT=$PIECE(CASEID,U,4)
+53 IF RARPT
+54 IF '$TEST
SET REPLY="4~Invalid Request; caseid string missing rarpt value. ("_PARAMS_") errcode*22a"
QUIT
+55 SET X=$PIECE(EXAMS(1),PIPE)
SET DAYCASE=$PIECE(X,U,3)
SET RASTCAT=$PIECE(X,U,7)
+56 IF "^I^C^"[RASTCAT
Begin DoDot:2
+57 IF TXID=0
+58 IF '$TEST
SET REPLY="4~Invalid Request; Exam status must be 'Ready for Interp' for this unlock request. ("_PARAMS_") errcode*22c"
QUIT
End DoDot:2
if REPLY]""
QUIT
+59 IF RASTCAT="R"
Begin DoDot:2
+60 IF TXID=10
+61 IF '$TEST
SET REPLY="4~Invalid Request; Exam status must be Interpreted or Complete for this unlock request. ("_PARAMS_") errcode*22d"
QUIT
End DoDot:2
if REPLY]""
QUIT
+62 IF $$LOCKCHK(CASEID,RASTCAT,DAYCASE)
Begin DoDot:2
+63 ; unlock report level
DO UNLOCKRP^ISIJRPT2(RARPT)
+64 ; unlock exam level for "R" category exams
IF +RCODE
DO UNLOCKEX^ISIJRPT2(CASEID)
+65 SET REPLY="0~Exam unlocked."_"-"_RASTCAT_"-"
End DoDot:2
QUIT
+66 IF '$TEST
SET REPLY="4~Invalid Request; exam/report was not locked by user. ("_PARAMS_"-"_RASTCAT_"-"_") errcode*22b"
End DoDot:1
GOTO RPTLOCKZ
+67 ;
+68 ; process lock request(s)
+69 ; get rid of input "duplicate" pset exams, if any
+70 IF NEXAMS>1
Begin DoDot:1
+71 FOR IEXAM=1:1:NEXAMS
SET X=$PIECE(EXAMS(IEXAM),PIPE)
SET T=+X
if T
Begin DoDot:2
+72 IF $DATA(PSETS(T))
KILL EXAMS(IEXAM)
SET NEXAMS=NEXAMS-1
QUIT
+73 SET PSETS(T)=IEXAM
End DoDot:2
End DoDot:1
+74 ;
+75 ; verify user type is valid for doing a lock
+76 IF +MAGJOB("USER",1)
+77 IF '$TEST
SET REPLY="4~Only a radiologist may lock a report. ("_PARAMS_") errcode*21a"
GOTO RPTLOCKZ
+78 ;
+79 ; verify exam status is valid for doing a lock
+80 SET IEXAM=0
+81 FOR
SET IEXAM=$ORDER(EXAMS(IEXAM))
if 'IEXAM
QUIT
Begin DoDot:1
+82 SET X=$PIECE(EXAMS(IEXAM),PIPE)
SET RASTCAT=$PIECE(X,U,7)
SET RPTSTAT=$PIECE(X,U,8)
+83 SET T=$SELECT(RPTSTAT="":0,1:1)
SET CT(T)=$GET(CT(T))+1
+84 IF $GET(CT(1))>1
SET REPLY="4~Cannot lock multiple exams having unverified reports. ("_PARAMS_") errcode*23f"
QUIT
+85 IF RASTCAT]""
IF ("^I^C^R^"[RASTCAT)
+86 IF '$TEST
SET REPLY="4~Invalid Report Lock request--exam status must be Complete, Ready for Interp, or Interpreted. ("_PARAMS_") errcode*23"
QUIT
+87 IF RASTCAT="R"
Begin DoDot:2
+88 IF TXID'=11
SET REPLY="4~Invalid Report Lock request--Invalid TxID code for 'Ready for Interp' exam. ("_PARAMS_") errcode*23d"
QUIT
End DoDot:2
if REPLY]""
QUIT
+89 IF TXID=11
Begin DoDot:2
+90 IF RASTCAT'="R"
SET REPLY="4~Invalid Report Lock request--TxID code valid only for 'Ready for Interp' exams. ("_PARAMS_") errcode*23e"
QUIT
End DoDot:2
if REPLY]""
QUIT
+91 SET STATCT(RASTCAT)=$GET(STATCT(RASTCAT))+1
End DoDot:1
IF REPLY]""
GOTO RPTLOCKZ
+92 IF $GET(STATCT("C"))>1!($GET(STATCT("C"))&($GET(STATCT("I"))!$GET(STATCT("R"))))
Begin DoDot:1
+93 SET REPLY="4~Invalid Report Lock request--Complete exam cannot be edited with another exam. ("_PARAMS_") errcode*23a"
QUIT
End DoDot:1
GOTO RPTLOCKZ
+94 IF $GET(STATCT("R"))&$GET(STATCT("I"))
Begin DoDot:1
+95 SET REPLY="4~Invalid Report Lock request--Ready for Interp exam cannot be edited with another exam. ("_PARAMS_") errcode*23c"
QUIT
End DoDot:1
GOTO RPTLOCKZ
+96 ;
+97 ; make sure not already locked by me
+98 SET IEXAM=0
+99 FOR
SET IEXAM=$ORDER(EXAMS(IEXAM))
if 'IEXAM
QUIT
Begin DoDot:1
+100 SET CASEID=$PIECE(EXAMS(IEXAM),PIPE,2)
+101 SET X=$PIECE(EXAMS(IEXAM),PIPE)
SET RASTCAT=$PIECE(X,U,7)
SET DAYCASE=$PIECE(X,U,3)
+102 ; for Category "R" exams, we assume this (report) lock happened only if the Exam lock also succeeded
SET T=$$LOCKCHK(CASEID,RASTCAT,DAYCASE)
+103 IF T
SET REPLY="4~Invalid Request; exam/report already locked by user. ("_PARAMS_"-"_RASTCAT_"-"_") errcode*23b"
End DoDot:1
IF REPLY]""
GOTO RPTLOCKZ
+104 ;
+105 ; obtain locks for the active exams
+106 SET IEXAM=0
+107 FOR
SET IEXAM=$ORDER(EXAMS(IEXAM))
if 'IEXAM
QUIT
Begin DoDot:1
+108 SET CASEID=$PIECE(EXAMS(IEXAM),PIPE,2)
SET RARPT=$PIECE(CASEID,U,4)
+109 IF RCODE
Begin DoDot:2
+110 SET X=$PIECE(EXAMS(IEXAM),PIPE)
SET RASTCAT=$PIECE(X,U,7)
+111 ; lock at exam level for Category "R" exams only
DO LOCKEX(CASEID,RASTCAT,.LOCKEDEX)
+112 IF LOCKEDEX
+113 IF '$TEST
SET REPLY="3~Unable to lock exam for report entry/edit; try again later; code*24a."
QUIT
End DoDot:2
if 'LOCKEDEX
QUIT
+114 ; ALL exams require report level lock
DO LOCKRPT(RARPT,.LOCKED)
+115 IF LOCKED
SET $PIECE(EXAMS(IEXAM),PIPE,3)=1_U
SET NLOCKS=NLOCKS+1
+116 IF '$TEST
Begin DoDot:2
+117 ; undo the exam lock
IF RCODE
DO UNLOCKEX^ISIJRPT2(CASEID)
+118 SET REPLY="3~Unable to lock report for entry/edit; try again later; code*24b."
QUIT
End DoDot:2
QUIT
End DoDot:1
IF REPLY]""
GOTO RPTLOCKZ
+119 SET REPLY="0~Report"_$SELECT(NLOCKS>1:"s",1:"")_" locked for entry/edit."
+120 ;
RPTLOCKZ ;
+1 ; clear up locks, if need be
IF +REPLY>0
Begin DoDot:1
+2 DO UNLOCKEM^ISIJRPT2(RCODE,NLOCKS)
End DoDot:1
+3 SET @MAGGRY@(0)=REPLY
+4 QUIT
+5 ;
LOCKRPT(RARPT,LOCKED) ; for input rarpt, return success/fail for lock attempt
+1 SET LOCKED=0
+2 IF 'RARPT
+3 IF '$TEST
Begin DoDot:1
+4 ; this is sufficient to protect all printset members (both ISIRad and roll'n scroll)
LOCK +^RARPT(RARPT):2
+5 IF $TEST
Begin DoDot:2
+6 SET ^TMP("RAD LOCKS","ISI",$JOB,DUZ,"^RARPT(",RARPT)=$PIECE($GET(MAGJOB("USER",1)),U,3)
+7 ; success
SET LOCKED=1
End DoDot:2
+8 ;
End DoDot:1
+9 QUIT
+10 ;
LOCKEX(CASEID,RASTCAT,LOCKED) ; for input caseid, return success/fail for lock attempt
+1 ; 1) Lock the Exam level--this will persist for the report entry session (protects Tech field update)
+2 ; Return: Lock successful 0/1
+3 NEW RADFN,RADTI,RACNI
+4 SET LOCKED=0
+5 IF RASTCAT="R"
+6 IF '$TEST
SET LOCKED=LOCKED_U_"Invalid exam status for 'R-category' exam lock operation. errcode*25a"
QUIT
+7 SET RADFN=$PIECE(CASEID,U)
SET RADTI=$PIECE(CASEID,U,2)
SET RACNI=$PIECE(CASEID,U,3)
+8 LOCK +^RADPT(RADFN,"DT",RADTI,"P",RACNI,0):2
+9 IF $TEST
SET LOCKED=1
+10 IF '$TEST
SET LOCKED=0_U_"Unable to obtain exam lock; errcode*25c"
+11 QUIT
+12 ;
LOCKCHK(CASEID,RASTCAT,DAYCASE) ; does current user have a lock?
+1 ; Return: 1=Locked by me; nil=not locked; INI[:R] or Text=Locked/Reserved by other
+2 NEW OK,RARPT
+3 SET OK=""
SET RARPT=$PIECE(CASEID,U,4)
+4 ; Should have been locked by "normal" exam lock
IF RASTCAT="E"
Begin DoDot:1
+5 SET X=$$CHKLOCK^MAGJLS2B(RARPT,DAYCASE)
+6 ; Exam locked by Client
SET OK=($PIECE(X,U,2)=1)
+7 ; initials of other user, or nil
IF 'OK
SET OK=$PIECE(X,U)
End DoDot:1
+8 ; lock would be the "report entry" lock per this module
IF '$TEST
IF RASTCAT]""
IF ("^I^C^R^"[RASTCAT)
Begin DoDot:1
+9 LOCK +^RARPT(RARPT,"checklock"):0
+10 IF $TEST
Begin DoDot:2
+11 ; locked by me
IF $DATA(^TMP("RAD LOCKS","ISI",$JOB,DUZ,"^RARPT(",RARPT))
SET OK=1
+12 ; not locked
IF '$TEST
SET OK=""
QUIT
End DoDot:2
LOCK -^RARPT(RARPT,"checklock")
+13 IF '$TEST
SET OK="another user"
End DoDot:1
+14 QUIT OK
+15 ;
READYINT(IMGTYP) ; "Ready for Interpretation" feature enabled? -- P106 enhancement
+1 ; --> If is enabled for input Type of Imaging, returns field # & data value to stuff into Exam Record
+2 ; current (perhaps only) user is RTT: called by ISIRAD03
+3 ;
+4 NEW FIELD,FILE,REPLY,VALUE,X
+5 SET REPLY=""
+6 SET X=$PIECE(^MAG(2006.69,1,"ISI"),U,7,8)
+7 ; does apply to this Imaging Type
IF +X=$GET(IMGTYP)
Begin DoDot:1
+8 SET X=$PIECE(X,U,2)
+9 SET VALUE=$PIECE(X,";",1)
SET FILE=$PIECE(X,";",2)
+10 ; <*> thus far, we only use #78.6 Camera/Equip/Rm
SET FIELD=$SELECT(FILE="RA(78.6,":18,1:"")
+11 IF FIELD=""!(VALUE="")
SET REPLY="-1^Invalid 'Ready for Interpretation' setting in MAG VISTARAD SITE PARAMETERS file."
QUIT
+12 SET REPLY=FIELD_U_VALUE
End DoDot:1
+13 if $QUIT
QUIT REPLY
QUIT
+14 ;
END ;
