- MAGJRPT ;WIRMFO/JHC - Display Rad reports ; 10/17/2022
- ;;3.0;IMAGING;**18,101,120,133,341**;Dec 21, 2022;Build 28
- ;; Per VHA Directive 2004-038, this routine should not be modified.
- ;; +---------------------------------------------------------------+
- ;; | 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. |
- ;; +---------------------------------------------------------------+
- ;;
- ; Reference to EN2^RAUTL20 in ICR #3270
- ; Reference to EN3^RAO7PC3 #2877
- ; Reference to ^RAORD5 #3513
- ; Reference to SVTCOM^RAUTL11 in ICR #3508
- ; Reference to PHARM^RARTUTL in ICR #5946
- ; Reference to RDIO^RARTUTL in ICR #5946
- ;; ISI IMAGING;**99,104,102**
- ; Subroutines for fetching Exam Info for VistaRad Workstation
- ; RADRPT: Display Radiology Report -- RPC Call: MAGJ EXAM REPORT
- ; ORD: Display Radiology Requisition -- RPC Call: MAGJ RADORDERDISP
- ;
- 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 ERR^MAGJRPT"
- N RARPT,RADFN,RADTI,RACNI,RAPGE,RAX,RAOIFN
- N REPLY,POP,DFN,COMPLIC,XX,HDR,MAGRET,REQONLY,TMPDATA
- N MEDS,RDIOPHARM
- 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,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
- S MEDS=$P(XX,U,14),RDIOPHARM=$P(XX,U,15) ; Medications & RadioPharm indicators
- F I=4,12,9 S HDR=HDR_$P(RADATA,U,I)_" " ; PtName, Case #, Procedure
- S T=$P(XX,U,8) I T]"" S HDR=HDR_" ("_T_")" ; ISI Modifier
- I REQONLY D CKINTEG(.REPLY,RADFN,RADTI,RACNI,RARPT,RADATA) I REPLY]"" S REPLY="0^7~"_REPLY G ORDZ ; Database integrity problems
- S TMPDATA=MAGRPTY_"~"_RADTI_"~"_RACNI
- S RAX="",RAPGE=0 D ^RAORD5
- S MAGRPTY=$P(TMPDATA,"~"),RADTI=$P(TMPDATA,"~",2),RACNI=$P(TMPDATA,"~",3)
- D:IO'=IO(0) ^%ZISC
- S @MAGRPTY@(1)="REQ: "_HDR
- D CLEANUP(MAGRPTY) ; ISI
- D COMMENTS(RADFN,RADTI,RACNI,MAGRPTY,2,COMPLIC,MEDS,RDIOPHARM)
- D TIUNOTE(RARPT,MAGRPTY,10000) ; append TIU note to reply at node 10000
- S REPLY="1^OK"
- K ^TMP($J,"MAGRAEX"),^("RAE2") ; ISI
- ORDZ S @MAGRPTY@(0)=REPLY
- Q
- ;
- CLEANUP(MAGRPTY) ; strip extraneous lines of dashes ; ISI new subrtn
- N HIT,I,X S HIT=0
- S I=20 F S I=$O(@MAGRPTY@(I)) Q:'I S X=^(I) D
- . I $L(X,"-")>20 S HIT=HIT+1 K:(HIT>1) @MAGRPTY@(I)
- . E S HIT=0
- Q
- ;
- ; Add Medications and Radiopharmaceuticals information to output
- ; 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
- ; MEDS passes in Medications indicator
- ; RDIOPHARM passes in Radiopharmaceuticals reference
- ;
- N QTMP,CT,XX,NOTES,NOTESTAT,T S CT=0 ; ISI begin
- D STATUS^ISIJNOTE(.NOTESTAT,RADFN,RADTI,RACNI)
- S T=+$P(NOTESTAT,U,2) I T D
- . S @MAGRPTY@(DNODE)=" ",CT=CT+.01,@MAGRPTY@(DNODE+CT)=" * See "_T_" NOTE"_$S(T-1:"S",1:"")_" at end of report."
- . S @MAGRPTY@(DNODE)=" ",CT=CT+.01,@MAGRPTY@(DNODE+CT)=" "
- . D NOTE^ISIJNOTE(.NOTES,1_U_RADFN_U_RADTI_U_RACNI_U_RARPT)
- . D NOTEDISP(.NOTES,MAGRPTY,5000)
- . K @NOTES ; ISI end
- I +$G(MAGJOB("USER",1)) ; Radiologist ; ISI--for RadTech Tool use
- E I $D(^VA(200,"ARC","T",+DUZ)) ; Rad Tech
- E Q ; Don't display for any other user type
- 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")
- I +$G(MEDS) D
- . N REF,RAUTOE,RAACNT
- . K ^TMP($J,"RA AUTOE")
- . S REF=RACNI_","_RADTI_","_RADFN_","
- . S RAUTOE="" ; if defined, directs output to ^TMP
- . S RAACNT=1000 ; init counter for output to ^TMP
- . D PHARM^RARTUTL(REF) ; get Medications data
- . D PHARMAS("Medications",1001)
- I +$G(RDIOPHARM) D
- . N RAUTOE,RAACNT
- . K ^TMP($J,"RA AUTOE")
- . S RAUTOE="" ; if defined, directs output to ^TMP
- . S RAACNT=1000 ; init counter for output to ^TMP
- . D RDIO^RARTUTL(RDIOPHARM) ; get Radiopharm data
- . D PHARMAS("Radiopharmaceuticals",1001)
- I +$G(MEDS)!+$G(RDIOPHARM) D
- . S CT=CT+.001,@MAGRPTY@(DNODE+CT)=" "_$TR($J(" ",66)," ","_")
- . S CT=CT+.001,@MAGRPTY@(DNODE+CT)=" "
- K ^TMP($J,"RA AUTOE")
- Q
- ;
- PHARMAS(TITLE,NODE) ; output lines of pharma data
- N LINE
- I $D(^TMP($J,"RA AUTOE",NODE)) D
- . S CT=CT+.001,@MAGRPTY@(DNODE+CT)=" "
- . S CT=CT+.001,@MAGRPTY@(DNODE+CT)=" ------------ "_TITLE_" ------------"
- . S CT=CT+.001,@MAGRPTY@(DNODE+CT)=" "
- . F S LINE=^TMP($J,"RA AUTOE",NODE) D S NODE=$O(^TMP($J,"RA AUTOE",NODE)) Q:'NODE
- . . S CT=CT+.001,@MAGRPTY@(DNODE+CT)=LINE
- . Q
- Q
- ;
- NOTEDISP(NOTES,MAGRPTY,DNODE) ; output notes ; ISI new subrtn
- N IP,NOTE,X S NOTE=0
- S DNODE=DNODE+1,@MAGRPTY@(DNODE)=" "
- S DNODE=DNODE+1,@MAGRPTY@(DNODE)="================================== NOTES =================================="
- S DNODE=DNODE+1,@MAGRPTY@(DNODE)=" "
- S IP="" F S IP=$O(@NOTES@(IP)) Q:IP="" S X=(@NOTES@(IP)) D
- . I X="*NOTES" S NOTE=1 Q
- . I NOTE D
- . . I X="*NOTES_END" S NOTE=0 Q
- . . S DNODE=DNODE+1,@MAGRPTY@(DNODE)=X
- Q
- ;
- TIUNOTE(RARPT,MAGRPTY,DNODE) ; FUT-70/IHS append Rad TIU Notes to report
- ; 1/2011--only works at IHS where TIU notes may exist for Radiology exams
- ; test for this by presence of DOCTEXT^BEHOTIU
- ; RARPT--exam pointer
- ; MAGRPTY--indirect reference to output file
- ; DNODE--starting node for lines of output
- ;
- N CT,QTMP,TEXT,XX
- I RARPT,$L(MAGRPTY),DNODE,$L($T(DOCTEXT^BEHOTIU)) D
- . D DOCTEXT^BEHOTIU("TEXT",RARPT_";RARPT(")
- . I $D(TEXT) D
- . . S CT=0,QTMP="TEXT"
- . . S @MAGRPTY@(DNODE)=" "
- . . F S QTMP=$Q(@QTMP) Q:QTMP="" S XX=@(QTMP) S CT=CT+.01,@MAGRPTY@(DNODE+CT)=XX
- Q
- ;
- OPENDEV ;
- N IOP,%ZIS
- S IOP="IMAGING WORKSTATION",%ZIS=0 D ^%ZIS
- I POP
- E U IO
- Q
- ;
- RADRPT(MAGRPTY,DATA) ; Display rad report; 1st must pass integrity checks
- ; Note: adds an additional line of output for the Report Window header
- ; RPC is MAGJ EXAM REPORT
- ;
- ; MAGRPTY holds $NA reference to return message; references to it use subscript indirection
- ;
- S MAGRPTY=$NA(^TMP($J,"MAGJRADRPT")) K @MAGRPTY
- N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJRPT"
- N RARPT,RADATA,MAGDFN,MAGDTI,MAGCNI,X,MAGRET,HDR,REPLY,MAGPRC,COMPLIC,DNODE
- N MEDS,RDIOPHARM
- S MAGDFN=$P(DATA,U),MAGDTI=$P(DATA,U,2),MAGCNI=$P(DATA,U,3),RARPT=+$P(DATA,U,4)
- I '(MAGDFN&MAGDTI&MAGCNI) D G RPTZ
- . S REPLY="0^4~Request Contains Invalid Case Pointer ("_MAGDFN_" "_MAGDTI_" "_MAGCNI_")."
- D GETEXAM2^MAGJUTL1(MAGDFN,MAGDTI,MAGCNI,"",.MAGRET)
- S RADATA=$G(^TMP($J,"MAGRAEX",1,1)),XX=$G(^(2)),HDR=""
- S COMPLIC=$P(XX,U,4) ; Complications text
- S MEDS=$P(XX,U,14),RDIOPHARM=$P(XX,U,15) ; Medications & RadioPharm indicators
- F I=4,12,9 S HDR=HDR_$P(RADATA,U,I)_" "
- S T=$P(XX,U,8) I T]"" S HDR=HDR_" ("_T_")" ; ISI Modifier
- D CKINTEG(.REPLY,MAGDFN,MAGDTI,MAGCNI,RARPT,RADATA)
- I REPLY]"" S REPLY="0^7~"_REPLY G RPTZ ; DB integ problem
- D EN3^RAO7PC3(MAGDFN_"^"_MAGDTI_"^"_MAGCNI)
- I '$D(^TMP($J,"RAE3")) S REPLY="0^4~No report on file." G RPTZ
- D COMMENTS(MAGDFN,MAGDTI,MAGCNI,MAGRPTY,2,COMPLIC,MEDS,RDIOPHARM)
- S MAGPRC=$O(^TMP($J,"RAE3",MAGDFN,MAGCNI,"")),I=0,DNODE=2
- F S I=$O(^TMP($J,"RAE3",MAGDFN,MAGCNI,MAGPRC,I)) Q:'I D
- . S DNODE=DNODE+1
- . S @MAGRPTY@(DNODE)=$G(^TMP($J,"RAE3",MAGDFN,MAGCNI,MAGPRC,I))
- S DNODE=DNODE+1,@MAGRPTY@(DNODE)=" " ; ISI
- S DNODE=DNODE+1,@MAGRPTY@(DNODE)="** END REPORT "_$$FMTE^XLFDT($$NOW^XLFDT,"1P")_" **" ; ISI
- D TIUNOTE(RARPT,MAGRPTY,10000) ; append TIU note to reply at node 10000
- S REPLY="1^1~Radiology Report"
- RPTZ S @MAGRPTY@(0)=REPLY
- I +$G(@MAGRPTY@(0)) S @MAGRPTY@(1)="RPT: "_HDR ; if a report exists, add header line to output
- K ^TMP($J,"MAGRAEX"),^("RAE3")
- Q
- ;
- CKINTEG(REPLY,RADFN,RADTI,RACNI,RARPT,RADATA) ; check integrity between Exam, Report, and Image Group Headers
- ; This subroutine is used by other vrad programs
- ;
- N IEN,MAGIEN,MIXEDUP,X,CKDFN,CKACN
- S MIXEDUP=0,REPLY=""
- I RARPT D G CK2:MIXEDUP
- . S X=$G(^RARPT(RARPT,0)),CKDFN=$P(X,U,2),CKACN=$P(X,U,4)
- . I CKDFN'=RADFN S MIXEDUP=1_U_+CKDFN Q
- . I $G(RADATA)]"" D
- . . I $P(RADATA,U,8)'=CKACN D
- . . . N MAGPSET,RAPRTSET,ACN,OK S OK=0
- . . . S RAPRTSET=0 D EN2^RAUTL20(.MAGPSET) I RAPRTSET D
- . . . . N I,T ; P133 mod for MAGPSET Data ex.--Old= 256^154^190^4 SSAN= 660-080504-256^154^190^4
- . . . . 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
- . . . I 'OK S MIXEDUP=5_U_CKACN_U_$P(RADATA,U,8)
- I $D(^RARPT(+RARPT,2005)) S IEN=0 D G CK2:MIXEDUP
- . F S IEN=$O(^RARPT(RARPT,2005,IEN)) Q:'IEN S MAGIEN=+$G(^(IEN,0)) D Q:MIXEDUP
- . . S X=$P($G(^MAG(2005,MAGIEN,0)),U,7) I X'=RADFN S MIXEDUP=2_U_+X Q
- . . S X=$P($G(^MAG(2005,MAGIEN,2)),U,7) I X'=RARPT S MIXEDUP=3_U_+X Q
- CK2 I 'MIXEDUP Q ; no problems detected
- I +MIXEDUP=1!(+MIXEDUP=2) D Q
- . S X=$$PNAM^MAGJEX1($P(MIXEDUP,U,2))
- . 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!"
- . 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!"
- I +MIXEDUP=3 D Q
- . N T S T=$P(MIXEDUP,U,2) S:'T T="Missing Link"
- . 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!"
- I +MIXEDUP=4 D Q
- . N T S T=$P(MIXEDUP,U,2) S:'T T="Missing Reference"
- . S X=" ("_RARPT_" and "_T_" )"
- . 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!"
- I +MIXEDUP=5 D Q
- . N T S X=$P(MIXEDUP,U,2) S:X="" X="Missing"
- . S T=$P(MIXEDUP,U,3) S:T="" T="Missing"
- . S X=" ("_X_" and "_T_") "
- . 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!"
- Q
- ;
- ERR ;
- S @MAGRPTY@(0)="0^ERROR "_$$EC^%ZOSV
- D @^%ZOSF("ERRTN")
- Q:$Q 1 Q
- END ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGJRPT 12691 printed Feb 18, 2025@23:33:23 Page 2
- MAGJRPT ;WIRMFO/JHC - Display Rad reports ; 10/17/2022
- +1 ;;3.0;IMAGING;**18,101,120,133,341**;Dec 21, 2022;Build 28
- +2 ;; Per VHA Directive 2004-038, this routine should not be modified.
- +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 ;; | 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 ; Reference to EN2^RAUTL20 in ICR #3270
- +18 ; Reference to EN3^RAO7PC3 #2877
- +19 ; Reference to ^RAORD5 #3513
- +20 ; Reference to SVTCOM^RAUTL11 in ICR #3508
- +21 ; Reference to PHARM^RARTUTL in ICR #5946
- +22 ; Reference to RDIO^RARTUTL in ICR #5946
- +23 ;; ISI IMAGING;**99,104,102**
- +24 ; Subroutines for fetching Exam Info for VistaRad Workstation
- +25 ; RADRPT: Display Radiology Report -- RPC Call: MAGJ EXAM REPORT
- +26 ; ORD: Display Radiology Requisition -- RPC Call: MAGJ RADORDERDISP
- +27 ;
- +28 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 ERR^MAGJRPT"
- +6 NEW RARPT,RADFN,RADTI,RACNI,RAPGE,RAX,RAOIFN
- +7 NEW REPLY,POP,DFN,COMPLIC,XX,HDR,MAGRET,REQONLY,TMPDATA
- +8 NEW MEDS,RDIOPHARM
- +9 SET REPLY="0^4~Attempting to display order info"
- +10 DO OPENDEV
- +11 IF POP
- SET REPLY="0^4~Unable to open device 'IMAGING WORKSTATION'"
- GOTO ORDZ
- +12 SET RADFN=$PIECE(DATA,U)
- SET RADTI=$PIECE(DATA,U,2)
- SET RACNI=$PIECE(DATA,U,3)
- +13 SET RARPT=+$PIECE(DATA,U,4)
- SET REQONLY=+$PIECE(DATA,U,5)
- +14 IF RADFN
- IF RADTI
- IF RACNI
- +15 IF '$TEST
- SET REPLY="0^4~Request Contains Invalid Case Pointer ("_RADFN_" "_RADTI_" "_RACNI_" "_RARPT_")."
- GOTO ORDZ
- +16 SET RAOIFN=$PIECE($GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),U,11)
- +17 IF RAOIFN
- IF $DATA(^RAO(75.1,RAOIFN,0))
- +18 IF '$TEST
- SET REPLY="0^2~Order Information is NOT Available for this exam."
- GOTO ORDZ
- +19 ; Check for Database integrity problems ONLY if Req was explicitly
- +20 ; requested (No check for Auto_Display of Req, cuz Exam Open does ck)
- +21 DO GETEXAM2^MAGJUTL1(RADFN,RADTI,RACNI,"",.MAGRET)
- +22 SET RADATA=$GET(^TMP($JOB,"MAGRAEX",1,1))
- SET XX=$GET(^(2))
- SET HDR=""
- +23 ; Complications text
- SET COMPLIC=$PIECE(XX,U,4)
- +24 ; Medications & RadioPharm indicators
- SET MEDS=$PIECE(XX,U,14)
- SET RDIOPHARM=$PIECE(XX,U,15)
- +25 ; PtName, Case #, Procedure
- FOR I=4,12,9
- SET HDR=HDR_$PIECE(RADATA,U,I)_" "
- +26 ; ISI Modifier
- SET T=$PIECE(XX,U,8)
- IF T]""
- SET HDR=HDR_" ("_T_")"
- +27 ; Database integrity problems
- IF REQONLY
- DO CKINTEG(.REPLY,RADFN,RADTI,RACNI,RARPT,RADATA)
- IF REPLY]""
- SET REPLY="0^7~"_REPLY
- GOTO ORDZ
- +28 SET TMPDATA=MAGRPTY_"~"_RADTI_"~"_RACNI
- +29 SET RAX=""
- SET RAPGE=0
- DO ^RAORD5
- +30 SET MAGRPTY=$PIECE(TMPDATA,"~")
- SET RADTI=$PIECE(TMPDATA,"~",2)
- SET RACNI=$PIECE(TMPDATA,"~",3)
- +31 if IO'=IO(0)
- DO ^%ZISC
- +32 SET @MAGRPTY@(1)="REQ: "_HDR
- +33 ; ISI
- DO CLEANUP(MAGRPTY)
- +34 DO COMMENTS(RADFN,RADTI,RACNI,MAGRPTY,2,COMPLIC,MEDS,RDIOPHARM)
- +35 ; append TIU note to reply at node 10000
- DO TIUNOTE(RARPT,MAGRPTY,10000)
- +36 SET REPLY="1^OK"
- +37 ; ISI
- KILL ^TMP($JOB,"MAGRAEX"),^("RAE2")
- ORDZ SET @MAGRPTY@(0)=REPLY
- +1 QUIT
- +2 ;
- CLEANUP(MAGRPTY) ; strip extraneous lines of dashes ; ISI new subrtn
- +1 NEW HIT,I,X
- SET HIT=0
- +2 SET I=20
- FOR
- SET I=$ORDER(@MAGRPTY@(I))
- if 'I
- QUIT
- SET X=^(I)
- Begin DoDot:1
- +3 IF $LENGTH(X,"-")>20
- SET HIT=HIT+1
- if (HIT>1)
- KILL @MAGRPTY@(I)
- +4 IF '$TEST
- SET HIT=0
- End DoDot:1
- +5 QUIT
- +6 ;
- +1 ; Add Medications and Radiopharmaceuticals information to output
- +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 ; MEDS passes in Medications indicator
- +7 ; RDIOPHARM passes in Radiopharmaceuticals reference
- +8 ;
- +9 ; ISI begin
- NEW QTMP,CT,XX,NOTES,NOTESTAT,T
- SET CT=0
- +10 DO STATUS^ISIJNOTE(.NOTESTAT,RADFN,RADTI,RACNI)
- +11 SET T=+$PIECE(NOTESTAT,U,2)
- IF T
- Begin DoDot:1
- +12 SET @MAGRPTY@(DNODE)=" "
- SET CT=CT+.01
- SET @MAGRPTY@(DNODE+CT)=" * See "_T_" NOTE"_$SELECT(T-1:"S",1:"")_" at end of report."
- +13 SET @MAGRPTY@(DNODE)=" "
- SET CT=CT+.01
- SET @MAGRPTY@(DNODE+CT)=" "
- +14 DO NOTE^ISIJNOTE(.NOTES,1_U_RADFN_U_RADTI_U_RACNI_U_RARPT)
- +15 DO NOTEDISP(.NOTES,MAGRPTY,5000)
- +16 ; ISI end
- KILL @NOTES
- End DoDot:1
- +17 ; Radiologist ; ISI--for RadTech Tool use
- IF +$GET(MAGJOB("USER",1))
- +18 ; Rad Tech
- IF '$TEST
- IF $DATA(^VA(200,"ARC","T",+DUZ))
- +19 ; Don't display for any other user type
- IF '$TEST
- QUIT
- +20 SET @MAGRPTY@(DNODE)=" "
- SET CT=CT+.01
- SET @MAGRPTY@(DNODE+CT)="Complications: "_$SELECT(COMPLIC:$PIECE($GET(^RA(78.1,+COMPLIC,0)),U),1:"")
- +21 SET X=$PIECE(COMPLIC,"~",2)
- +22 IF X
- SET CT=CT+.01
- SET @MAGRPTY@(DNODE+CT)=" "_$PIECE($GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"COMP")),U)
- +23 KILL ^TMP($JOB,"RAE2")
- DO SVTCOM^RAUTL11(RADFN,RADTI,RACNI)
- +24 SET QTMP="^TMP($J,""RAE2"")"
- +25 FOR
- SET QTMP=$QUERY(@QTMP)
- if QTMP=""
- QUIT
- if QTMP'["RAE2"
- QUIT
- IF QTMP["TCOM"
- Begin DoDot:1
- +26 SET XX=@(QTMP)
- NEW HI,TXT,LINE1
- SET LINE1=0
- +27 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
- +28 SET TXT=$SELECT('LINE1:"Tech Comments: ",1:" ")_$EXTRACT(XX,1,I)
- SET XX=$EXTRACT(XX,I+1,999)
- SET LINE1=1
- +29 IF XX]""
- FOR I=1:1:999
- IF $EXTRACT(XX,I)'=" "
- SET XX=$EXTRACT(XX,I,999)
- QUIT
- +30 SET CT=CT+.01
- SET @MAGRPTY@(DNODE+CT)=TXT
- End DoDot:2
- QUIT
- End DoDot:1
- +31 KILL ^TMP($JOB,"RAE2")
- +32 IF +$GET(MEDS)
- Begin DoDot:1
- +33 NEW REF,RAUTOE,RAACNT
- +34 KILL ^TMP($JOB,"RA AUTOE")
- +35 SET REF=RACNI_","_RADTI_","_RADFN_","
- +36 ; if defined, directs output to ^TMP
- SET RAUTOE=""
- +37 ; init counter for output to ^TMP
- SET RAACNT=1000
- +38 ; get Medications data
- DO PHARM^RARTUTL(REF)
- +39 DO PHARMAS("Medications",1001)
- End DoDot:1
- +40 IF +$GET(RDIOPHARM)
- Begin DoDot:1
- +41 NEW RAUTOE,RAACNT
- +42 KILL ^TMP($JOB,"RA AUTOE")
- +43 ; if defined, directs output to ^TMP
- SET RAUTOE=""
- +44 ; init counter for output to ^TMP
- SET RAACNT=1000
- +45 ; get Radiopharm data
- DO RDIO^RARTUTL(RDIOPHARM)
- +46 DO PHARMAS("Radiopharmaceuticals",1001)
- End DoDot:1
- +47 IF +$GET(MEDS)!+$GET(RDIOPHARM)
- Begin DoDot:1
- +48 SET CT=CT+.001
- SET @MAGRPTY@(DNODE+CT)=" "_$TRANSLATE($JUSTIFY(" ",66)," ","_")
- +49 SET CT=CT+.001
- SET @MAGRPTY@(DNODE+CT)=" "
- End DoDot:1
- +50 KILL ^TMP($JOB,"RA AUTOE")
- +51 QUIT
- +52 ;
- PHARMAS(TITLE,NODE) ; output lines of pharma data
- +1 NEW LINE
- +2 IF $DATA(^TMP($JOB,"RA AUTOE",NODE))
- Begin DoDot:1
- +3 SET CT=CT+.001
- SET @MAGRPTY@(DNODE+CT)=" "
- +4 SET CT=CT+.001
- SET @MAGRPTY@(DNODE+CT)=" ------------ "_TITLE_" ------------"
- +5 SET CT=CT+.001
- SET @MAGRPTY@(DNODE+CT)=" "
- +6 FOR
- SET LINE=^TMP($JOB,"RA AUTOE",NODE)
- Begin DoDot:2
- +7 SET CT=CT+.001
- SET @MAGRPTY@(DNODE+CT)=LINE
- End DoDot:2
- SET NODE=$ORDER(^TMP($JOB,"RA AUTOE",NODE))
- if 'NODE
- QUIT
- +8 QUIT
- End DoDot:1
- +9 QUIT
- +10 ;
- NOTEDISP(NOTES,MAGRPTY,DNODE) ; output notes ; ISI new subrtn
- +1 NEW IP,NOTE,X
- SET NOTE=0
- +2 SET DNODE=DNODE+1
- SET @MAGRPTY@(DNODE)=" "
- +3 SET DNODE=DNODE+1
- SET @MAGRPTY@(DNODE)="================================== NOTES =================================="
- +4 SET DNODE=DNODE+1
- SET @MAGRPTY@(DNODE)=" "
- +5 SET IP=""
- FOR
- SET IP=$ORDER(@NOTES@(IP))
- if IP=""
- QUIT
- SET X=(@NOTES@(IP))
- Begin DoDot:1
- +6 IF X="*NOTES"
- SET NOTE=1
- QUIT
- +7 IF NOTE
- Begin DoDot:2
- +8 IF X="*NOTES_END"
- SET NOTE=0
- QUIT
- +9 SET DNODE=DNODE+1
- SET @MAGRPTY@(DNODE)=X
- End DoDot:2
- End DoDot:1
- +10 QUIT
- +11 ;
- 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
- +2 ; test for this by presence of DOCTEXT^BEHOTIU
- +3 ; RARPT--exam pointer
- +4 ; MAGRPTY--indirect reference to output file
- +5 ; DNODE--starting node for lines of output
- +6 ;
- +7 NEW CT,QTMP,TEXT,XX
- +8 IF RARPT
- IF $LENGTH(MAGRPTY)
- IF DNODE
- IF $LENGTH($TEXT(DOCTEXT^BEHOTIU))
- Begin DoDot:1
- +9 DO DOCTEXT^BEHOTIU("TEXT",RARPT_";RARPT(")
- +10 IF $DATA(TEXT)
- Begin DoDot:2
- +11 SET CT=0
- SET QTMP="TEXT"
- +12 SET @MAGRPTY@(DNODE)=" "
- +13 FOR
- SET QTMP=$QUERY(@QTMP)
- if QTMP=""
- QUIT
- SET XX=@(QTMP)
- SET CT=CT+.01
- SET @MAGRPTY@(DNODE+CT)=XX
- End DoDot:2
- End DoDot:1
- +14 QUIT
- +15 ;
- OPENDEV ;
- +1 NEW IOP,%ZIS
- +2 SET IOP="IMAGING WORKSTATION"
- SET %ZIS=0
- DO ^%ZIS
- +3 IF POP
- +4 IF '$TEST
- USE IO
- +5 QUIT
- +6 ;
- RADRPT(MAGRPTY,DATA) ; Display rad report; 1st must pass integrity checks
- +1 ; Note: adds an additional line of output for the Report Window header
- +2 ; RPC is MAGJ EXAM REPORT
- +3 ;
- +4 ; MAGRPTY holds $NA reference to return message; references to it use subscript indirection
- +5 ;
- +6 SET MAGRPTY=$NAME(^TMP($JOB,"MAGJRADRPT"))
- KILL @MAGRPTY
- +7 NEW $ETRAP,$ESTACK
- SET $ETRAP="D ERR^MAGJRPT"
- +8 NEW RARPT,RADATA,MAGDFN,MAGDTI,MAGCNI,X,MAGRET,HDR,REPLY,MAGPRC,COMPLIC,DNODE
- +9 NEW MEDS,RDIOPHARM
- +10 SET MAGDFN=$PIECE(DATA,U)
- SET MAGDTI=$PIECE(DATA,U,2)
- SET MAGCNI=$PIECE(DATA,U,3)
- SET RARPT=+$PIECE(DATA,U,4)
- +11 IF '(MAGDFN&MAGDTI&MAGCNI)
- Begin DoDot:1
- +12 SET REPLY="0^4~Request Contains Invalid Case Pointer ("_MAGDFN_" "_MAGDTI_" "_MAGCNI_")."
- End DoDot:1
- GOTO RPTZ
- +13 DO GETEXAM2^MAGJUTL1(MAGDFN,MAGDTI,MAGCNI,"",.MAGRET)
- +14 SET RADATA=$GET(^TMP($JOB,"MAGRAEX",1,1))
- SET XX=$GET(^(2))
- SET HDR=""
- +15 ; Complications text
- SET COMPLIC=$PIECE(XX,U,4)
- +16 ; Medications & RadioPharm indicators
- SET MEDS=$PIECE(XX,U,14)
- SET RDIOPHARM=$PIECE(XX,U,15)
- +17 FOR I=4,12,9
- SET HDR=HDR_$PIECE(RADATA,U,I)_" "
- +18 ; ISI Modifier
- SET T=$PIECE(XX,U,8)
- IF T]""
- SET HDR=HDR_" ("_T_")"
- +19 DO CKINTEG(.REPLY,MAGDFN,MAGDTI,MAGCNI,RARPT,RADATA)
- +20 ; DB integ problem
- IF REPLY]""
- SET REPLY="0^7~"_REPLY
- GOTO RPTZ
- +21 DO EN3^RAO7PC3(MAGDFN_"^"_MAGDTI_"^"_MAGCNI)
- +22 IF '$DATA(^TMP($JOB,"RAE3"))
- SET REPLY="0^4~No report on file."
- GOTO RPTZ
- +23 DO COMMENTS(MAGDFN,MAGDTI,MAGCNI,MAGRPTY,2,COMPLIC,MEDS,RDIOPHARM)
- +24 SET MAGPRC=$ORDER(^TMP($JOB,"RAE3",MAGDFN,MAGCNI,""))
- SET I=0
- SET DNODE=2
- +25 FOR
- SET I=$ORDER(^TMP($JOB,"RAE3",MAGDFN,MAGCNI,MAGPRC,I))
- if 'I
- QUIT
- Begin DoDot:1
- +26 SET DNODE=DNODE+1
- +27 SET @MAGRPTY@(DNODE)=$GET(^TMP($JOB,"RAE3",MAGDFN,MAGCNI,MAGPRC,I))
- End DoDot:1
- +28 ; ISI
- SET DNODE=DNODE+1
- SET @MAGRPTY@(DNODE)=" "
- +29 ; ISI
- SET DNODE=DNODE+1
- SET @MAGRPTY@(DNODE)="** END REPORT "_$$FMTE^XLFDT($$NOW^XLFDT,"1P")_" **"
- +30 ; append TIU note to reply at node 10000
- DO TIUNOTE(RARPT,MAGRPTY,10000)
- +31 SET REPLY="1^1~Radiology Report"
- RPTZ SET @MAGRPTY@(0)=REPLY
- +1 ; if a report exists, add header line to output
- IF +$GET(@MAGRPTY@(0))
- SET @MAGRPTY@(1)="RPT: "_HDR
- +2 KILL ^TMP($JOB,"MAGRAEX"),^("RAE3")
- +3 QUIT
- +4 ;
- 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
- +2 ;
- +3 NEW IEN,MAGIEN,MIXEDUP,X,CKDFN,CKACN
- +4 SET MIXEDUP=0
- SET REPLY=""
- +5 IF RARPT
- Begin DoDot:1
- +6 SET X=$GET(^RARPT(RARPT,0))
- SET CKDFN=$PIECE(X,U,2)
- SET CKACN=$PIECE(X,U,4)
- +7 IF CKDFN'=RADFN
- SET MIXEDUP=1_U_+CKDFN
- QUIT
- +8 IF $GET(RADATA)]""
- Begin DoDot:2
- +9 IF $PIECE(RADATA,U,8)'=CKACN
- Begin DoDot:3
- +10 NEW MAGPSET,RAPRTSET,ACN,OK
- SET OK=0
- +11 SET RAPRTSET=0
- DO EN2^RAUTL20(.MAGPSET)
- IF RAPRTSET
- Begin DoDot:4
- +12 ; P133 mod for MAGPSET Data ex.--Old= 256^154^190^4 SSAN= 660-080504-256^154^190^4
- NEW I,T
- +13 SET I=0
- FOR
- SET I=$ORDER(MAGPSET(I))
- if 'I
- QUIT
- SET T=$PIECE(MAGPSET(I),U)
- IF $PIECE(T,"-",$LENGTH(T,"-"))=CKACN
- SET OK=1
- QUIT
- End DoDot:4
- +14 IF 'OK
- SET MIXEDUP=5_U_CKACN_U_$PIECE(RADATA,U,8)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- if MIXEDUP
- GOTO CK2
- +15 IF $DATA(^RARPT(+RARPT,2005))
- SET IEN=0
- Begin DoDot:1
- +16 FOR
- SET IEN=$ORDER(^RARPT(RARPT,2005,IEN))
- if 'IEN
- QUIT
- SET MAGIEN=+$GET(^(IEN,0))
- Begin DoDot:2
- +17 SET X=$PIECE($GET(^MAG(2005,MAGIEN,0)),U,7)
- IF X'=RADFN
- SET MIXEDUP=2_U_+X
- QUIT
- +18 SET X=$PIECE($GET(^MAG(2005,MAGIEN,2)),U,7)
- IF X'=RARPT
- SET MIXEDUP=3_U_+X
- QUIT
- End DoDot:2
- if MIXEDUP
- QUIT
- End DoDot:1
- if MIXEDUP
- GOTO CK2
- CK2 ; no problems detected
- IF 'MIXEDUP
- QUIT
- +1 IF +MIXEDUP=1!(+MIXEDUP=2)
- Begin DoDot:1
- +2 SET X=$$PNAM^MAGJEX1($PIECE(MIXEDUP,U,2))
- +3 IF +MIXEDUP=1
- SET 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!"
- +4 IF +MIXEDUP=2
- SET 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!"
- End DoDot:1
- QUIT
- +5 IF +MIXEDUP=3
- Begin DoDot:1
- +6 NEW T
- SET T=$PIECE(MIXEDUP,U,2)
- if 'T
- SET T="Missing Link"
- +7 SET 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!"
- End DoDot:1
- QUIT
- +8 IF +MIXEDUP=4
- Begin DoDot:1
- +9 NEW T
- SET T=$PIECE(MIXEDUP,U,2)
- if 'T
- SET T="Missing Reference"
- +10 SET X=" ("_RARPT_" and "_T_" )"
- +11 SET 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!"
- End DoDot:1
- QUIT
- +12 IF +MIXEDUP=5
- Begin DoDot:1
- +13 NEW T
- SET X=$PIECE(MIXEDUP,U,2)
- if X=""
- SET X="Missing"
- +14 SET T=$PIECE(MIXEDUP,U,3)
- if T=""
- SET T="Missing"
- +15 SET X=" ("_X_" and "_T_") "
- +16 SET 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!"
- End DoDot:1
- QUIT
- +17 QUIT
- +18 ;
- ERR ;
- +1 SET @MAGRPTY@(0)="0^ERROR "_$$EC^%ZOSV
- +2 DO @^%ZOSF("ERRTN")
- +3 if $QUIT
- QUIT 1
- QUIT
- END ;