MAGNU003 ;WOIFO/NST - Misc fuctions for image list ; 16 Jan 2018 3:42 AM
;;3.0;IMAGING;**185,269**;Mar 19, 2002;Build 8;Feb 28, 2011
;; 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. |
;; +---------------------------------------------------------------+
;;
Q
;
STDINFO(IMGIEN,REFTYPE,REFIEN,MAGNCXT) ; Get study info by image IEN in file #2005 or #2005.1
; IMGIEN -- Image IEN
; REFTYPE = "RAD", "TIU"
; REFIEN = IEN in respective file of REFTYPE
; MAGNCXT = CPRS Context ID
;
; Return Study( Image ) info. The code is a copy from MAGSIXG3
N X0,X2,X40
N PKG,TYPE,EVT,SPEC,ORIG,ORIG,CAPTAPP,CLASS
N IMGNODE,FLTX
;
S IMGNODE=$$NODE^MAGGI11(IMGIEN) Q:IMGNODE="" 0
;
S X0=$G(@IMGNODE@(0))
S X2=$G(@IMGNODE@(2))
S X40=$G(@IMGNODE@(40))
;
S PKG=$P(X40,U) ; PACKAGE INDEX (40)
S TYPE=$P(X40,U,3) ; TYPE INDEX (42)
S EVT=$P(X40,U,4) ; PROC/EVENT INDEX (43)
S SPEC=$P(X40,U,5) ; SPEC/SUBSPEC INDEX (44)
S ORIG=$P(X40,U,6) ; ORIGIN INDEX (45)
S:ORIG="" ORIG="V" ; Show VA by default
S CAPTAPP=$P(X2,U,12) ; CAPTURE APPLICATION (8.1)
;
S CLASS=$S(TYPE:$P($G(^MAG(2005.83,+TYPE,0)),U,2),1:"")
;
S FLTX=""
S $P(FLTX,U,3)=$$RPTITLE^MAGSIXG3($P(X2,U,6),$P(X2,U,7)) ; Report title
S $P(FLTX,U,4)=$$DTE^MAGSIXG3($P(X2,U,5)) ; Procedure date
S $P(FLTX,U,5)=$P(X0,U,8) ; Procedure
S $P(FLTX,U,7)=$P(X2,U,4) ; Short descr.
S $P(FLTX,U,8)=PKG ; Package
S $P(FLTX,U,9)=$P($G(^MAG(2005.82,+CLASS,0)),U) ; Class
S $P(FLTX,U,10)=$P($G(^MAG(2005.83,+TYPE,0)),U) ; Type
S $P(FLTX,U,11)=$P($G(^MAG(2005.84,+SPEC,0)),U) ; (Sub)Specialty
S $P(FLTX,U,12)=$P($G(^MAG(2005.85,+EVT,0)),U) ; Proc/Event
S $P(FLTX,U,13)=$$EXTERNAL^DILFD(2005,45,,ORIG) ; Origin
S $P(FLTX,U,14)=$$DTE^MAGSIXG3($P(X2,U)) ; Capture date
S $P(FLTX,U,15)=$$GET1^DIQ(200,+$P(X2,U,2)_",",.01) ; Captured by
S $P(FLTX,U,16)=IMGIEN ; Image IEN
S $P(FLTX,U,20)=$$ACCNUM(REFTYPE,REFIEN,MAGNCXT) ; Accession Number
Q FLTX_"|"_REFTYPE_"-"_REFIEN_"|"_$S(MAGNCXT'="":MAGNCXT,1:$$CPRSCTX(REFTYPE,REFIEN))
;
INSFIMG(DATA,MAGNCNT,OUT) ; Append First Image Info from 2005 image structure
N IMGGRP,IMGIEN
S IMGGRP=$P(DATA,"|",2)
S IMGIEN=$P(DATA,"|",4)
S MAGNCNT=MAGNCNT+1,@OUT@(MAGNCNT)="NEXT_SERIES"
S MAGNCNT=MAGNCNT+1,@OUT@(MAGNCNT)="SERIES_IEN|"_IMGGRP
S MAGNCNT=MAGNCNT+1,@OUT@(MAGNCNT)="SERIES_NUMBER|1"
S MAGNCNT=MAGNCNT+1,@OUT@(MAGNCNT)="NEXT_IMAGE"
S MAGNCNT=MAGNCNT+1,@OUT@(MAGNCNT)="IMAGE_IEN|"_IMGIEN
S MAGNCNT=MAGNCNT+1,@OUT@(MAGNCNT)="GROUP_IEN|"_IMGGRP
S MAGNCNT=MAGNCNT+1,@OUT@(MAGNCNT)="IMAGE_INFO|"_"^"_$$INFO^MAGGAII(IMGIEN,"E")
Q
;
ACCNUM(REFTYPE,REFIEN,MAGNCXT) ; Accession Number
I REFTYPE="TIU" Q $$ACNTIU(REFIEN)
I REFTYPE="RAD" Q $$ACNRAD(REFIEN,MAGNCXT)
Q ""
;
ACNRAD(RARPT,MAGNCXT) ; Get Accession number by RAD report IEN
N ACN,DFN,ENT,INVDTTM,INVDT,INVTM
I RARPT D Q ACN
. S ACN=$P($G(^RARPT(RARPT,0)),"^") ; IA # 1171 ; Get Radiology Accession number
. Q
;
I MAGNCXT="" Q ""
;
; Report is not defined
S DFN=+$P(MAGNCXT,U,3)
S ENT=+$P($P(MAGNCXT,U,5),"-",2)
S INVDTTM=$P($P(MAGNCXT,U,5),"-",1)
S INVDT=$P(INVDTTM,".",1)
S INVTM=$P(INVDTTM,".",2)
F Q:($L(INVDT)<8) S INVDT=$E(INVDT,2,$L(INVDT))
S INVDTTM=INVDT_"."_INVTM
S ACN=$$ACCNUM^RAAPI(DFN,INVDTTM,ENT)
I $L(ACN,"-")=3 S ACN=$P(ACN,"-",2,3)
Q ACN
;
ACNTIU(MAGTIUDA) ; Get Accession number by TIU Note IEN
N MAGMRC,IEN
;
D GET1405^TIUSRVR(.MAGMRC,MAGTIUDA)
S IEN=+MAGMRC
I (IEN'>0)!'(MAGMRC["GMR(123") Q ""
Q $$GMRCACN^MAGDFCNV(IEN) ; site-specific accession number
;
CPRSCTX(REFTYPE,REFIEN) ; Create CPRS Context ID
; REFTYPE = "RAD", "TIU"
; REFIEN = IEN in respective file of REFTYPE
;
N CTXID
I REFTYPE="TIU" D Q CTXID
. S CTXID=$$TIUCPRS(REFIEN)
. Q
;
I REFTYPE="RAD" D Q CTXID
. S CTXID=$$RACPRS(REFIEN)
. Q
;
Q ""
;
REFBYACN(REFTYPE,REFIEN,ACNUMB) ; Get report by accession number
N GMRCIEN,IEN,LST
S (REFTYPE,REFIEN)=""
;
I ACNUMB="" Q
S IEN=$O(^MAGV(2005.62,"D",ACNUMB,""))
I IEN'>0 Q
S REFTYPE=$$GET1^DIQ(2005.62,IEN,"11:.03","I") ; Get procedure type (RAD, CON, etc)
;
I REFTYPE="RAD" D Q
. N I,DFN,INVDT,ENT
. D ACCFIND^RAAPI(ACNUMB,.LST) ; IA 5020
. S I=$O(LST(""))
. Q:I'>0
. S DFN=$P(LST(I),"^")
. S INVDT=$P(LST(I),"^",2)
. S ENT=$P(LST(I),"^",3)
. S REFIEN=$P(^RADPT(DFN,"DT",INVDT,"P",ENT,0),U,17)
. Q
;
I REFTYPE="CON" D Q
. S REFTYPE="TIU"
. S GMRCIEN=$$GMRCIEN(ACNUMB)
. Q:GMRCIEN'>0 ; invalid IEN
. D GETDOCS^TIUSRVLR(.LST,GMRCIEN_";GMR(123,") ; IA 3536
. S REFIEN=$P($G(@LST@(1)),"^")
. Q
Q
;
GMRCIEN(ACNUMB) ; return the GMRC IEN, given a consult/procedure accession number
; ACNUMB is the accession number for a consult/procedure request
; OLD Format: GMRC-<gmrcien>, where <gmrcien>is the internal entry number of the request
; New Format: <sss>-GMR-<gmrcien>, where <sss> is station number, and <gmrcien>
; is the internal entry number of the request, up to 8 digits (100 million)
N GMRCIEN ; CPRS Consult Request Tracking GMRC IEN - REQUEST/CONSULTATION file(#123)
S GMRCIEN=""
I ACNUMB?1"GMRC-"1N.N S GMRCIEN=$P(ACNUMB,"-",2) ; return the second piece
E I ACNUMB?1N.N1"-GMR-"1N.N S:$P(ACNUMB,"-",1)=$$STATNUMB^MAGDFCNV() GMRCIEN=$P(ACNUMB,"-",3) ; return the third piece
;
Q GMRCIEN
;
RACPRS(REFIEN) ; Return Radiology CRPS context by Report IEN in file #74
; REFIEN - Radiology report IEN in file #74
I REFIEN'>0 Q ""
N DAYCASE,CASE,DATETIME,INVDAT,ENT,CONTEXT
S DAYCASE=$$GET1^DIQ(74,REFIEN,.01)
Q:DAYCASE="" "" ;*ZEB 269 prevent subscript error if study deleted
S DFN=$$GET1^DIQ(74,REFIEN,2,"I")
Q:DFN="" "" ;*ZEB 269 prevent subscript error if study deleted
S DATETIME=$$GET1^DIQ(74,REFIEN,3,"I")
S INVDAT=9999999.9999-DATETIME
S CASE=$$GET1^DIQ(74,REFIEN,4)
S ENT=$O(^RADPT("ADC1",DAYCASE,DFN,INVDAT,""))
I 'ENT S ENT=$O(^RADPT("ADC",DAYCASE,DFN,INVDAT,""))
S CONTEXT="RPT^CPRS^"_DFN_"^RA^i"_INVDAT_"-"_ENT_"^"_CASE
Q CONTEXT
;
TIUCPRS(REFIEN) ; Return TIU CRPS context by TIU note IEN in file #8925
; REFIEN - TIU note IEN in file #8925
I REFIEN'>0 Q ""
N DFN,CONTEXT
S DFN=$$GET1^DIQ(8925,REFIEN,.02,"I")
S CONTEXT="RPT^CPRS^"_DFN_"^TIU^"_REFIEN
Q CONTEXT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGNU003 7362 printed Nov 22, 2024@17:17:36 Page 2
MAGNU003 ;WOIFO/NST - Misc fuctions for image list ; 16 Jan 2018 3:42 AM
+1 ;;3.0;IMAGING;**185,269**;Mar 19, 2002;Build 8;Feb 28, 2011
+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 QUIT
+18 ;
STDINFO(IMGIEN,REFTYPE,REFIEN,MAGNCXT) ; Get study info by image IEN in file #2005 or #2005.1
+1 ; IMGIEN -- Image IEN
+2 ; REFTYPE = "RAD", "TIU"
+3 ; REFIEN = IEN in respective file of REFTYPE
+4 ; MAGNCXT = CPRS Context ID
+5 ;
+6 ; Return Study( Image ) info. The code is a copy from MAGSIXG3
+7 NEW X0,X2,X40
+8 NEW PKG,TYPE,EVT,SPEC,ORIG,ORIG,CAPTAPP,CLASS
+9 NEW IMGNODE,FLTX
+10 ;
+11 SET IMGNODE=$$NODE^MAGGI11(IMGIEN)
if IMGNODE=""
QUIT 0
+12 ;
+13 SET X0=$GET(@IMGNODE@(0))
+14 SET X2=$GET(@IMGNODE@(2))
+15 SET X40=$GET(@IMGNODE@(40))
+16 ;
+17 ; PACKAGE INDEX (40)
SET PKG=$PIECE(X40,U)
+18 ; TYPE INDEX (42)
SET TYPE=$PIECE(X40,U,3)
+19 ; PROC/EVENT INDEX (43)
SET EVT=$PIECE(X40,U,4)
+20 ; SPEC/SUBSPEC INDEX (44)
SET SPEC=$PIECE(X40,U,5)
+21 ; ORIGIN INDEX (45)
SET ORIG=$PIECE(X40,U,6)
+22 ; Show VA by default
if ORIG=""
SET ORIG="V"
+23 ; CAPTURE APPLICATION (8.1)
SET CAPTAPP=$PIECE(X2,U,12)
+24 ;
+25 SET CLASS=$SELECT(TYPE:$PIECE($GET(^MAG(2005.83,+TYPE,0)),U,2),1:"")
+26 ;
+27 SET FLTX=""
+28 ; Report title
SET $PIECE(FLTX,U,3)=$$RPTITLE^MAGSIXG3($PIECE(X2,U,6),$PIECE(X2,U,7))
+29 ; Procedure date
SET $PIECE(FLTX,U,4)=$$DTE^MAGSIXG3($PIECE(X2,U,5))
+30 ; Procedure
SET $PIECE(FLTX,U,5)=$PIECE(X0,U,8)
+31 ; Short descr.
SET $PIECE(FLTX,U,7)=$PIECE(X2,U,4)
+32 ; Package
SET $PIECE(FLTX,U,8)=PKG
+33 ; Class
SET $PIECE(FLTX,U,9)=$PIECE($GET(^MAG(2005.82,+CLASS,0)),U)
+34 ; Type
SET $PIECE(FLTX,U,10)=$PIECE($GET(^MAG(2005.83,+TYPE,0)),U)
+35 ; (Sub)Specialty
SET $PIECE(FLTX,U,11)=$PIECE($GET(^MAG(2005.84,+SPEC,0)),U)
+36 ; Proc/Event
SET $PIECE(FLTX,U,12)=$PIECE($GET(^MAG(2005.85,+EVT,0)),U)
+37 ; Origin
SET $PIECE(FLTX,U,13)=$$EXTERNAL^DILFD(2005,45,,ORIG)
+38 ; Capture date
SET $PIECE(FLTX,U,14)=$$DTE^MAGSIXG3($PIECE(X2,U))
+39 ; Captured by
SET $PIECE(FLTX,U,15)=$$GET1^DIQ(200,+$PIECE(X2,U,2)_",",.01)
+40 ; Image IEN
SET $PIECE(FLTX,U,16)=IMGIEN
+41 ; Accession Number
SET $PIECE(FLTX,U,20)=$$ACCNUM(REFTYPE,REFIEN,MAGNCXT)
+42 QUIT FLTX_"|"_REFTYPE_"-"_REFIEN_"|"_$SELECT(MAGNCXT'="":MAGNCXT,1:$$CPRSCTX(REFTYPE,REFIEN))
+43 ;
INSFIMG(DATA,MAGNCNT,OUT) ; Append First Image Info from 2005 image structure
+1 NEW IMGGRP,IMGIEN
+2 SET IMGGRP=$PIECE(DATA,"|",2)
+3 SET IMGIEN=$PIECE(DATA,"|",4)
+4 SET MAGNCNT=MAGNCNT+1
SET @OUT@(MAGNCNT)="NEXT_SERIES"
+5 SET MAGNCNT=MAGNCNT+1
SET @OUT@(MAGNCNT)="SERIES_IEN|"_IMGGRP
+6 SET MAGNCNT=MAGNCNT+1
SET @OUT@(MAGNCNT)="SERIES_NUMBER|1"
+7 SET MAGNCNT=MAGNCNT+1
SET @OUT@(MAGNCNT)="NEXT_IMAGE"
+8 SET MAGNCNT=MAGNCNT+1
SET @OUT@(MAGNCNT)="IMAGE_IEN|"_IMGIEN
+9 SET MAGNCNT=MAGNCNT+1
SET @OUT@(MAGNCNT)="GROUP_IEN|"_IMGGRP
+10 SET MAGNCNT=MAGNCNT+1
SET @OUT@(MAGNCNT)="IMAGE_INFO|"_"^"_$$INFO^MAGGAII(IMGIEN,"E")
+11 QUIT
+12 ;
ACCNUM(REFTYPE,REFIEN,MAGNCXT) ; Accession Number
+1 IF REFTYPE="TIU"
QUIT $$ACNTIU(REFIEN)
+2 IF REFTYPE="RAD"
QUIT $$ACNRAD(REFIEN,MAGNCXT)
+3 QUIT ""
+4 ;
ACNRAD(RARPT,MAGNCXT) ; Get Accession number by RAD report IEN
+1 NEW ACN,DFN,ENT,INVDTTM,INVDT,INVTM
+2 IF RARPT
Begin DoDot:1
+3 ; IA # 1171 ; Get Radiology Accession number
SET ACN=$PIECE($GET(^RARPT(RARPT,0)),"^")
+4 QUIT
End DoDot:1
QUIT ACN
+5 ;
+6 IF MAGNCXT=""
QUIT ""
+7 ;
+8 ; Report is not defined
+9 SET DFN=+$PIECE(MAGNCXT,U,3)
+10 SET ENT=+$PIECE($PIECE(MAGNCXT,U,5),"-",2)
+11 SET INVDTTM=$PIECE($PIECE(MAGNCXT,U,5),"-",1)
+12 SET INVDT=$PIECE(INVDTTM,".",1)
+13 SET INVTM=$PIECE(INVDTTM,".",2)
+14 FOR
if ($LENGTH(INVDT)<8)
QUIT
SET INVDT=$EXTRACT(INVDT,2,$LENGTH(INVDT))
+15 SET INVDTTM=INVDT_"."_INVTM
+16 SET ACN=$$ACCNUM^RAAPI(DFN,INVDTTM,ENT)
+17 IF $LENGTH(ACN,"-")=3
SET ACN=$PIECE(ACN,"-",2,3)
+18 QUIT ACN
+19 ;
ACNTIU(MAGTIUDA) ; Get Accession number by TIU Note IEN
+1 NEW MAGMRC,IEN
+2 ;
+3 DO GET1405^TIUSRVR(.MAGMRC,MAGTIUDA)
+4 SET IEN=+MAGMRC
+5 IF (IEN'>0)!'(MAGMRC["GMR(123")
QUIT ""
+6 ; site-specific accession number
QUIT $$GMRCACN^MAGDFCNV(IEN)
+7 ;
CPRSCTX(REFTYPE,REFIEN) ; Create CPRS Context ID
+1 ; REFTYPE = "RAD", "TIU"
+2 ; REFIEN = IEN in respective file of REFTYPE
+3 ;
+4 NEW CTXID
+5 IF REFTYPE="TIU"
Begin DoDot:1
+6 SET CTXID=$$TIUCPRS(REFIEN)
+7 QUIT
End DoDot:1
QUIT CTXID
+8 ;
+9 IF REFTYPE="RAD"
Begin DoDot:1
+10 SET CTXID=$$RACPRS(REFIEN)
+11 QUIT
End DoDot:1
QUIT CTXID
+12 ;
+13 QUIT ""
+14 ;
REFBYACN(REFTYPE,REFIEN,ACNUMB) ; Get report by accession number
+1 NEW GMRCIEN,IEN,LST
+2 SET (REFTYPE,REFIEN)=""
+3 ;
+4 IF ACNUMB=""
QUIT
+5 SET IEN=$ORDER(^MAGV(2005.62,"D",ACNUMB,""))
+6 IF IEN'>0
QUIT
+7 ; Get procedure type (RAD, CON, etc)
SET REFTYPE=$$GET1^DIQ(2005.62,IEN,"11:.03","I")
+8 ;
+9 IF REFTYPE="RAD"
Begin DoDot:1
+10 NEW I,DFN,INVDT,ENT
+11 ; IA 5020
DO ACCFIND^RAAPI(ACNUMB,.LST)
+12 SET I=$ORDER(LST(""))
+13 if I'>0
QUIT
+14 SET DFN=$PIECE(LST(I),"^")
+15 SET INVDT=$PIECE(LST(I),"^",2)
+16 SET ENT=$PIECE(LST(I),"^",3)
+17 SET REFIEN=$PIECE(^RADPT(DFN,"DT",INVDT,"P",ENT,0),U,17)
+18 QUIT
End DoDot:1
QUIT
+19 ;
+20 IF REFTYPE="CON"
Begin DoDot:1
+21 SET REFTYPE="TIU"
+22 SET GMRCIEN=$$GMRCIEN(ACNUMB)
+23 ; invalid IEN
if GMRCIEN'>0
QUIT
+24 ; IA 3536
DO GETDOCS^TIUSRVLR(.LST,GMRCIEN_";GMR(123,")
+25 SET REFIEN=$PIECE($GET(@LST@(1)),"^")
+26 QUIT
End DoDot:1
QUIT
+27 QUIT
+28 ;
GMRCIEN(ACNUMB) ; return the GMRC IEN, given a consult/procedure accession number
+1 ; ACNUMB is the accession number for a consult/procedure request
+2 ; OLD Format: GMRC-<gmrcien>, where <gmrcien>is the internal entry number of the request
+3 ; New Format: <sss>-GMR-<gmrcien>, where <sss> is station number, and <gmrcien>
+4 ; is the internal entry number of the request, up to 8 digits (100 million)
+5 ; CPRS Consult Request Tracking GMRC IEN - REQUEST/CONSULTATION file(#123)
NEW GMRCIEN
+6 SET GMRCIEN=""
+7 ; return the second piece
IF ACNUMB?1"GMRC-"1N.N
SET GMRCIEN=$PIECE(ACNUMB,"-",2)
+8 ; return the third piece
IF '$TEST
IF ACNUMB?1N.N1"-GMR-"1N.N
if $PIECE(ACNUMB,"-",1)=$$STATNUMB^MAGDFCNV()
SET GMRCIEN=$PIECE(ACNUMB,"-",3)
+9 ;
+10 QUIT GMRCIEN
+11 ;
RACPRS(REFIEN) ; Return Radiology CRPS context by Report IEN in file #74
+1 ; REFIEN - Radiology report IEN in file #74
+2 IF REFIEN'>0
QUIT ""
+3 NEW DAYCASE,CASE,DATETIME,INVDAT,ENT,CONTEXT
+4 SET DAYCASE=$$GET1^DIQ(74,REFIEN,.01)
+5 ;*ZEB 269 prevent subscript error if study deleted
if DAYCASE=""
QUIT ""
+6 SET DFN=$$GET1^DIQ(74,REFIEN,2,"I")
+7 ;*ZEB 269 prevent subscript error if study deleted
if DFN=""
QUIT ""
+8 SET DATETIME=$$GET1^DIQ(74,REFIEN,3,"I")
+9 SET INVDAT=9999999.9999-DATETIME
+10 SET CASE=$$GET1^DIQ(74,REFIEN,4)
+11 SET ENT=$ORDER(^RADPT("ADC1",DAYCASE,DFN,INVDAT,""))
+12 IF 'ENT
SET ENT=$ORDER(^RADPT("ADC",DAYCASE,DFN,INVDAT,""))
+13 SET CONTEXT="RPT^CPRS^"_DFN_"^RA^i"_INVDAT_"-"_ENT_"^"_CASE
+14 QUIT CONTEXT
+15 ;
TIUCPRS(REFIEN) ; Return TIU CRPS context by TIU note IEN in file #8925
+1 ; REFIEN - TIU note IEN in file #8925
+2 IF REFIEN'>0
QUIT ""
+3 NEW DFN,CONTEXT
+4 SET DFN=$$GET1^DIQ(8925,REFIEN,.02,"I")
+5 SET CONTEXT="RPT^CPRS^"_DFN_"^TIU^"_REFIEN
+6 QUIT CONTEXT
