- 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 Feb 18, 2025@23:33:21 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 ;