168 lines
7.0 KiB
Mathematica
168 lines
7.0 KiB
Mathematica
MAGGTRPT ;WOIFO/RED/GEK - Display Associated Report ; [ 11/08/2001 17:18 ]
|
|
;;3.0;IMAGING;**8,48**;Jan 11, 2005
|
|
;; +---------------------------------------------------------------+
|
|
;; | 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. |
|
|
;; +---------------------------------------------------------------+
|
|
;;
|
|
BRK(MAGRPTY,MAGGIEN,NOCHK) ;RPC [MAGGRPT] Call to return Image report
|
|
; MAGGIEN is internal number in Image File ^MAG(2005,
|
|
; NOCHK is a Flag that tell to Not run the QA check, just return
|
|
; the report.
|
|
;
|
|
S MAGRPTY=$NA(^TMP($J,"WSDAT"))
|
|
K @MAGRPTY ; clean it up first.
|
|
S @MAGRPTY@(0)="0^Building the Image report..."
|
|
N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTRPT"
|
|
;
|
|
N X,Y,Z,MAGGBRK,MAGO,MAGGRPO,MAGDFN,MAGTMPR,MAGTMPRT
|
|
N MAGNODIS,MAGTMPR2,MAGDESC,MAGISGRP,MAGQA,%ZIS,IOP
|
|
S MAGGBRK=1,MAGISGRP=0
|
|
S MAGO=+$P(MAGGIEN,"^")
|
|
S NOCHK=+$G(NOCHK)
|
|
; Requesting a report, have to check Image
|
|
; and Group, if this image is in a group.
|
|
I 'NOCHK D Q:'MAGQA(0)
|
|
. D CHK^MAGGSQI(.MAGQA,MAGO)
|
|
. I 'MAGQA(0) S @MAGRPTY@(0)="-2^"_$P(MAGQA(0),U,2,99) Q
|
|
. S MAGGRPO=+$P(^MAG(2005,MAGO,0),U,10)
|
|
. Q:'MAGGRPO K MAGQA
|
|
. D CHK^MAGGSQI(.MAGQA,MAGGRPO)
|
|
. I 'MAGQA(0) S @MAGRPTY@(0)="-2^"_$P(MAGQA(0),U,2,99) Q
|
|
;
|
|
;
|
|
I 'MAGO S @MAGRPTY@(0)="INVALID Image pointer: '"_MAGGIEN_"'" Q
|
|
I $D(^MAG(2005.1,MAGO)) S @MAGRPTY@(0)="0^Image : """_$P($G(^MAG(2005.1,MAGO,2)),U,4)_""" has been deleted." Q
|
|
S MAGDESC="",MAGDFN=$P(^MAG(2005,MAGO,0),U,7)
|
|
; IN check we get Desc for Report Window header,
|
|
; and Define Group IEN - MAGGRPO if it exists.
|
|
; and Define MAGISGRP = 1 if this MAGO is a group itself
|
|
D CHECK(.MAGO,MAGDFN,.MAGDESC,.MAGGRPO,.MAGISGRP)
|
|
; quit if NO PARENT DATA FILE and No long description.
|
|
; for the Image or the Group entry
|
|
I ($P($G(^MAG(2005,MAGO,2)),U,6)="")&('$D(^MAG(2005,MAGO,3)))&($P($G(^MAG(2005,MAGGRPO,2)),U,6)="")&('$D(^MAG(2005,MAGGRPO,3))) S @MAGRPTY@(0)="0^No Report for this Image" Q
|
|
S IOP="IMAGING WORKSTATION",%ZIS=0 D ^%ZIS
|
|
I POP S @MAGRPTY@(0)="0^Can't open device IMAGING WORKSTATION" K POP Q
|
|
U IO D BUILD
|
|
;
|
|
D:IO'=IO(0) ^%ZISC
|
|
S:+$P(@MAGRPTY@(0),"^") @MAGRPTY@(0)="1^"_MAGDESC
|
|
Q
|
|
BUILD ;
|
|
K DIC,DIR
|
|
N MAGDASH,DIWR,DIWL
|
|
S $P(MAGDASH,"_",79)="_"
|
|
; If Child of group get PARENT DATA FILE from group
|
|
I MAGGRPO S MAGTMPR=$G(^MAG(2005,MAGGRPO,2)),MAGTMPRT=$P(MAGTMPR,"^",6) ;
|
|
; if not child of group, then get PARENT DATA FILE from original IEN
|
|
I 'MAGGRPO S MAGTMPR=$G(^MAG(2005,MAGO,2)),MAGTMPRT=$P(MAGTMPR,"^",6)
|
|
S DIWR=80,DIWL=1
|
|
; IF This is a group call GRPDESC which will print ALL image long descriptions , not just the group long desc
|
|
I MAGISGRP D GRPDESC^MAGGTRP1(MAGO)
|
|
; If not a group, then print group long desc if it exists,
|
|
; and/or the long desc of the Images itself
|
|
I 'MAGISGRP D
|
|
. I MAGGRPO D GETDESC^MAGGTRP1(MAGGRPO)
|
|
. D GETDESC^MAGGTRP1(MAGO)
|
|
. W MAGDASH
|
|
I MAGTMPRT="" D ENTRY^MAGLOG("LONGDES",DUZ,MAGO,"MAGRPT-WIN",MAGDFN,0) Q
|
|
I $P(MAGTMPR,"^",7)="" S @MAGRPTY@(0)="0^Full report not available through this windows option." Q
|
|
;
|
|
; Surgery reports
|
|
S MAGTMPR2=$P(^MAG(2005.03,MAGTMPRT,0),"^",1) I MAGTMPR2="SURGERY" D Q
|
|
. S SRTN=$P(MAGTMPR,"^",7)
|
|
. D ^SROPRPT K SRTN
|
|
. D ENTRY^MAGLOG("SURGRPT",DUZ,MAGO,"MAGRPT",MAGDFN,0)
|
|
;
|
|
; TIU documents;
|
|
I MAGTMPRT=8925 D Q
|
|
. N MAGY
|
|
. D TGET^TIUSRVR1(.MAGY,$P(MAGTMPR,"^",7))
|
|
. S I="" F S I=$O(@MAGY@(I)) Q:'I W !,@MAGY@(I)
|
|
. D ENTRY^MAGLOG("TIURPT",DUZ,MAGO,"MAGRPT",MAGDFN,0)
|
|
;
|
|
; Medicine reports
|
|
I MAGTMPRT>689.999&(MAGTMPRT<703) D Q
|
|
. S MAGNODIS=1
|
|
. D REPRT^MCMAGDSP($P(MAGTMPR,"^",7),MAGTMPRT)
|
|
. D ENTRY^MAGLOG("MEDRPT",DUZ,MAGO,"MAGRPT-WIN",MAGDFN,0)
|
|
;
|
|
; Radiology reports
|
|
I MAGTMPRT=74 D Q
|
|
. D BUILD^MAGGTRP1($P(MAGTMPR,U,7))
|
|
. D ENTRY^MAGLOG("RADRPT",DUZ,MAGO,"MAGRPT-WIN",MAGDFN,0)
|
|
;
|
|
;Laboratory reports
|
|
I $P(^MAG(2005.03,MAGTMPRT,0),"^",4)=63 D @$S(MAGTMPRT=63:"AU",MAGTMPRT=63.2:"AU",1:"LAB") Q
|
|
;
|
|
S @MAGRPTY@(0)="0^Full report not available through this windows option."
|
|
Q
|
|
;
|
|
CHECK(MAGO,MAGDFN,MAGDESC,MAGGRPO,MAGISGRP) ;
|
|
; 9/28/99 Change Report long description, so this is changed to
|
|
; return the desc of MAGO, and define MAGGRPO if this is child of grp
|
|
N MAGTMP
|
|
I '$D(^MAG(2005,MAGO)) S @MAGRPTY@(0)="0^Invalid Image pointer"_MAGO Q
|
|
S MAGDESC=$P($G(^MAG(2005,MAGO,2)),U,4)
|
|
I $O(^MAG(2005,MAGO,1,0)) S MAGISGRP=1
|
|
S MAGGRPO=+$P(^MAG(2005,MAGO,0),U,10)
|
|
;
|
|
S MAGTMP=$S(MAGGRPO:MAGGRPO,1:MAGO)
|
|
Q:'$D(^MAG(2005,MAGTMP,2))
|
|
; Procedure Exam Date/Time
|
|
S Y=$P(^MAG(2005,MAGTMP,2),U,5),X=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_($E(Y,1,3)+1700)
|
|
; procedure short description
|
|
S Y=X_" "_$P(^MAG(2005,MAGTMP,0),U,8)_" "_$P($G(^MAG(2005,MAGTMP,2)),U,4)
|
|
I MAGDFN S MAGDESC=MAGDESC_"^"_$P($G(^DPT(MAGDFN,0)),U)
|
|
Q
|
|
LAB ; Pathology Reports
|
|
N LINE,MAGIOPEN,MAGSTART,MAGEND,MAGSUB,TYPE,MAGXX,MAGLR
|
|
S TYPE=$P(^MAG(2005.03,MAGTMPRT,0),"^",2)
|
|
S MAGSTART=$P(^MAG(2005,MAGO,2),"^",10),MAGLR=$P(^MAG(2005,MAGO,2),"^",7)
|
|
I MAGSTART,MAGLR,$D(^LR(MAGLR,TYPE,MAGSTART,0)) D
|
|
. S (MAGSTART,MAGEND)=9999999-MAGSTART
|
|
. Q
|
|
;if no pointer back to lab file use the procedure date/time.
|
|
I 'MAGSTART D
|
|
. S MAGSTART=$P(^MAG(2005,MAGO,2),"^",5)
|
|
. S (MAGSTART,MAGEND)=$P(MAGSTART,".")
|
|
. Q
|
|
I '$L(MAGSTART) D Q
|
|
. S @MAGRPTY@(1)="No Procedure Date/Time entered in file 2005 for this Image"
|
|
S TYPE=$S(TYPE="SP":"SURGICAL PATHOLOGY",TYPE="CY":"CYTOPATHOLOGY",1:TYPE)
|
|
S MAGSUB=1,MAGSUB(TYPE)="",MAGXX=""
|
|
S MAGIOPEN=1
|
|
D EN^LR7OSUM(MAGXX,MAGDFN,MAGSTART,MAGEND,10,80,.MAGSUB)
|
|
I '$D(^TMP("LRC",$J)) S @MAGRPTY@(1)="No report(s) on file." Q
|
|
E S LINE=0 F S LINE=$O(^TMP("LRC",$J,LINE)) Q:LINE<1 W !,^TMP("LRC",$J,LINE,0)
|
|
D ENTRY^MAGLOG("LABRPT",DUZ,MAGO,"MAGRPT-WIN",MAGDFN,0)
|
|
K ^TMP("LRC",$J),^TMP("LRT",$J),^TMP("LRH",$J)
|
|
Q
|
|
AU ;Autopsy Report
|
|
N LRDFN,MAGSUB,MAGXX,LINE
|
|
S MAGSUB("AUTOPSY")=""
|
|
I '$D(MAGO)!'$D(MAGDFN) W !,"Missing imaging pointers." Q
|
|
S LRDFN=$P(^MAG(2005,MAGO,2),"^",7),LRDFN=+LRDFN
|
|
I 'LRDFN!'$D(^LR(LRDFN,0)) W !,"Information missing, please use DHCP Lab print options." Q
|
|
I '$D(^LR(LRDFN,"AU")) W !,"Missing autopsy information." K LRDFN Q
|
|
D EN^LR7OSUM(.MAGXX,MAGDFN,,,,80,.MAGSUB)
|
|
I '$D(^TMP("LRC",$J)) S @MAGRPTY@(1)="No autopsy report on file." Q
|
|
S LINE=0 F S LINE=$O(^TMP("LRC",$J,LINE)) Q:LINE<1 W !,^TMP("LRC",$J,LINE,0)
|
|
D ENTRY^MAGLOG("LABRPT",DUZ,MAGO,"MAGRPT-WIN",MAGDFN,0)
|
|
K ^TMP("LRC",$J)
|
|
Q
|
|
ERRA ;
|
|
S @MAGRPTY@(0)="0^ERROR "_$$EC^%ZOSV
|
|
D @^%ZOSF("ERRTN")
|
|
Q
|