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

MAGJORD.m

Go to the documentation of this file.
  1. MAGJORD ;WIRMFO/JHC-Display Rad Exam Order info ; 29 Jul 2003 10:02 AM
  1. ;;3.0;IMAGING;**16,22,18**;Mar 07, 2006
  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. ;; | |
  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. 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 ERRA^MAGJORD"
  1. N RARPT,RADFN,RADTI,RACNI,RAPGE,RAX,RAOIFN
  1. N REPLY,POP,DFN,COMPLIC,XX,HDR,MAGRET,REQONLY
  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,1,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. F I=4,12,9 S HDR=HDR_$P(RADATA,U,I)_" " ; PtName, Case #, Procedure
  1. I REQONLY D CKINTEG^MAGJRPT(.REPLY,RADFN,RADTI,RACNI,RARPT,RADATA) I REPLY]"" S REPLY="0^7~"_REPLY G ORDZ ; Database integrity problems
  1. S RAX="",RAPGE=0 D ^RAORD5
  1. D:IO'=IO(0) ^%ZISC
  1. S @MAGRPTY@(1)="REQ: "_HDR
  1. D COMMENTS(RADFN,RADTI,RACNI,MAGRPTY,2,COMPLIC)
  1. S REPLY="1^OK"
  1. K ^TMP($J,"MAGRAEX")
  1. ORDZ S @MAGRPTY@(0)=REPLY
  1. Q
  1. ;
  1. COMMENTS(RADFN,RADTI,RACNI,MAGRPTY,DNODE,COMPLIC) ; add Complications & Tech Comments to output report
  1. ; also called by Rad Report display (magjlst1)
  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. ;
  1. I +MAGJOB("USER",1) ; Radiologist
  1. E I $D(^VA(200,"ARC","T",+DUZ)) ; Rad Tech
  1. E Q ; Don't display for any other user type
  1. N QTMP,CT,XX S CT=0
  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. Q
  1. ;
  1. OPENDEV ;
  1. S IOP="IMAGING WORKSTATION",%ZIS=0 D ^%ZIS
  1. I POP
  1. E U IO
  1. Q
  1. ERRA ;
  1. S @MAGRPTY@(0)="0^ERROR "_$$EC^%ZOSV
  1. D @^%ZOSF("ERRTN")
  1. Q:$Q 1 Q
  1. END ;