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

MAGJRPT.m

Go to the documentation of this file.
  1. MAGJRPT ;WIRMFO/JHC - Display Rad reports ; 10/17/2022
  1. ;;3.0;IMAGING;**18,101,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. ; Reference to EN3^RAO7PC3 #2877
  1. ; Reference to ^RAORD5 #3513
  1. ; Reference to SVTCOM^RAUTL11 in ICR #3508
  1. ; Reference to PHARM^RARTUTL in ICR #5946
  1. ; Reference to RDIO^RARTUTL in ICR #5946
  1. ;; ISI IMAGING;**99,104,102**
  1. ; Subroutines for fetching Exam Info for VistaRad Workstation
  1. ; RADRPT: Display Radiology Report -- RPC Call: MAGJ EXAM REPORT
  1. ; ORD: Display Radiology Requisition -- RPC Call: MAGJ RADORDERDISP
  1. ;
  1. Q
  1. ORD(MAGRPTY,DATA) ; Radiology Order Display
  1. ; RPC Call: MAGJ RADORDERDISP
  1. ; MAGRPTY holds indirect reference to returned data
  1. ;
  1. S MAGRPTY=$NA(^TMP($J,"WSDAT")) K @MAGRPTY
  1. N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJRPT"
  1. N RARPT,RADFN,RADTI,RACNI,RAPGE,RAX,RAOIFN
  1. N REPLY,POP,DFN,COMPLIC,XX,HDR,MAGRET,REQONLY,TMPDATA
  1. N MEDS,RDIOPHARM
  1. S REPLY="0^4~Attempting to display order info"
  1. D OPENDEV
  1. I POP S REPLY="0^4~Unable to open device 'IMAGING WORKSTATION'" G ORDZ
  1. S RADFN=$P(DATA,U),RADTI=$P(DATA,U,2),RACNI=$P(DATA,U,3)
  1. S RARPT=+$P(DATA,U,4),REQONLY=+$P(DATA,U,5)
  1. I RADFN,RADTI,RACNI
  1. E S REPLY="0^4~Request Contains Invalid Case Pointer ("_RADFN_" "_RADTI_" "_RACNI_" "_RARPT_")." G ORDZ
  1. S RAOIFN=$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),U,11)
  1. I RAOIFN,$D(^RAO(75.1,RAOIFN,0))
  1. E S REPLY="0^2~Order Information is NOT Available for this exam." G ORDZ
  1. ; Check for Database integrity problems ONLY if Req was explicitly
  1. ; requested (No check for Auto_Display of Req, cuz Exam Open does ck)
  1. D GETEXAM2^MAGJUTL1(RADFN,RADTI,RACNI,"",.MAGRET)
  1. S RADATA=$G(^TMP($J,"MAGRAEX",1,1)),XX=$G(^(2)),HDR=""
  1. S COMPLIC=$P(XX,U,4) ; Complications text
  1. S MEDS=$P(XX,U,14),RDIOPHARM=$P(XX,U,15) ; Medications & RadioPharm indicators
  1. F I=4,12,9 S HDR=HDR_$P(RADATA,U,I)_" " ; PtName, Case #, Procedure
  1. S T=$P(XX,U,8) I T]"" S HDR=HDR_" ("_T_")" ; ISI Modifier
  1. I REQONLY D CKINTEG(.REPLY,RADFN,RADTI,RACNI,RARPT,RADATA) I REPLY]"" S REPLY="0^7~"_REPLY G ORDZ ; Database integrity problems
  1. S TMPDATA=MAGRPTY_"~"_RADTI_"~"_RACNI
  1. S RAX="",RAPGE=0 D ^RAORD5
  1. S MAGRPTY=$P(TMPDATA,"~"),RADTI=$P(TMPDATA,"~",2),RACNI=$P(TMPDATA,"~",3)
  1. D:IO'=IO(0) ^%ZISC
  1. S @MAGRPTY@(1)="REQ: "_HDR
  1. D CLEANUP(MAGRPTY) ; ISI
  1. D COMMENTS(RADFN,RADTI,RACNI,MAGRPTY,2,COMPLIC,MEDS,RDIOPHARM)
  1. D TIUNOTE(RARPT,MAGRPTY,10000) ; append TIU note to reply at node 10000
  1. S REPLY="1^OK"
  1. K ^TMP($J,"MAGRAEX"),^("RAE2") ; ISI
  1. ORDZ S @MAGRPTY@(0)=REPLY
  1. Q
  1. ;
  1. CLEANUP(MAGRPTY) ; strip extraneous lines of dashes ; ISI new subrtn
  1. N HIT,I,X S HIT=0
  1. S I=20 F S I=$O(@MAGRPTY@(I)) Q:'I S X=^(I) D
  1. . I $L(X,"-")>20 S HIT=HIT+1 K:(HIT>1) @MAGRPTY@(I)
  1. . E S HIT=0
  1. Q
  1. ;
  1. COMMENTS(RADFN,RADTI,RACNI,MAGRPTY,DNODE,COMPLIC,MEDS,RDIOPHARM) ; add Complications & Tech Comments to output report
  1. ; Add Medications and Radiopharmaceuticals information to output
  1. ; RADFN, RADTI, & RACNI identify exam
  1. ; MAGRPTY is indirect reference wher output lines are to be stored
  1. ; DNODE holds reference for starting node for lines of output
  1. ; COMPLIC passes in complications data reference
  1. ; MEDS passes in Medications indicator
  1. ; RDIOPHARM passes in Radiopharmaceuticals reference
  1. ;
  1. N QTMP,CT,XX,NOTES,NOTESTAT,T S CT=0 ; ISI begin
  1. D STATUS^ISIJNOTE(.NOTESTAT,RADFN,RADTI,RACNI)
  1. S T=+$P(NOTESTAT,U,2) I T D
  1. . S @MAGRPTY@(DNODE)=" ",CT=CT+.01,@MAGRPTY@(DNODE+CT)=" * See "_T_" NOTE"_$S(T-1:"S",1:"")_" at end of report."
  1. . S @MAGRPTY@(DNODE)=" ",CT=CT+.01,@MAGRPTY@(DNODE+CT)=" "
  1. . D NOTE^ISIJNOTE(.NOTES,1_U_RADFN_U_RADTI_U_RACNI_U_RARPT)
  1. . D NOTEDISP(.NOTES,MAGRPTY,5000)
  1. . K @NOTES ; ISI end
  1. I +$G(MAGJOB("USER",1)) ; Radiologist ; ISI--for RadTech Tool use
  1. E I $D(^VA(200,"ARC","T",+DUZ)) ; Rad Tech
  1. E Q ; Don't display for any other user type
  1. S @MAGRPTY@(DNODE)=" ",CT=CT+.01,@MAGRPTY@(DNODE+CT)="Complications: "_$S(COMPLIC:$P($G(^RA(78.1,+COMPLIC,0)),U),1:"")
  1. S X=$P(COMPLIC,"~",2)
  1. I X S CT=CT+.01,@MAGRPTY@(DNODE+CT)=" "_$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"COMP")),U)
  1. K ^TMP($J,"RAE2") D SVTCOM^RAUTL11(RADFN,RADTI,RACNI)
  1. S QTMP="^TMP($J,""RAE2"")"
  1. F S QTMP=$Q(@QTMP) Q:QTMP="" Q:QTMP'["RAE2" I QTMP["TCOM" D
  1. . S XX=@(QTMP) N HI,TXT,LINE1 S LINE1=0
  1. . F Q:XX="" S HI=$L(XX) S:HI>63 HI=63 F I=HI:-1:0 S:'I XX="" I HI<63!($E(XX,I)=" ") D Q
  1. . . S TXT=$S('LINE1:"Tech Comments: ",1:" ")_$E(XX,1,I),XX=$E(XX,I+1,999),LINE1=1
  1. . . I XX]"" F I=1:1:999 I $E(XX,I)'=" " S XX=$E(XX,I,999) Q
  1. . . S CT=CT+.01,@MAGRPTY@(DNODE+CT)=TXT
  1. K ^TMP($J,"RAE2")
  1. I +$G(MEDS) D
  1. . N REF,RAUTOE,RAACNT
  1. . K ^TMP($J,"RA AUTOE")
  1. . S REF=RACNI_","_RADTI_","_RADFN_","
  1. . S RAUTOE="" ; if defined, directs output to ^TMP
  1. . S RAACNT=1000 ; init counter for output to ^TMP
  1. . D PHARM^RARTUTL(REF) ; get Medications data
  1. . D PHARMAS("Medications",1001)
  1. I +$G(RDIOPHARM) D
  1. . N RAUTOE,RAACNT
  1. . K ^TMP($J,"RA AUTOE")
  1. . S RAUTOE="" ; if defined, directs output to ^TMP
  1. . S RAACNT=1000 ; init counter for output to ^TMP
  1. . D RDIO^RARTUTL(RDIOPHARM) ; get Radiopharm data
  1. . D PHARMAS("Radiopharmaceuticals",1001)
  1. I +$G(MEDS)!+$G(RDIOPHARM) D
  1. . S CT=CT+.001,@MAGRPTY@(DNODE+CT)=" "_$TR($J(" ",66)," ","_")
  1. . S CT=CT+.001,@MAGRPTY@(DNODE+CT)=" "
  1. K ^TMP($J,"RA AUTOE")
  1. Q
  1. ;
  1. PHARMAS(TITLE,NODE) ; output lines of pharma data
  1. N LINE
  1. I $D(^TMP($J,"RA AUTOE",NODE)) D
  1. . S CT=CT+.001,@MAGRPTY@(DNODE+CT)=" "
  1. . S CT=CT+.001,@MAGRPTY@(DNODE+CT)=" ------------ "_TITLE_" ------------"
  1. . S CT=CT+.001,@MAGRPTY@(DNODE+CT)=" "
  1. . F S LINE=^TMP($J,"RA AUTOE",NODE) D S NODE=$O(^TMP($J,"RA AUTOE",NODE)) Q:'NODE
  1. . . S CT=CT+.001,@MAGRPTY@(DNODE+CT)=LINE
  1. . Q
  1. Q
  1. ;
  1. NOTEDISP(NOTES,MAGRPTY,DNODE) ; output notes ; ISI new subrtn
  1. N IP,NOTE,X S NOTE=0
  1. S DNODE=DNODE+1,@MAGRPTY@(DNODE)=" "
  1. S DNODE=DNODE+1,@MAGRPTY@(DNODE)="================================== NOTES =================================="
  1. S DNODE=DNODE+1,@MAGRPTY@(DNODE)=" "
  1. S IP="" F S IP=$O(@NOTES@(IP)) Q:IP="" S X=(@NOTES@(IP)) D
  1. . I X="*NOTES" S NOTE=1 Q
  1. . I NOTE D
  1. . . I X="*NOTES_END" S NOTE=0 Q
  1. . . S DNODE=DNODE+1,@MAGRPTY@(DNODE)=X
  1. Q
  1. ;
  1. TIUNOTE(RARPT,MAGRPTY,DNODE) ; FUT-70/IHS append Rad TIU Notes to report
  1. ; 1/2011--only works at IHS where TIU notes may exist for Radiology exams
  1. ; test for this by presence of DOCTEXT^BEHOTIU
  1. ; RARPT--exam pointer
  1. ; MAGRPTY--indirect reference to output file
  1. ; DNODE--starting node for lines of output
  1. ;
  1. N CT,QTMP,TEXT,XX
  1. I RARPT,$L(MAGRPTY),DNODE,$L($T(DOCTEXT^BEHOTIU)) D
  1. . D DOCTEXT^BEHOTIU("TEXT",RARPT_";RARPT(")
  1. . I $D(TEXT) D
  1. . . S CT=0,QTMP="TEXT"
  1. . . S @MAGRPTY@(DNODE)=" "
  1. . . F S QTMP=$Q(@QTMP) Q:QTMP="" S XX=@(QTMP) S CT=CT+.01,@MAGRPTY@(DNODE+CT)=XX
  1. Q
  1. ;
  1. OPENDEV ;
  1. N IOP,%ZIS
  1. S IOP="IMAGING WORKSTATION",%ZIS=0 D ^%ZIS
  1. I POP
  1. E U IO
  1. Q
  1. ;
  1. RADRPT(MAGRPTY,DATA) ; Display rad report; 1st must pass integrity checks
  1. ; Note: adds an additional line of output for the Report Window header
  1. ; RPC is MAGJ EXAM REPORT
  1. ;
  1. ; MAGRPTY holds $NA reference to return message; references to it use subscript indirection
  1. ;
  1. S MAGRPTY=$NA(^TMP($J,"MAGJRADRPT")) K @MAGRPTY
  1. N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJRPT"
  1. N RARPT,RADATA,MAGDFN,MAGDTI,MAGCNI,X,MAGRET,HDR,REPLY,MAGPRC,COMPLIC,DNODE
  1. N MEDS,RDIOPHARM
  1. S MAGDFN=$P(DATA,U),MAGDTI=$P(DATA,U,2),MAGCNI=$P(DATA,U,3),RARPT=+$P(DATA,U,4)
  1. I '(MAGDFN&MAGDTI&MAGCNI) D G RPTZ
  1. . S REPLY="0^4~Request Contains Invalid Case Pointer ("_MAGDFN_" "_MAGDTI_" "_MAGCNI_")."
  1. D GETEXAM2^MAGJUTL1(MAGDFN,MAGDTI,MAGCNI,"",.MAGRET)
  1. S RADATA=$G(^TMP($J,"MAGRAEX",1,1)),XX=$G(^(2)),HDR=""
  1. S COMPLIC=$P(XX,U,4) ; Complications text
  1. S MEDS=$P(XX,U,14),RDIOPHARM=$P(XX,U,15) ; Medications & RadioPharm indicators
  1. F I=4,12,9 S HDR=HDR_$P(RADATA,U,I)_" "
  1. S T=$P(XX,U,8) I T]"" S HDR=HDR_" ("_T_")" ; ISI Modifier
  1. D CKINTEG(.REPLY,MAGDFN,MAGDTI,MAGCNI,RARPT,RADATA)
  1. I REPLY]"" S REPLY="0^7~"_REPLY G RPTZ ; DB integ problem
  1. D EN3^RAO7PC3(MAGDFN_"^"_MAGDTI_"^"_MAGCNI)
  1. I '$D(^TMP($J,"RAE3")) S REPLY="0^4~No report on file." G RPTZ
  1. D COMMENTS(MAGDFN,MAGDTI,MAGCNI,MAGRPTY,2,COMPLIC,MEDS,RDIOPHARM)
  1. S MAGPRC=$O(^TMP($J,"RAE3",MAGDFN,MAGCNI,"")),I=0,DNODE=2
  1. F S I=$O(^TMP($J,"RAE3",MAGDFN,MAGCNI,MAGPRC,I)) Q:'I D
  1. . S DNODE=DNODE+1
  1. . S @MAGRPTY@(DNODE)=$G(^TMP($J,"RAE3",MAGDFN,MAGCNI,MAGPRC,I))
  1. S DNODE=DNODE+1,@MAGRPTY@(DNODE)=" " ; ISI
  1. S DNODE=DNODE+1,@MAGRPTY@(DNODE)="** END REPORT "_$$FMTE^XLFDT($$NOW^XLFDT,"1P")_" **" ; ISI
  1. D TIUNOTE(RARPT,MAGRPTY,10000) ; append TIU note to reply at node 10000
  1. S REPLY="1^1~Radiology Report"
  1. RPTZ S @MAGRPTY@(0)=REPLY
  1. I +$G(@MAGRPTY@(0)) S @MAGRPTY@(1)="RPT: "_HDR ; if a report exists, add header line to output
  1. K ^TMP($J,"MAGRAEX"),^("RAE3")
  1. Q
  1. ;
  1. CKINTEG(REPLY,RADFN,RADTI,RACNI,RARPT,RADATA) ; check integrity between Exam, Report, and Image Group Headers
  1. ; This subroutine is used by other vrad programs
  1. ;
  1. N IEN,MAGIEN,MIXEDUP,X,CKDFN,CKACN
  1. S MIXEDUP=0,REPLY=""
  1. I RARPT D G CK2:MIXEDUP
  1. . S X=$G(^RARPT(RARPT,0)),CKDFN=$P(X,U,2),CKACN=$P(X,U,4)
  1. . I CKDFN'=RADFN S MIXEDUP=1_U_+CKDFN Q
  1. . I $G(RADATA)]"" D
  1. . . I $P(RADATA,U,8)'=CKACN D
  1. . . . N MAGPSET,RAPRTSET,ACN,OK S OK=0
  1. . . . S RAPRTSET=0 D EN2^RAUTL20(.MAGPSET) I RAPRTSET D
  1. . . . . N I,T ; P133 mod for MAGPSET Data ex.--Old= 256^154^190^4 SSAN= 660-080504-256^154^190^4
  1. . . . . S I=0 F S I=$O(MAGPSET(I)) Q:'I S T=$P(MAGPSET(I),U) I $P(T,"-",$L(T,"-"))=CKACN S OK=1 Q
  1. . . . I 'OK S MIXEDUP=5_U_CKACN_U_$P(RADATA,U,8)
  1. I $D(^RARPT(+RARPT,2005)) S IEN=0 D G CK2:MIXEDUP
  1. . F S IEN=$O(^RARPT(RARPT,2005,IEN)) Q:'IEN S MAGIEN=+$G(^(IEN,0)) D Q:MIXEDUP
  1. . . S X=$P($G(^MAG(2005,MAGIEN,0)),U,7) I X'=RADFN S MIXEDUP=2_U_+X Q
  1. . . S X=$P($G(^MAG(2005,MAGIEN,2)),U,7) I X'=RARPT S MIXEDUP=3_U_+X Q
  1. CK2 I 'MIXEDUP Q ; no problems detected
  1. I +MIXEDUP=1!(+MIXEDUP=2) D Q
  1. . S X=$$PNAM^MAGJEX1($P(MIXEDUP,U,2))
  1. . I +MIXEDUP=1 S REPLY="The Exam file for this exam has patient "_$$PNAM^MAGJEX1(RADFN)_"; the corresponding Report file has patient "_X_". This is a serious problem--immediately report it to Radiology management and Imaging support!"
  1. . I +MIXEDUP=2 S REPLY="This exam is registered for "_$$PNAM^MAGJEX1(RADFN)_"; however, it is linked to images for patient "_X_". This is a serious problem--immediately report it to Radiology management and Imaging support staff!"
  1. I +MIXEDUP=3 D Q
  1. . N T S T=$P(MIXEDUP,U,2) S:'T T="Missing Link"
  1. . S REPLY="This exam is linked to Report entry #"_RARPT_", but some of its images may be linked to Report entry #"_T_". This is a potentially serious problem--immediately report it to Radiology management and Imaging support staff!"
  1. I +MIXEDUP=4 D Q
  1. . N T S T=$P(MIXEDUP,U,2) S:'T T="Missing Reference"
  1. . S X=" ("_RARPT_" and "_T_" )"
  1. . S REPLY="This exam has problems in the Radiology Report file, with two different report entries referenced"_X_". This is a potentially serious problem--immediately report it to Radiology management and Imaging support staff!"
  1. I +MIXEDUP=5 D Q
  1. . N T S X=$P(MIXEDUP,U,2) S:X="" X="Missing"
  1. . S T=$P(MIXEDUP,U,3) S:T="" T="Missing"
  1. . S X=" ("_X_" and "_T_") "
  1. . S REPLY="This exam has problems in the Radiology files, with two different Case Numbers referenced"_X_". This is a potentially serious problem--immediately report it to Radiology management and Imaging support staff!"
  1. Q
  1. ;
  1. ERR ;
  1. S @MAGRPTY@(0)="0^ERROR "_$$EC^%ZOSV
  1. D @^%ZOSF("ERRTN")
  1. Q:$Q 1 Q
  1. END ;