source: FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGGTRP1.m@ 636

MAGGTRP1 ;WOIFO/GEK - Display Associated Report ; [ 11/08/2001 17:18 ]
 ;;3.0;IMAGING;**8**;Sep 15, 2004
 ;; +---------------------------------------------------------------+
 ;; | 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
RAD(MAGRPTY,RARPT) ;RPC [MAGGRADREPORT] Call to retrun a Radiology report
 ; MAGRPTY is the return array
 ; RARPT is the Radiology Report IEN i.e. ^RARPT(RARPT
 N ERRRES,RPTRES
 S ERRRES=""
 D OPENDEV Q:POP
 D BUILD(RARPT)
 S RPTRES=$G(@MAGRPTY@(0))
 I 'RPTRES S ERRRES=RPTRES
 I +RPTRES=-2 S ERRRES=RPTRES
 D:IO'=IO(0) ^%ZISC
 I $L(ERRRES) K @MAGRPTY S @MAGRPTY@(0)=ERRRES
 ; Mod Patch5 block Questionable reports 
 ; stop incorrectly report success on a failed report attempt.  this line is 
 ; moved inside BUILD tag
 ;S @MAGRPTY@(0)="1^OK"
 Q
BUILD(RARPT) ;Call to generate the Radiology Report
 ; This call is called be various Imaging routines to get the Rad Report
 ; This call assumes the device is already open.
 ; New the variables that'll be defined in the call to RASET^RAUTL2
 N RACN,RACNI,RADATE,RADFN,RADTE,RADTI
 ; We'll use these
 ; RADTI = Inverse date/time for rad order
 ; RACNI = rad case number
 ; RADFN = Patient DFN
 N I,Y,X,MAGPRC,XINF
 IF $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTRP1"
 E  S X="ERRA^MAGGTPR1",@^%ZOSF("TRAP")
 I RARPT["PMRAD" S @MAGRPTY@(0)="-2^Patient Mismatch. Radiology Files" Q
 I '$G(RARPT) S @MAGRPTY@(0)="0^NO Radiology Report number." Q
 ; 
 I '$$FIND1^DIC(74,"","A",+RARPT) S @MAGRPTY@(0)="0^Radiology report entry "_RARPT_" is not on file.  Contact IRM." Q
 ;
 S Y=RARPT
 ; This call will define the needed variables RADTI,RACNI and RADFN
 D RASET^RAUTL2
 ;D RPT2DPT(RARPT,.XINF)
 ;S ^TMP("MAGQIRP1",$J,"XINF")=XINF
 ;I +XINF'=RADFN S @MAGRPTY@(0)="0^Patient Mismatch. Radiology Files"  Q
 S ^TMP("MAGQIRP1",$J)="RADFN "_RADFN_" RADTI "_RADTI_" RACNI "_RACNI
 S ^TMP("MAGQIRP1",$J,1)="RARPT "_RARPT_" ,0)="_$G(^RARPT(RARPT,0))
 D EN3^RAO7PC3(RADFN_"^"_RADTI_"^"_RACNI)
 I '$D(^TMP($J,"RAE3")) D  Q
 . S @MAGRPTY@(0)="0^Radiology report not on file.  Contact IRM." Q
 S MAGPRC=$O(^TMP($J,"RAE3",RADFN,RACNI,""))
 S I=0 F  S I=$O(^TMP($J,"RAE3",RADFN,RACNI,MAGPRC,I)) Q:'I  D
 . W !,$G(^TMP($J,"RAE3",RADFN,RACNI,MAGPRC,I))
 ; 2.5P5  This line was moved from above.  So this BUILD function
 ;        should now correctly return success or failure.
 S @MAGRPTY@(0)="1^OK"
 Q
OPENDEV ;
 S MAGRPTY=$NA(^TMP($J,"WSDAT"))
 K @MAGRPTY ; clean it up first.
 S IOP="IMAGING WORKSTATION",%ZIS=0 D ^%ZIS
 I POP S @MAGRPTY@(0)="0^Can't open device IMAGING WORKSTATION" Q
 U IO
 Q
ERRA ;
 S @MAGRPTY@(0)="0^ERROR "_$$EC^%ZOSV
 D @^%ZOSF("ERRTN")
 Q
GRPDESC(MAGIEN) ; PRINT LONG DESC OF IMAGE GROUP and ALL children in Group
 ;DEVICE HAS ALREADY BEEN OPENED
 N MAGCIEN,MAGJ,MAGDASH
 S $P(MAGDASH,"_",79)="_"
 K ^UTILITY($J,"W")
 D GETDESC(MAGIEN)
 S MAGCIEN=0
 F  S MAGCIEN=$O(^MAG(2005,MAGIEN,1,MAGCIEN)) Q:'MAGCIEN  D
 . S MAGJ=^MAG(2005,MAGIEN,1,MAGCIEN,0)
 . I '$D(^MAG(2005,+MAGJ,3)) Q
 . D GETDESC(MAGJ)
 W MAGDASH
 Q
GETDESC(MAGIEN) ;
 ;
 N X,MAGI,DIWR,DIWL,DIWF,MAGHD
 I $O(^MAG(2005,MAGIEN,1,0)) S MAGHD="Group"
 E  S MAGHD="Image"
 W MAGHD_" ID# "_MAGIEN,!
 I $O(^MAG(2005,MAGIEN,3,0)) D
 . S DIWR=80,DIWL=1,DIWF="N"
 . W MAGHD_" : "_$P(^MAG(2005,MAGIEN,2),U,4),!
 . W MAGHD_" Long Description:  ",!
 . S MAGI=0
 . F  S MAGI=$O(^MAG(2005,MAGIEN,3,MAGI)) Q:+MAGI<1  D
 . . S X=^MAG(2005,MAGIEN,3,MAGI,0) D ^DIWP
 . D ^DIWW
 . W !
 Q
RPT2DPT(RARPT,RET) ; For input RARPT, return string RET containing case
 ;                 subscript values for accessing ^RADPT
 ; Stole this code from john, don't tell him.
 ; * This subroutine may be called by other routines of the Radiology
 ;   Imaging Workstation programs
 ;
 N DFN,DTI,CNI S (DFN,DTI,CNI)=""
 I RARPT?1N.N,$D(^RARPT(RARPT)) S X=$G(^(RARPT,0)) I X]"" D
 . S X=$P(X,U)
 . S X=$O(^RADPT("ADC",X,0)) I X S DFN=X,DTI=$O(^(X,0)),CNI=$O(^(DTI,0))
 . S RET=DFN_U_DTI_U_CNI
 E  S RET=""
 Q