- 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 Feb 18, 2025@23:33:58 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