| 1 | MAGJRPT ;WIRMFO/JHC-Display Rad reports ; 15 OCT 2004 10:02 AM
|
|---|
| 2 | ;;3.0;IMAGING;**18**;Mar 07, 2006
|
|---|
| 3 | ;; +---------------------------------------------------------------+
|
|---|
| 4 | ;; | Property of the US Government. |
|
|---|
| 5 | ;; | No permission to copy or redistribute this software is given. |
|
|---|
| 6 | ;; | Use of unreleased versions of this software requires the user |
|
|---|
| 7 | ;; | to execute a written test agreement with the VistA Imaging |
|
|---|
| 8 | ;; | Development Office of the Department of Veterans Affairs, |
|
|---|
| 9 | ;; | telephone (301) 734-0100. |
|
|---|
| 10 | ;; | |
|
|---|
| 11 | ;; | The Food and Drug Administration classifies this software as |
|
|---|
| 12 | ;; | a medical device. As such, it may not be changed in any way. |
|
|---|
| 13 | ;; | Modifications to this software may result in an adulterated |
|
|---|
| 14 | ;; | medical device under 21CFR820, the use of which is considered |
|
|---|
| 15 | ;; | to be a violation of US Federal Statutes. |
|
|---|
| 16 | ;; +---------------------------------------------------------------+
|
|---|
| 17 | ;;
|
|---|
| 18 | ; Subroutines for fetching Exam Info for VistaRad Workstation
|
|---|
| 19 | ; RADRPT: Display Radiology Report -- RPC Call: MAGJ EXAM REPORT
|
|---|
| 20 | ; ORD: Display Radiology Requisition -- RPC Call: MAGJ RADORDERDISP
|
|---|
| 21 | ;
|
|---|
| 22 | Q
|
|---|
| 23 | ORD(MAGRPTY,DATA) ; Radiology Order Display
|
|---|
| 24 | ; RPC Call: MAGJ RADORDERDISP
|
|---|
| 25 | ; MAGRPTY holds indirect reference to returned data
|
|---|
| 26 | ;
|
|---|
| 27 | S MAGRPTY=$NA(^TMP($J,"WSDAT")) K @MAGRPTY
|
|---|
| 28 | N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJRPT"
|
|---|
| 29 | N RARPT,RADFN,RADTI,RACNI,RAPGE,RAX,RAOIFN
|
|---|
| 30 | N REPLY,POP,DFN,COMPLIC,XX,HDR,MAGRET,REQONLY
|
|---|
| 31 | S REPLY="0^4~Attempting to display order info"
|
|---|
| 32 | D OPENDEV
|
|---|
| 33 | I POP S REPLY="0^4~Unable to open device 'IMAGING WORKSTATION'" G ORDZ
|
|---|
| 34 | S RADFN=$P(DATA,U),RADTI=$P(DATA,U,2),RACNI=$P(DATA,U,3)
|
|---|
| 35 | S RARPT=+$P(DATA,U,4),REQONLY=+$P(DATA,U,1,5)
|
|---|
| 36 | I RADFN,RADTI,RACNI
|
|---|
| 37 | E S REPLY="0^4~Request Contains Invalid Case Pointer ("_RADFN_" "_RADTI_" "_RACNI_" "_RARPT_")." G ORDZ
|
|---|
| 38 | S RAOIFN=$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),U,11)
|
|---|
| 39 | I RAOIFN,$D(^RAO(75.1,RAOIFN,0))
|
|---|
| 40 | E S REPLY="0^2~Order Information is NOT Available for this exam." G ORDZ
|
|---|
| 41 | ; Check for Database integrity problems ONLY if Req was explicitly
|
|---|
| 42 | ; requested (No check for Auto_Display of Req, cuz Exam Open does ck)
|
|---|
| 43 | D GETEXAM2^MAGJUTL1(RADFN,RADTI,RACNI,"",.MAGRET)
|
|---|
| 44 | S RADATA=$G(^TMP($J,"MAGRAEX",1,1)),XX=$G(^(2)),HDR=""
|
|---|
| 45 | S COMPLIC=$P(XX,U,4) ; Complications text
|
|---|
| 46 | F I=4,12,9 S HDR=HDR_$P(RADATA,U,I)_" " ; PtName, Case #, Procedure
|
|---|
| 47 | I REQONLY D CKINTEG(.REPLY,RADFN,RADTI,RACNI,RARPT,RADATA) I REPLY]"" S REPLY="0^7~"_REPLY G ORDZ ; Database integrity problems
|
|---|
| 48 | S RAX="",RAPGE=0 D ^RAORD5
|
|---|
| 49 | D:IO'=IO(0) ^%ZISC
|
|---|
| 50 | S @MAGRPTY@(1)="REQ: "_HDR
|
|---|
| 51 | D COMMENTS(RADFN,RADTI,RACNI,MAGRPTY,2,COMPLIC)
|
|---|
| 52 | S REPLY="1^OK"
|
|---|
| 53 | K ^TMP($J,"MAGRAEX")
|
|---|
| 54 | ORDZ S @MAGRPTY@(0)=REPLY
|
|---|
| 55 | Q
|
|---|
| 56 | ;
|
|---|
| 57 | COMMENTS(RADFN,RADTI,RACNI,MAGRPTY,DNODE,COMPLIC) ; add Complications & Tech Comments to output report
|
|---|
| 58 | ; RADFN, RADTI, & RACNI identify exam
|
|---|
| 59 | ; MAGRPTY is indirect reference wher output lines are to be stored
|
|---|
| 60 | ; DNODE holds reference for starting node for lines of output
|
|---|
| 61 | ; COMPLIC passes in complications data reference
|
|---|
| 62 | ;
|
|---|
| 63 | I +MAGJOB("USER",1) ; Radiologist
|
|---|
| 64 | E I $D(^VA(200,"ARC","T",+DUZ)) ; Rad Tech
|
|---|
| 65 | E Q ; Don't display for any other user type
|
|---|
| 66 | N QTMP,CT,XX S CT=0
|
|---|
| 67 | S @MAGRPTY@(DNODE)=" ",CT=CT+.01,@MAGRPTY@(DNODE+CT)="Complications: "_$S(COMPLIC:$P($G(^RA(78.1,+COMPLIC,0)),U),1:"")
|
|---|
| 68 | S X=$P(COMPLIC,"~",2)
|
|---|
| 69 | I X S CT=CT+.01,@MAGRPTY@(DNODE+CT)=" "_$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"COMP")),U)
|
|---|
| 70 | K ^TMP($J,"RAE2") D SVTCOM^RAUTL11(RADFN,RADTI,RACNI)
|
|---|
| 71 | S QTMP="^TMP($J,""RAE2"")"
|
|---|
| 72 | F S QTMP=$Q(@QTMP) Q:QTMP="" Q:QTMP'["RAE2" I QTMP["TCOM" D
|
|---|
| 73 | . S XX=@(QTMP) N HI,TXT,LINE1 S LINE1=0
|
|---|
| 74 | . 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
|
|---|
| 75 | .. S TXT=$S('LINE1:"Tech Comments: ",1:" ")_$E(XX,1,I),XX=$E(XX,I+1,999),LINE1=1
|
|---|
| 76 | .. I XX]"" F I=1:1:999 I $E(XX,I)'=" " S XX=$E(XX,I,999) Q
|
|---|
| 77 | .. S CT=CT+.01,@MAGRPTY@(DNODE+CT)=TXT
|
|---|
| 78 | K ^TMP($J,"RAE2")
|
|---|
| 79 | Q
|
|---|
| 80 | ;
|
|---|
| 81 | OPENDEV ;
|
|---|
| 82 | N IOP
|
|---|
| 83 | S IOP="IMAGING WORKSTATION",%ZIS=0 D ^%ZIS
|
|---|
| 84 | I POP
|
|---|
| 85 | E U IO
|
|---|
| 86 | Q
|
|---|
| 87 | ;
|
|---|
| 88 | ;
|
|---|
| 89 | RADRPT(MAGRPTY,DATA) ; Display rad report; 1st must pass integrity checks
|
|---|
| 90 | ; Note: adds an additional line of output for the Report Window header
|
|---|
| 91 | ; RPC is MAGJ EXAM REPORT
|
|---|
| 92 | ;
|
|---|
| 93 | ; MAGRPTY holds $NA reference to return message; references to it use subscript indirection
|
|---|
| 94 | ;
|
|---|
| 95 | S MAGRPTY=$NA(^TMP($J,"WSDAT")) K @MAGRPTY
|
|---|
| 96 | N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJRPT"
|
|---|
| 97 | N RARPT,RADATA,MAGDFN,MAGDTI,MAGCNI,X,MAGRET,HDR,REPLY,POP,MAGPRC,COMPLIC
|
|---|
| 98 | S MAGDFN=$P(DATA,U),MAGDTI=$P(DATA,U,2),MAGCNI=$P(DATA,U,3),RARPT=+$P(DATA,U,4)
|
|---|
| 99 | I '(MAGDFN&MAGDTI&MAGCNI) D G RPTZ
|
|---|
| 100 | . S REPLY="0^4~Request Contains Invalid Case Pointer ("_MAGDFN_" "_MAGDTI_" "_MAGCNI_")."
|
|---|
| 101 | D GETEXAM2^MAGJUTL1(MAGDFN,MAGDTI,MAGCNI,"",.MAGRET)
|
|---|
| 102 | S RADATA=$G(^TMP($J,"MAGRAEX",1,1)),XX=$G(^(2)),HDR=""
|
|---|
| 103 | S COMPLIC=$P(XX,U,4) ; Complications text
|
|---|
| 104 | F I=4,12,9 S HDR=HDR_$P(RADATA,U,I)_" "
|
|---|
| 105 | D CKINTEG(.REPLY,MAGDFN,MAGDTI,MAGCNI,RARPT,RADATA)
|
|---|
| 106 | I REPLY]"" S REPLY="0^7~"_REPLY G RPTZ ; DB integ problem
|
|---|
| 107 | D OPENDEV
|
|---|
| 108 | I POP S REPLY="0^4~Unable to open device 'IMAGING WORKSTATION'" G RPTZ
|
|---|
| 109 | D EN3^RAO7PC3(MAGDFN_"^"_MAGDTI_"^"_MAGCNI)
|
|---|
| 110 | I '$D(^TMP($J,"RAE3")) S REPLY="0^4~No report on file." G RPTZ
|
|---|
| 111 | D COMMENTS(MAGDFN,MAGDTI,MAGCNI,MAGRPTY,2,COMPLIC)
|
|---|
| 112 | S MAGPRC=$O(^TMP($J,"RAE3",MAGDFN,MAGCNI,"")),I=0
|
|---|
| 113 | F S I=$O(^TMP($J,"RAE3",MAGDFN,MAGCNI,MAGPRC,I)) Q:'I W !,$G(^TMP($J,"RAE3",MAGDFN,MAGCNI,MAGPRC,I))
|
|---|
| 114 | D:IO'=IO(0) ^%ZISC
|
|---|
| 115 | S REPLY="1^1~Radiology Report"
|
|---|
| 116 | RPTZ S @MAGRPTY@(0)=REPLY
|
|---|
| 117 | I +$G(@MAGRPTY@(0)) S @MAGRPTY@(1)="RPT: "_HDR ; if a report exists, add header line to output
|
|---|
| 118 | K ^TMP($J,"MAGRAEX"),^("RAE3")
|
|---|
| 119 | Q
|
|---|
| 120 | ;
|
|---|
| 121 | CKINTEG(REPLY,RADFN,RADTI,RACNI,RARPT,RADATA) ; check integrity between Exam, Report, and Image Group Headers
|
|---|
| 122 | ; This subroutine is used by other vrad programs
|
|---|
| 123 | ;
|
|---|
| 124 | N IEN,MAGIEN,MIXEDUP,X,CKDFN,CKACN
|
|---|
| 125 | S MIXEDUP=0,REPLY=""
|
|---|
| 126 | I RARPT D G CK2:MIXEDUP
|
|---|
| 127 | . S X=$G(^RARPT(RARPT,0)),CKDFN=$P(X,U,2),CKACN=$P(X,U,4)
|
|---|
| 128 | . I CKDFN'=RADFN S MIXEDUP=1_U_+CKDFN Q
|
|---|
| 129 | . I $G(RADATA)]"" D
|
|---|
| 130 | .. I $P(RADATA,U,8)'=CKACN D
|
|---|
| 131 | ... N MAGPSET,RAPRTSET,ACN,OK S OK=0
|
|---|
| 132 | ... S RAPRTSET=0 D EN2^RAUTL20(.MAGPSET) I RAPRTSET D
|
|---|
| 133 | .... N I S I=0 F S I=$O(MAGPSET(I)) Q:'I I +MAGPSET(I)=CKACN S OK=1 Q
|
|---|
| 134 | ... I 'OK S MIXEDUP=5_U_CKACN_U_$P(RADATA,U,8)
|
|---|
| 135 | I $D(^RARPT(+RARPT,2005)) S IEN=0 D G CK2:MIXEDUP
|
|---|
| 136 | . F S IEN=$O(^RARPT(RARPT,2005,IEN)) Q:'IEN S MAGIEN=+$G(^(IEN,0)) D Q:MIXEDUP
|
|---|
| 137 | .. S X=$P($G(^MAG(2005,MAGIEN,0)),U,7) I X'=RADFN S MIXEDUP=2_U_+X Q
|
|---|
| 138 | .. S X=$P($G(^MAG(2005,MAGIEN,2)),U,7) I X'=RARPT S MIXEDUP=3_U_+X Q
|
|---|
| 139 | CK2 I 'MIXEDUP Q ; no problems detected
|
|---|
| 140 | I +MIXEDUP=1!(+MIXEDUP=2) D Q
|
|---|
| 141 | . S X=$$PNAM^MAGJEX1($P(MIXEDUP,U,2))
|
|---|
| 142 | . 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!"
|
|---|
| 143 | . 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!"
|
|---|
| 144 | I +MIXEDUP=3 D Q
|
|---|
| 145 | . N T S T=$P(MIXEDUP,U,2) S:'T T="Missing Link"
|
|---|
| 146 | . 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!"
|
|---|
| 147 | I +MIXEDUP=4 D Q
|
|---|
| 148 | . N T S T=$P(MIXEDUP,U,2) S:'T T="Missing Reference"
|
|---|
| 149 | . S X=" ("_RARPT_" and "_T_" )"
|
|---|
| 150 | . 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!"
|
|---|
| 151 | I +MIXEDUP=5 D Q
|
|---|
| 152 | . N T S X=$P(MIXEDUP,U,2) S:X="" X="Missing"
|
|---|
| 153 | . S T=$P(MIXEDUP,U,3) S:T="" T="Missing"
|
|---|
| 154 | . S X=" ("_X_" and "_T_") "
|
|---|
| 155 | . 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!"
|
|---|
| 156 | Q
|
|---|
| 157 | ;
|
|---|
| 158 | ERR ;
|
|---|
| 159 | S @MAGRPTY@(0)="0^ERROR "_$$EC^%ZOSV
|
|---|
| 160 | D @^%ZOSF("ERRTN")
|
|---|
| 161 | Q:$Q 1 Q
|
|---|
| 162 | END ;
|
|---|
