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

MAGJLST1.m

Go to the documentation of this file.
  1. MAGJLST1 ;WIRMFO/JHC - VistARad RPC calls ; 10/17/2022
  1. ;;3.0;IMAGING;**16,22,18,65,76,101,90,120,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. ;; ISI IMAGING;**99,101,103,106**
  1. Q
  1. ;
  1. ; Subroutines for fetching Patient Exam Info
  1. ; PTLIST -- list subset of all exams for a patient
  1. ; RPC Call: MAGJ PTRADEXAMS
  1. ; PTLSTALL -- list ALL exams for a patient
  1. ; RPC Call: MAGJ PT ALL EXAMS
  1. ; FACLIST -- get Treating Facility List for a patient
  1. ; RPC Call: MAGJ GET TREATING LIST
  1. ;
  1. Q
  1. ERR N ERR S ERR=$$EC^%ZOSV S ^TMP($J,"RET",0)="0^4~"_ERR
  1. S MAGGRY=$NA(^TMP($J,"RET"))
  1. D @^%ZOSF("ERRTN")
  1. Q:$Q 1 Q
  1. ;
  1. PTLSTALL(MAGGRY,DATA) ; List ALL exams for a patient
  1. ; MAGGRY - indirect reference to return array of exams for a patient
  1. ; DATA -- DFN ^ BEGDT ^ ONESHOT
  1. ; --> see PTLIST comments
  1. ; RPC is MAGJ PT ALL EXAMS
  1. N PARAM
  1. S PARAM=$P(DATA,U)_"^^^"_$P(DATA,U,2,3)
  1. D PTLIST(.MAGGRY,PARAM)
  1. Q
  1. ;
  1. PTLIST(MAGGRY,DATA) ; get list of exams for a patient
  1. ;
  1. ; MAGGRY - indirect reference to return array of exams for a patient
  1. ; DATA -- DFN ^ unused ^ unused ^ BEGDT ^ ONESHOT
  1. ; DFN--Required; Patient's DFN
  1. ; BEGDT--Optional; Begin date for exam fetch (see below)
  1. ; ONESHOT--Optional; Number days back to search, return all records in one fell swoop
  1. ; Returns data in ^TMP($J,"MAGRAEX",0:n)
  1. ; RPC Call: MAGJ PTRADEXAMS
  1. ;
  1. ; Client retrieves ALL exams using multiple RPC calls to
  1. ; incrementally build the list; this is to provide all the data, but without
  1. ; incurring any long pauses to provide the info to the user.
  1. ; The algorithm fetches RAD data in one-year chunks, and repeats
  1. ; until over 20 exams have been processed, at which point the RPC reply
  1. ; is posted, along with the last date processed; this value is then used for
  1. ; a subsequent RPC call (BEGDT) to get the next chunk of the record; etc. till all done.
  1. ; * ONESHOT overrides the incremental algorithm, returning all desired data in a single call.
  1. ;
  1. N CNT,DFN,ISS,PATNAME,DIQUIET,MAGRACNT,MAGRET,REPLY,REMOTE
  1. N DAYCASE,DIV,EXCAT,MAGDT,XX,XX2,WHOLOCK,MODALITY,MYLOCK,PLACE,ENDLOOP
  1. N LIMEXAMS,BEGDT,SAVBEGDT,ENDDT,MORE,RDRIST,PSSN,CPT
  1. N CURPRIO,STATUS,RARPT,KEY,X2,REMOTE2,ONESHOT,LIMDAYS
  1. N IMGCNT,LRFLAG,MSG,ONL,PROCMOD,RASTCAT,RASTORD,STATPRIORITY,SNDREMOT
  1. N ASIGINI,ASIGENA,ASIGDUZ,XX9 ; ISI
  1. N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJLST1"
  1. S DIQUIET=1 D DT^DICRW
  1. S BEGDT=$P(DATA,U,4),ONESHOT=$P(DATA,U,5)
  1. K MAGGRY S DFN=+DATA
  1. S SNDREMOT=+$P($G(^MAG(2006.69,1,0)),U,11)
  1. S ASIGENA=$P($G(^MAG(2006.69,1,"ISI")),U,1)="Y" ; ISI
  1. S MAGRACNT=1,CNT=0 K ^TMP($J,"MAGRAEX"),^("MAGRAEX2")
  1. S REPLY="0^4~Compiling list of Radiology Exams."
  1. I DFN,$D(^DPT(DFN,0)) S PATNAME=$P(^(0),U) D
  1. . D PID^VADPT6 S PSSN=$S(VAERR:"Unknown",1:VA("PID"))
  1. . K VA("PID"),VA("BID"),VAERR
  1. . S ENDLOOP=0,BEGDT=$S(+BEGDT:BEGDT,1:"")
  1. . F D Q:'MORE Q:ENDLOOP S BEGDT=MORE+1
  1. . . I 'BEGDT S BEGDT=DT,X2=0
  1. . . E S X2=-1
  1. . . S LIMDAYS=365,MORE=1
  1. . . I ONESHOT,(ONESHOT>0) S LIMDAYS=+ONESHOT
  1. . . S ENDDT=$$FMADD^XLFDT(BEGDT,X2)
  1. . . S BEGDT=$$FMADD^XLFDT(ENDDT,-LIMDAYS)
  1. . . D GETEXAM3^MAGJUTL1(DFN,BEGDT,ENDDT,.MAGRACNT,.MAGRET,.MORE)
  1. . . S ENDLOOP=(MAGRACNT>20)!+ONESHOT ; For testing only, use >8
  1. . I 'MORE S SAVBEGDT=0
  1. . E S SAVBEGDT=MORE+1 ; adding 1 correctly inits value for subseqent call
  1. . I MAGRACNT>1 D PTLOOP
  1. E S REPLY="0^4~Invalid Radiology Patient"
  1. I MAGRACNT<2 S:(REPLY["Compiling") REPLY="0^2~Radiology Exams for: "_PATNAME
  1. I CNT!(REPLY["2~Radiology Exams") D
  1. . I 'MORE S MSG=""
  1. . E S MORE=$$FMTE^XLFDT(MORE) S MSG="Patient has more exams on file."
  1. . ; show SSN only if the user is a radiologist
  1. . S X=+MAGJOB("USER",1)
  1. . I '(X=12!(X=15)),(PSSN?3N1"-"2N1"-"4N) S PSSN=$E(PATNAME)_$P(PSSN,"-",3)
  1. . S PSSN=" ("_PSSN_")"
  1. . I CNT S REPLY=CNT_"^1~Radiology Exams for: "_PATNAME_PSSN_$S(MSG="":"",1:" -- "_MSG)
  1. . E S REPLY=REPLY_$S(MSG="":"",1:" -- "_MSG)
  1. . S X="^Day/Case~S3~1^Lock~~2^Procedure~~6^Modifier~~25^Image Date/Time~S1~7^Status~~8^# Img~S2~9^Onl~~10^"_$S(SNDREMOT:"RC~~12^",1:"")_"Site~~23^Mod~~15" ; ISI
  1. . S ^TMP($J,"MAGRAEX2",1)=X_$S(ASIGENA:"^Assign~~201",1:"")_"^Interp By~~20^Imaging Loc~~11^CPT~~27" ; ISI Assign
  1. S $P(REPLY,"|",2)=SAVBEGDT
  1. S ^TMP($J,"MAGRAEX2",0)=REPLY
  1. S MAGGRY=$NA(^TMP($J,"MAGRAEX2"))
  1. K ^TMP($J,"RAE1"),^("MAGRAEX")
  1. Q
  1. ;
  1. PTLOOP ; loop through exam data & package it for VRAD use
  1. S ISS=0
  1. F S ISS=$O(^TMP($J,"MAGRAEX",ISS)) Q:'ISS S XX=^(ISS,1),XX2=^(2),XX9=$G(^("ISI")) D ; ISI
  1. . S CNT=CNT+1,RARPT=$P(XX,U,10)
  1. . D IMGINFO^MAGJUTL2(RARPT,.Y)
  1. . S IMGCNT=$P(Y,U),ONL=$P(Y,U,2),MAGDT=$P(Y,U,3),REMOTE=$P(Y,U,4),MODALITY=$P(Y,U,5),PLACE=$P(Y,U,6),KEY=$P(Y,U,7)
  1. . S REMOTE2=REMOTE
  1. . S:PLACE PLACE=$P($G(^MAG(2006.1,PLACE,0)),U,9)
  1. . I REMOTE D
  1. . . S T="" F I=1:1:$L(REMOTE,",") S T=T_$S(T="":"",1:",")_$P($G(^MAG(2005.2,$P(REMOTE,",",I),3)),U,5)
  1. . . S REMOTE=T
  1. . S DIV="",X=$P(XX2,U,5) I X'=DUZ(2) S DIV=$$STATN(X)
  1. . I MAGDT="" S MAGDT=$P(XX,U,7)
  1. . S MAGDT=$$FMTE^XLFDT(MAGDT,"5Z")
  1. . S WHOLOCK=RARPT,MYLOCK="",DAYCASE=$P(XX,U,12)
  1. . I WHOLOCK]"" S T=$$CHKLOCK^MAGJLS2B(WHOLOCK,DAYCASE),WHOLOCK=$P(T,U),MYLOCK=$P(T,U,2)
  1. . S RDRIST=$P(XX2,U,3),PROCMOD=$P(XX2,U,8),CPT=$P(XX,U,17),RASTORD=$P(XX,U,15)
  1. . S ASIGINI=$P(XX9,U,1),ASIGDUZ=$P(XX9,U,3) ; ISI
  1. . S Y=U_DAYCASE_U_WHOLOCK_U_$E($P(XX,U,9),1,26)_U_PROCMOD_U_MAGDT_U_$E($P(XX,U,14),1,16)_U_IMGCNT_U_ONL
  1. . I SNDREMOT S Y=Y_U_REMOTE
  1. . S Y=Y_U_PLACE_U_MODALITY_$S(ASIGENA:U_ASIGINI,1:"")_U_RDRIST_U_$E($P(XX,U,13),1,11)_U_CPT ; ISI asigini
  1. . S STATUS=$P(XX,U,11),EXCAT="",CURPRIO=0,RASTCAT=$P(XX2,U,11),LRFLAG=$P(XX2,U,12)
  1. . I ASIGENA D ; ISI <*> Special case, for PtList ONLY! Exam is NOT locked, but assigned to someone else,
  1. . . I ASIGINI]"",(MYLOCK="") I '$$ASIGME^ISIJUTL1(ASIGDUZ) S MYLOCK=0 ; flags client to NOT Allow Dictate option
  1. . I STATUS]"" D
  1. . . S EXCAT=RASTCAT
  1. . . I RASTORD<2!(EXCAT="W")!(EXCAT="R")!('IMGCNT) S CURPRIO=0 ; Cancelled/Waiting/No images: Ignore exam ; ISI P106
  1. . . E I EXCAT="E" S CURPRIO=1 ; Examined="Current" exam
  1. . . E S CURPRIO=2 ; must be a "prior" exam
  1. . . I CURPRIO,'(ONL="Y") S CURPRIO=3 ; images on jukebox
  1. . . I RASTORD=9 S EXCAT="C" ; Complete
  1. . . E I EXCAT="D"!(EXCAT="T") S EXCAT="I" ; just display one value meaning Interpreted
  1. . S STATPRIORITY=0 ; in the Pt list, this is only a placeholder in next line, to sync with svmag2a, etc.
  1. . S ^TMP($J,"MAGRAEX2",ISS)=Y_"^|"_$P(XX,U,1,3)_U_RARPT_"||"_EXCAT_U_WHOLOCK_U_MYLOCK_U_MODALITY_U_CPT_U_CURPRIO_U_RARPT_U_KEY_U_REMOTE2_U_LRFLAG_U_STATPRIORITY
  1. . ; * Note: Keep Pipe-pieces in sync with svmag2a^magjls3 & lstout^magjls2b *
  1. Q
  1. ;
  1. STATN(X) ; get station #, else return input value
  1. N T
  1. I X]"" D GETS^DIQ(4,X,99,"E","T") S T=$G(T(4,X_",",99,"E")) I T]"" S X=T
  1. Q X
  1. ;
  1. FACLIST(MAGGRY,DATA) ; get Treating Facility List for a patient
  1. ; RPC Call: MAGJ GET TREATING LIST
  1. ; MAGGRY -- return array--supplied by TFL^VAFCTFU1
  1. ; Input: DATA -- Patient DFN
  1. ; Returns:
  1. ; Array; first entry contains result header with # lines to follow
  1. ; and reply message description.
  1. ; Entries 2:N (if any exist) contain data for each Treating facility
  1. ; up-caret delimited : A ^ B ^ C ^ D ^ E
  1. ; A: Institution IEN of the Facility
  1. ; B: Institution Name
  1. ; C: Current date on record for that institution
  1. ; D: ADT/HL7 event reason
  1. ; E: FACILITY TYPE
  1. ; Note--see TFL^VAFCTFU1 for further details
  1. ;
  1. N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJLST1"
  1. S DIQUIET=1 D DT^DICRW
  1. N DFN
  1. K MAGGRY S DFN=+$G(DATA)
  1. S REPLY="0^4~Compiling list of Treating Facilities."
  1. I DFN
  1. E S REPLY="0^4~Invalid Radiology Patient" G FACLISTZ
  1. D TFL^VAFCTFU1(.MAGGRY,DFN) ; ICR 2990
  1. I $D(MAGGRY)<10 S REPLY="0^4~No results available." G FACLISTZ
  1. E I +MAGGRY(1)=-1 S REPLY="0^2~"_$P(MAGGRY(1),U,2) K MAGGRY(1) G FACLISTZ
  1. S REPLY=$O(MAGGRY(""),-1)_U_"1~Treating facilities returned"
  1. FACLISTZ S MAGGRY(0)=REPLY
  1. Q
  1. ;
  1. END Q ;