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

MAGJEX1.m

Go to the documentation of this file.
  1. MAGJEX1 ;WIRMFO/JHC,ISI/JL - VistARad RPC calls ; 10/17/2022
  1. ;;3.0;IMAGING;**16,22,18,65,101,115,104,120,133,341**;Dec 21, 2022;Build 28
  1. ;; Per VHA Directive 2004-038, this routine should not be modified.
  1. ;; +---------------------------------------------------------------+
  1. ;; | Property of the US Government. |
  1. ;; | No permission to copy or redistribute this software is given. |
  1. ;; | Use of unreleased versions of this software requires the user |
  1. ;; | to execute a written test agreement with the VistA Imaging |
  1. ;; | Development Office of the Department of Veterans Affairs, |
  1. ;; | telephone (301) 734-0100. |
  1. ;; | The Food and Drug Administration classifies this software as |
  1. ;; | a medical device. As such, it may not be changed in any way. |
  1. ;; | Modifications to this software may result in an adulterated |
  1. ;; | medical device under 21CFR820, the use of which is considered |
  1. ;; | to be a violation of US Federal Statutes. |
  1. ;; +---------------------------------------------------------------+
  1. ;;
  1. ; Reference to EN2^RAUTL20 in ICR #3270
  1. ;; ISI IMAGING;**99,101**
  1. Q
  1. ;
  1. ;
  1. ERR N ERR S ERR=$$EC^%ZOSV S @MAGGRY@(0)="0^4~"_ERR
  1. D @^%ZOSF("ERRTN")
  1. Q:$Q 1 Q
  1. ;
  1. ;***** Open an exam.
  1. ; RPC: MAGJ RADCASEIMAGES
  1. ;
  1. OPENCASE(MAGGRY,DATA) ;
  1. ; MAGGRY holds $NA reference to ^TMP for rpc return
  1. ; all ref's to MAGGRY use subscript indirection
  1. ; input in DATA:
  1. ; OPEN_FLAG ^ RADFN^RADTI^RACNI^RARPT ^ PSINDGET ^ <unused> ^ USETGA (forced to zero) ; ISI
  1. ; OPEN_FLAG = 0: Open, view only
  1. ; 1: Open, lock the case for status update
  1. ; 2: Open, Reserve for Interpretation
  1. ; VIX: Fetching metadata only; Jukebox retrieval occurs (P115 & earlier)
  1. ; VIX-Metadata: Fetching metadata only; no JB Retrieval (P104,ff)
  1. ; VIX-Open: Fetching metadata with JB Retrieval (P104,ff)
  1. ; RADFN^RADTI^RACNI^RARPT = Exam ID string, specifies case of interest
  1. ; PSINDGET= Presentation State indicators of interest to client
  1. ; K/I/U for Key Image/ Interpretation/ User PS types
  1. ; USETGA = hard-code to "0": Open BIG file ; ISI remove support for downsampled image fetch
  1. ;
  1. ; Details of Reply message are below tag OPENCASZ
  1. ;
  1. N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJEX1"
  1. N RARPT,RADFN,RADTI,RACNI,RADIV
  1. N DAYCASE,CURCASE,REPLY,CT,MAGS,STARTNOD,LOCKED,DATAOUT,RADATA,RIST,MDL
  1. N IMAG,MAGXX,MAGFILE,MAGFILE1,MAGFILE2,MAGFILE3,MAGLST,MAGOBJT,MODALITY
  1. N MAGSTRT,MAGEND,CURPATHS
  1. N MIXEDUP,VIEWOK,USETGA,USELORES,IMGST,REMOTE,DIQUIET
  1. N LOGDATA,MODIF,EXCAT,RADATA2,PSIND,RACPT,RASTCAT,RASTORD,ACQSITE,ALTPATH,PROCDT
  1. N YNMAMMO,YNREVANN,PSINDGET,JBDISABLE,STANUM
  1. N ASIGDUZ,ASIGRIST,ASIGREPL,RADATA9,PLACE ; ISI
  1. S DIQUIET=1 D DT^DICRW
  1. S (CT,MIXEDUP)=0,MODALITY="",DATAOUT="",DAYCASE="",MAGLST="MAGJOPENCASE",(ACQSITE,ALTPATH,PROCDT,STANUM)=""
  1. S VIEWOK=1
  1. K MAGGRY S MAGGRY=$NA(^TMP($J,MAGLST)),STARTNOD=0 K @MAGGRY ; assign MAGGRY value
  1. S CURCASE=$P(DATA,U),RARPT=+$P(DATA,U,5),PSINDGET=+$P(DATA,U,6)
  1. S PSIND="" I PSINDGET]"" F I="K","I","U" I $F(PSINDGET,I) S PSIND(I)=""
  1. S USETGA=0 ; ISI hard-code to "0"
  1. S RADFN=$P(DATA,U,2),RADTI=$P(DATA,U,3),RACNI=$P(DATA,U,4)
  1. I RADFN,RADTI,RACNI D GETEXAM2^MAGJUTL1(RADFN,RADTI,RACNI,"",.X)
  1. I 'X S REPLY="4~Request Contains Invalid Case Pointer ("_RADFN_U_RADTI_U_RACNI_U_RARPT_")." G OPENCASZ
  1. S RADATA=$G(^TMP($J,"MAGRAEX",1,1)),RADATA2=$G(^(2)),RADATA9=$G(^("ISI")) ; ISI
  1. K ^TMP($J,"MAGRAEX")
  1. S RADIV=$P(RADATA2,U,5),MODIF=$P(RADATA2,U,8),RASTCAT=$P(RADATA2,U,11),RASTORD=$P(RADATA,U,15)
  1. S PLACE=$P(RADATA2,U,6) ; ISI
  1. S RARPT=+$P(RADATA,U,10),DAYCASE=$P(RADATA,U,12),RACPT=$P(RADATA,U,17)
  1. I 'RARPT!'$D(^RARPT(RARPT,2005)) S REPLY="4~This exam has no report entry for associating images; no images can be accessed." G OPENCASZ
  1. D CKINTEG^MAGJRPT(.X,RADFN,RADTI,RACNI,RARPT,RADATA)
  1. I X]"" S MIXEDUP=1,MIXEDUP("REPLY")=X ; DB corruption
  1. ; ISI begin ...
  1. S ASIGDUZ=+$P(RADATA9,U,3),ASIGRIST=0,ASIGREPL=0 ; ISI
  1. I ASIGDUZ D
  1. . F X="S","R" I $D(^VA(200,"ARC",X,ASIGDUZ)) S ASIGRIST=1 Q
  1. ; check if an assignment conflict exists for current user:
  1. ; exam is lockable (curcase = 1 or 2); if a rist is attempting to open, & exam is assigned, then block:
  1. ; Rist vs Tech has Assign? tech: allow View/Cancel; Rist: View/Override/Cancel
  1. ; Note that reply code 10 is a special value, used ONLY to enable the Assign over-ride for a rist
  1. I CURCASE,'$$ASIGME^ISIJUTL1(ASIGDUZ) I CURCASE'=11 D G OPENCASZ:'(+REPLY=5) S CURCASE=0,ASIGREPL=1
  1. . I ASIGRIST,(CURCASE=1) S REPLY="10~Case #"_DAYCASE_" is Assigned to "_$$USERINF^MAGJUTL3(ASIGDUZ,1)_". You may View only, Override the assignment, or Cancel. " ; #10=View/Override/Cancel"
  1. . E I ASIGRIST S REPLY="2~Case #"_DAYCASE_" is Assigned to "_$$USERINF^MAGJUTL3(ASIGDUZ,1)_"; Reserve not allowed."
  1. . E S REPLY="5~Case #"_DAYCASE_" is Assigned to "_$$USERINF^MAGJUTL3(ASIGDUZ,1)_"; exam NOT Locked. "
  1. I CURCASE=11 S CURCASE=1 ; Came through Override pathway--allow override lock attempt
  1. I ASIGREPL ; Assign conflict logic has already created a reply code/msg
  1. E S REPLY="4~Attempting to open/display case #"_DAYCASE
  1. ; ISI ... end
  1. S JBDISABLE=0
  1. I CURCASE="VIX-Metadata" S JBDISABLE=1 ; metadata only, do not trigger JB fetches
  1. ;
  1. ; Note in several reply messages below the use of "2~"
  1. ; This value triggers specific behaviors in vrad client and VIX
  1. ; -- client displays an Information message box
  1. ; -- VIX 'tags' the exam to refresh the file list metadata from the source
  1. ; on any subsequent access for this exam
  1. ; These respective behaviours are mutually appropriate for both parts of
  1. ; the system for all the messages involved; avoid using "2~" unless the
  1. ; same functionality applies for any given new functionality
  1. ;
  1. S IMGST=$$JBFETCH^MAGJUTL2(RARPT,.MAGS,USETGA,JBDISABLE) ; open only if NOT on JB
  1. I +IMGST D G OPENCASZ ; some images are on JB
  1. . I $D(MAGS("OFFLN")) N T,TT S T="",TT="" D
  1. . . F S T=$O(MAGS("OFFLN",T)) Q:T="" S TT=TT_$S(TT="":"",1:", ")_T
  1. . . S REPLY="2~Case #"_DAYCASE_"--Images for this exam are stored OFF-LINE. To view these images, contact your Imaging Coordinator, and request mounting of the following platters: "_TT
  1. . E I JBDISABLE S REPLY="2~Case #"_DAYCASE_"--"_+IMGST_" Images are on Jukebox."
  1. . E S REPLY="2~Case #"_DAYCASE_"--"_+IMGST_" Images have been requested from Jukebox; try again later."
  1. I '$P(IMGST,U,2) S REPLY="2~No Images exist for Case #"_DAYCASE_"." G OPENCASZ
  1. S USELORES=+$P(IMGST,U,3)_U_$P(IMGST,U,2)
  1. S MAGSTRT=1,MAGEND=MAGS D IMGLOOP^MAGJEX1B
  1. ;
  1. I ACQSITE="" S ACQSITE=RADIV
  1. ;
  1. ; Conditionally support revising an unlocked exam's annotations as a function
  1. ; of exam status and credentials of (current & original) interpreter (P101).
  1. S YNREVANN=$$ZRUREVAN^MAGJUTL4(RADFN,RADTI,RACNI)
  1. ;
  1. ; Return flag to allow display of disclaimer text if ExamType="Mammogram".
  1. ; Note the VRad client may override based on image metadata (P101).
  1. S YNMAMMO=$$ZRUMAMMO^MAGJUTL4(RACPT)
  1. ;
  1. ;
  1. I ASIGREPL ; ISI ; Assign conflict logic has already created a reply code/msg
  1. E S REPLY="0~Images for Case #"_DAYCASE ; ISI
  1. ;
  1. OPENCASZ I 'CT,(REPLY["Attempting") S REPLY="4~Unable to retrieve images for Case #"_DAYCASE_"."
  1. ;
  1. ; Contents of successful reply = 4 pipe-delimited ("|") pieces:
  1. ; 1: # Image nodes ^ Reply Msg Type ~ Reply Msg display text
  1. ; 2: RADFN^RADTI^RACNI^RARPT --> Exam ID String
  1. ; 3: Pt Name ^ CASE # ^ Proc. Name ^ Exam Date ^ Time ^ Modality ^
  1. ; SSN ^ <unused> ^ LOCKED Status ^ Modifier ^ Exam Status Category
  1. ; 4: Is Radiologist? ^ Alt_Path Flag ^ Acquisition Site ^ Procedure Date ^
  1. ; Revise Annotations? ^ Mammography? ^ Station Number | Regional image(0/1)
  1. ;
  1. S REMOTE=+$G(MAGJOB("REMOTE")) ; ISI
  1. S LOCKED=0
  1. I MIXEDUP D
  1. . N IMIX,XDFN,XPTS S VIEWOK=$S($D(MAGJOB("KEYS","MAGJ SEE BAD IMAGES")):1,1:0)
  1. . I MIXEDUP>1 D
  1. . . S XPTS="",XDFN=0 F IMIX=0:1 S XDFN=$O(MIXEDUP(XDFN)) Q:'XDFN S XPTS=XPTS_$S(IMIX:" and ",1:" ")_$$PNAM(XDFN)
  1. . . S XPTS=$S(IMIX=1:" ",1:"s ")_XPTS
  1. . . S REPLY=(7-VIEWOK)_"~This exam is registered for "_$$PNAM(RADFN)_"; however, it is linked to images for patient"_XPTS_". This is a serious problem--immediately report it to Radiology management and Imaging support staff!"
  1. . E S REPLY=(7-VIEWOK)_"~"_MIXEDUP("REPLY")
  1. . I CURCASE S REPLY=REPLY_" The exam is NOT Locked." S CURCASE=0
  1. I CT D
  1. . S RIST=$S(+MAGJOB("USER",1):1,1:0),EXCAT=""
  1. . S LOGDATA=RADFN_U_+$P(MAGS(1),U,4)_U_+MAGS_U_REMOTE ; for Img Access log
  1. . I CURCASE D
  1. . . I $G(MAGJOB("CONSOLIDATED")),'$D(MAGJOB("DIVSCRN",RADIV)) D S CURCASE=0 Q
  1. . . . S REPLY="5~Exam is for Station #"_$$STATN(RADIV)_"; you are logged on to #"_$$STATN(DUZ(2))_". Exam is NOT Locked."
  1. . . S XX=$P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,3)
  1. . . I '$D(^RA(72,"AVC","E",XX)) D S CURCASE=0 Q
  1. . . . D LOCKACT^MAGJEX1A(RARPT,DAYCASE,100,.RESULT) ; between reserve and now, exam may have been Taken & Updated
  1. . . . I +RESULT(1)!+RESULT(2) D LOCKACT^MAGJEX1A(RARPT,DAYCASE,101,.RESULT) ; so, cancel any lock/reserve
  1. . . . S REPLY="5~For Case #"_DAYCASE_", current Status is "_$P(^RA(72,XX,0),U)_"; Lock or Reserve NOT allowed."
  1. . . E S EXCAT="E"
  1. . . I RIST D ; lock only for Current Case, Radiologist, & Full Res images ; ISI remove deprecated logic re usetga
  1. . . . ; save data needed to later log Interpreted event
  1. . . . D LOCKACT^MAGJEX1A(RARPT,DAYCASE,CURCASE,.RESULT,.REPLY,LOGDATA)
  1. . . . S LOCKED=$S(+RESULT:1,+$P(RESULT,U,2):2,1:0)
  1. . I EXCAT="" D
  1. . . I RASTORD=9 S EXCAT="C" Q ; Complete
  1. . . E S EXCAT=RASTCAT
  1. . . I EXCAT="D"!(EXCAT="T") S EXCAT="I" ; just display one value meaning Interpreted
  1. . S DATAOUT=$P(RADATA,U,4)_U_DAYCASE_U_$P(RADATA,U,9)
  1. . S X=$P(RADATA,U,6),T=$L(X," "),X=$P(X," ",1,T-1)_U_$P(X," ",T)
  1. . S DATAOUT=DATAOUT_U_X
  1. . S DATAOUT=DATAOUT_U_MODALITY_U_$P(RADATA,U,5)_U_U_LOCKED
  1. . S DATAOUT=DATAOUT_U_MODIF_U_EXCAT_U_"|"_RIST_U_ALTPATH_U_ACQSITE_U_PROCDT_U_YNREVANN_U_YNMAMMO_U_STANUM_U_"|"_$$REGIONAL(.MAGS)_U_PLACE ; ISI adds pipe-piece 5!
  1. . ; ISI remove deprecated logic re usetga
  1. S @MAGGRY@(STARTNOD)=CT_U_REPLY_"|"_RADFN_U_RADTI_U_RACNI_U_RARPT_"|"_DATAOUT
  1. ; if mixedup & not have keys to see images, delete image refs
  1. ; & send only reply msg
  1. I MIXEDUP,('VIEWOK) S CT=0 K @MAGGRY S @MAGGRY@(0)=CT_U_REPLY
  1. E S $P(@MAGGRY@(0),U)=CT+STARTNOD
  1. I CT,(LOCKED'=2),(CURCASE'["VIX") D LOG^MAGJUTL3("VR-VW",LOGDATA,$$PSETLST(RADFN,RADTI,RACNI)) ; Image access log
  1. Q
  1. ;
  1. PSETLST(RADFN,RADTI,RACNI) ; Return list of Printset Case #'s for exam
  1. N I,MAGPSET,PSETLST,RAPRTSET,X
  1. S PSETLST="" ; initialize return value
  1. I +$G(RADFN),+$G(RADTI),+$G(RACNI) D
  1. . D EN2^RAUTL20(.MAGPSET)
  1. . Q:'RAPRTSET ; variable set by above call; stop if not a printset
  1. . S X=""
  1. . F I=0:1 S X=$O(MAGPSET(X)) Q:'X S PSETLST=PSETLST_$S(I:U,1:"")_$P(MAGPSET(X),U)
  1. Q:$Q PSETLST Q
  1. ;
  1. PNAM(X) ; return pt name for input DFN
  1. I X S X=$G(^DPT(+X,0)) I X]"" S X=$P(X,U)
  1. E S X="UNKNOWN"
  1. Q X
  1. ;
  1. STATN(X) ; get station #, else return input value
  1. N T
  1. I X]"" D GETS^DIQ(4,X,99,"","T") S T=$G(T(4,X_",",99,"E")) I T]"" S X=T
  1. Q X
  1. ;
  1. END Q ;
  1. ;
  1. REGIONAL(MAGS) ; ISI -- return 1 if image storage loc is regional
  1. N IEN,LOC,RSL
  1. S RSL=""
  1. I $G(MAGS) D ;aft called jbfetch^magjutl2
  1. . S IEN=+$P($G(MAGS(1)),U,4) Q:'IEN ;MAG IEN 1st image
  1. . S LOC=+$P($G(^MAG(2005,+IEN,0)),"^",3) ;NETWORK LOCATION
  1. . I $G(^MAG(2005.2,LOC,"REGIONAL")) S RSL=1
  1. Q RSL
  1. ;