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

MAGGTRPT.m

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