MAGJORD ;WIRMFO/JHC-Display Rad Exam Order info ; 29 Jul 2003 10:02 AM
;;3.0;IMAGING;**16,22,18**;Mar 07, 2006
;; +---------------------------------------------------------------+
;; | Property of the US Government. |
;; | No permission to copy or redistribute this software is given. |
;; | Use of unreleased versions of this software requires the user |
;; | to execute a written test agreement with the VistA Imaging |
;; | Development Office of the Department of Veterans Affairs, |
;; | telephone (301) 734-0100. |
;; | |
;; | The Food and Drug Administration classifies this software as |
;; | a medical device. As such, it may not be changed in any way. |
;; | Modifications to this software may result in an adulterated |
;; | medical device under 21CFR820, the use of which is considered |
;; | to be a violation of US Federal Statutes. |
;; +---------------------------------------------------------------+
;;
Q
ORD(MAGRPTY,DATA) ; Radiology Order Display
; RPC Call: MAGJ RADORDERDISP
; MAGRPTY holds indirect reference to returned data
;
S MAGRPTY=$NA(^TMP($J,"WSDAT")) K @MAGRPTY
N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGJORD"
N RARPT,RADFN,RADTI,RACNI,RAPGE,RAX,RAOIFN
N REPLY,POP,DFN,COMPLIC,XX,HDR,MAGRET,REQONLY
S REPLY="0^4~Attempting to display order info"
D OPENDEV
I POP S REPLY="0^4~Unable to open device 'IMAGING WORKSTATION'" G ORDZ
S RADFN=$P(DATA,U),RADTI=$P(DATA,U,2),RACNI=$P(DATA,U,3)
S RARPT=+$P(DATA,U,4),REQONLY=+$P(DATA,U,1,5)
I RADFN,RADTI,RACNI
E S REPLY="0^4~Request Contains Invalid Case Pointer ("_RADFN_" "_RADTI_" "_RACNI_" "_RARPT_")." G ORDZ
S RAOIFN=$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),U,11)
I RAOIFN,$D(^RAO(75.1,RAOIFN,0))
E S REPLY="0^2~Order Information is NOT Available for this exam." G ORDZ
; Check for Database integrity problems ONLY if Req was explicitly
; requested (No check for Auto_Display of Req, cuz Exam Open does ck)
D GETEXAM2^MAGJUTL1(RADFN,RADTI,RACNI,"",.MAGRET)
S RADATA=$G(^TMP($J,"MAGRAEX",1,1)),XX=$G(^(2)),HDR=""
S COMPLIC=$P(XX,U,4) ; Complications text
F I=4,12,9 S HDR=HDR_$P(RADATA,U,I)_" " ; PtName, Case #, Procedure
I REQONLY D CKINTEG^MAGJRPT(.REPLY,RADFN,RADTI,RACNI,RARPT,RADATA) I REPLY]"" S REPLY="0^7~"_REPLY G ORDZ ; Database integrity problems
S RAX="",RAPGE=0 D ^RAORD5
D:IO'=IO(0) ^%ZISC
S @MAGRPTY@(1)="REQ: "_HDR
D COMMENTS(RADFN,RADTI,RACNI,MAGRPTY,2,COMPLIC)
S REPLY="1^OK"
K ^TMP($J,"MAGRAEX")
ORDZ S @MAGRPTY@(0)=REPLY
Q
;
; also called by Rad Report display (magjlst1)
; RADFN, RADTI, & RACNI identify exam
; MAGRPTY is indirect reference wher output lines are to be stored
; DNODE holds reference for starting node for lines of output
; COMPLIC passes in complications data reference
;
I +MAGJOB("USER",1) ; Radiologist
E I $D(^VA(200,"ARC","T",+DUZ)) ; Rad Tech
E Q ; Don't display for any other user type
N QTMP,CT,XX S CT=0
S @MAGRPTY@(DNODE)=" ",CT=CT+.01,@MAGRPTY@(DNODE+CT)="Complications: "_$S(COMPLIC:$P($G(^RA(78.1,+COMPLIC,0)),U),1:"")
S X=$P(COMPLIC,"~",2)
I X S CT=CT+.01,@MAGRPTY@(DNODE+CT)=" "_$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"COMP")),U)
K ^TMP($J,"RAE2") D SVTCOM^RAUTL11(RADFN,RADTI,RACNI)
S QTMP="^TMP($J,""RAE2"")"
F S QTMP=$Q(@QTMP) Q:QTMP="" Q:QTMP'["RAE2" I QTMP["TCOM" D
. S XX=@(QTMP) N HI,TXT,LINE1 S LINE1=0
. 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
.. S TXT=$S('LINE1:"Tech Comments: ",1:" ")_$E(XX,1,I),XX=$E(XX,I+1,999),LINE1=1
.. I XX]"" F I=1:1:999 I $E(XX,I)'=" " S XX=$E(XX,I,999) Q
.. S CT=CT+.01,@MAGRPTY@(DNODE+CT)=TXT
K ^TMP($J,"RAE2")
Q
;
OPENDEV ;
S IOP="IMAGING WORKSTATION",%ZIS=0 D ^%ZIS
I POP
E U IO
Q
ERRA ;
S @MAGRPTY@(0)="0^ERROR "_$$EC^%ZOSV
D @^%ZOSF("ERRTN")
Q:$Q 1 Q
END ;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGJORD 4152 printed Dec 13, 2024@02:06:52 Page 2
MAGJORD ;WIRMFO/JHC-Display Rad Exam Order info ; 29 Jul 2003 10:02 AM
+1 ;;3.0;IMAGING;**16,22,18**;Mar 07, 2006
+2 ;; +---------------------------------------------------------------+
+3 ;; | Property of the US Government. |
+4 ;; | No permission to copy or redistribute this software is given. |
+5 ;; | Use of unreleased versions of this software requires the user |
+6 ;; | to execute a written test agreement with the VistA Imaging |
+7 ;; | Development Office of the Department of Veterans Affairs, |
+8 ;; | telephone (301) 734-0100. |
+9 ;; | |
+10 ;; | The Food and Drug Administration classifies this software as |
+11 ;; | a medical device. As such, it may not be changed in any way. |
+12 ;; | Modifications to this software may result in an adulterated |
+13 ;; | medical device under 21CFR820, the use of which is considered |
+14 ;; | to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
+17 QUIT
ORD(MAGRPTY,DATA) ; Radiology Order Display
+1 ; RPC Call: MAGJ RADORDERDISP
+2 ; MAGRPTY holds indirect reference to returned data
+3 ;
+4 SET MAGRPTY=$NAME(^TMP($JOB,"WSDAT"))
KILL @MAGRPTY
+5 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERRA^MAGJORD"
+6 NEW RARPT,RADFN,RADTI,RACNI,RAPGE,RAX,RAOIFN
+7 NEW REPLY,POP,DFN,COMPLIC,XX,HDR,MAGRET,REQONLY
+8 SET REPLY="0^4~Attempting to display order info"
+9 DO OPENDEV
+10 IF POP
SET REPLY="0^4~Unable to open device 'IMAGING WORKSTATION'"
GOTO ORDZ
+11 SET RADFN=$PIECE(DATA,U)
SET RADTI=$PIECE(DATA,U,2)
SET RACNI=$PIECE(DATA,U,3)
+12 SET RARPT=+$PIECE(DATA,U,4)
SET REQONLY=+$PIECE(DATA,U,1,5)
+13 IF RADFN
IF RADTI
IF RACNI
+14 IF '$TEST
SET REPLY="0^4~Request Contains Invalid Case Pointer ("_RADFN_" "_RADTI_" "_RACNI_" "_RARPT_")."
GOTO ORDZ
+15 SET RAOIFN=$PIECE($GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),U,11)
+16 IF RAOIFN
IF $DATA(^RAO(75.1,RAOIFN,0))
+17 IF '$TEST
SET REPLY="0^2~Order Information is NOT Available for this exam."
GOTO ORDZ
+18 ; Check for Database integrity problems ONLY if Req was explicitly
+19 ; requested (No check for Auto_Display of Req, cuz Exam Open does ck)
+20 DO GETEXAM2^MAGJUTL1(RADFN,RADTI,RACNI,"",.MAGRET)
+21 SET RADATA=$GET(^TMP($JOB,"MAGRAEX",1,1))
SET XX=$GET(^(2))
SET HDR=""
+22 ; Complications text
SET COMPLIC=$PIECE(XX,U,4)
+23 ; PtName, Case #, Procedure
FOR I=4,12,9
SET HDR=HDR_$PIECE(RADATA,U,I)_" "
+24 ; Database integrity problems
IF REQONLY
DO CKINTEG^MAGJRPT(.REPLY,RADFN,RADTI,RACNI,RARPT,RADATA)
IF REPLY]""
SET REPLY="0^7~"_REPLY
GOTO ORDZ
+25 SET RAX=""
SET RAPGE=0
DO ^RAORD5
+26 if IO'=IO(0)
DO ^%ZISC
+27 SET @MAGRPTY@(1)="REQ: "_HDR
+28 DO COMMENTS(RADFN,RADTI,RACNI,MAGRPTY,2,COMPLIC)
+29 SET REPLY="1^OK"
+30 KILL ^TMP($JOB,"MAGRAEX")
ORDZ SET @MAGRPTY@(0)=REPLY
+1 QUIT
+2 ;
+1 ; also called by Rad Report display (magjlst1)
+2 ; RADFN, RADTI, & RACNI identify exam
+3 ; MAGRPTY is indirect reference wher output lines are to be stored
+4 ; DNODE holds reference for starting node for lines of output
+5 ; COMPLIC passes in complications data reference
+6 ;
+7 ; Radiologist
IF +MAGJOB("USER",1)
+8 ; Rad Tech
IF '$TEST
IF $DATA(^VA(200,"ARC","T",+DUZ))
+9 ; Don't display for any other user type
IF '$TEST
QUIT
+10 NEW QTMP,CT,XX
SET CT=0
+11 SET @MAGRPTY@(DNODE)=" "
SET CT=CT+.01
SET @MAGRPTY@(DNODE+CT)="Complications: "_$SELECT(COMPLIC:$PIECE($GET(^RA(78.1,+COMPLIC,0)),U),1:"")
+12 SET X=$PIECE(COMPLIC,"~",2)
+13 IF X
SET CT=CT+.01
SET @MAGRPTY@(DNODE+CT)=" "_$PIECE($GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"COMP")),U)
+14 KILL ^TMP($JOB,"RAE2")
DO SVTCOM^RAUTL11(RADFN,RADTI,RACNI)
+15 SET QTMP="^TMP($J,""RAE2"")"
+16 FOR
SET QTMP=$QUERY(@QTMP)
if QTMP=""
QUIT
if QTMP'["RAE2"
QUIT
IF QTMP["TCOM"
Begin DoDot:1
+17 SET XX=@(QTMP)
NEW HI,TXT,LINE1
SET LINE1=0
+18 FOR
if XX=""
QUIT
SET HI=$LENGTH(XX)
if HI>63
SET HI=63
FOR I=HI:-1:0
if 'I
SET XX=""
IF HI<63!($EXTRACT(XX,I)=" ")
Begin DoDot:2
+19 SET TXT=$SELECT('LINE1:"Tech Comments: ",1:" ")_$EXTRACT(XX,1,I)
SET XX=$EXTRACT(XX,I+1,999)
SET LINE1=1
+20 IF XX]""
FOR I=1:1:999
IF $EXTRACT(XX,I)'=" "
SET XX=$EXTRACT(XX,I,999)
QUIT
+21 SET CT=CT+.01
SET @MAGRPTY@(DNODE+CT)=TXT
End DoDot:2
QUIT
End DoDot:1
+22 KILL ^TMP($JOB,"RAE2")
+23 QUIT
+24 ;
OPENDEV ;
+1 SET IOP="IMAGING WORKSTATION"
SET %ZIS=0
DO ^%ZIS
+2 IF POP
+3 IF '$TEST
USE IO
+4 QUIT
ERRA ;
+1 SET @MAGRPTY@(0)="0^ERROR "_$$EC^%ZOSV
+2 DO @^%ZOSF("ERRTN")
+3 if $QUIT
QUIT 1
QUIT
END ;
