MAGSHEC ;WOIFO/JSL - IMAGING UTILITY PROGRAM ; 11 June 2010 1:33 PM
;;3.0;IMAGING;**98**;Mar 19, 2002;Build 1849;Sep 22, 2010
;; 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
;
DTRANGE(OUT,IN,LMT) ;RPC - MAG UTIL DT2IEN
;; Using DATE to find first close MAG(2005 IEN
;; OUT : result - code,message
;; IN : Input DATE range to begin with
;; LMT : 0:=limit one year, 1:NONE, 2:EndDate
N $ETRAP,$ESTACK S $ETRAP="D ERR^"_$T(+0)
N DAY,DT0,IEN,YR,X,Y,FW
S OUT(1)="0"
I $G(IN)="" S OUT(1)="-1,? Enter any Date, e.g.: Jan 1 2008 or 1/1/08" Q
S X=IN D ^%DT S DT0=Y I DT0<0 S OUT(1)="-1,Invalid date or date format entered" Q
I DT0>$$NOW^XLFDT S OUT(1)="-1,No future date" Q
I $G(LMT)=2 I ($$NOW^XLFDT-DT0)<1 S OUT(1)="-1,images from today`s date will not be copied" Q ;no today image
I '$G(LMT) D Q:OUT(1)["-1"
. S YR=($$NOW^XLFDT()-10000\10000),X=YR_"0101" ;HEC only accepts up to last FY Jan 01
. ;S X=$$NOW^XLFDT()-10000\1 ;one year old
. I DT0<X S OUT(1)="-1,Cannot request HEC 10-10 forms prior to Jan 1 of previous calendar year." Q
. Q
S IEN=$O(^MAG(2005,"AD",Y,0)) S:$G(LMT)=2 IEN=$O(^MAG(2005,"AD",Y," "),-1) ;EndDate get last IEN
I 'IEN S DT0=Y,FW=$S('$O(^MAG(2005,"AD",DT0)):-1,$G(LMT)=2:-1,1:1) D ;no image for the date DT0
. F DAY=1:1:7 S DT0=$O(^MAG(2005,"AD",DT0),FW) Q:'DT0 D Q:IEN ;find near DATE
. . S IEN=$S($G(LMT)=2:$O(^MAG(2005,"AD",DT0," "),-1),1:$O(^MAG(2005,"AD",DT0,0))) ;last/1st IEN of DATE
. Q
I ((DT0-Y)>39999)!((Y-DT0)>39999) D ;3 YR possible range
. S DAY=$O(^MAG(2005,"AD","")) I (Y<DAY) S IEN=$O(^MAG(2005,"AD",DAY,0)) I IEN S Y=DAY Q ;1st IEN
. S IEN=0,OUT(1)="-1,No image for the date entered."
S:IEN OUT(1)=IEN,OUT(2)=$P($$FMTE^XLFDT(Y,5),"@"),OUT(3)=$P($$FMTE^XLFDT(DT0,5),"@") ;MM/DD/YYYY
Q
;
ERR ; ERROR TRAP FOR RPC
N ERR S ERR=$$EC^%ZOSV
S OUT(0)="0,ETRAP: "_ERR
D @^%ZOSF("ERRTN")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGSHEC 2856 printed Nov 22, 2024@17:18:26 Page 2
MAGSHEC ;WOIFO/JSL - IMAGING UTILITY PROGRAM ; 11 June 2010 1:33 PM
+1 ;;3.0;IMAGING;**98**;Mar 19, 2002;Build 1849;Sep 22, 2010
+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 ;
DTRANGE(OUT,IN,LMT) ;RPC - MAG UTIL DT2IEN
+1 ;; Using DATE to find first close MAG(2005 IEN
+2 ;; OUT : result - code,message
+3 ;; IN : Input DATE range to begin with
+4 ;; LMT : 0:=limit one year, 1:NONE, 2:EndDate
+5 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERR^"_$TEXT(+0)
+6 NEW DAY,DT0,IEN,YR,X,Y,FW
+7 SET OUT(1)="0"
+8 IF $GET(IN)=""
SET OUT(1)="-1,? Enter any Date, e.g.: Jan 1 2008 or 1/1/08"
QUIT
+9 SET X=IN
DO ^%DT
SET DT0=Y
IF DT0<0
SET OUT(1)="-1,Invalid date or date format entered"
QUIT
+10 IF DT0>$$NOW^XLFDT
SET OUT(1)="-1,No future date"
QUIT
+11 ;no today image
IF $GET(LMT)=2
IF ($$NOW^XLFDT-DT0)<1
SET OUT(1)="-1,images from today`s date will not be copied"
QUIT
+12 IF '$GET(LMT)
Begin DoDot:1
+13 ;HEC only accepts up to last FY Jan 01
SET YR=($$NOW^XLFDT()-10000\10000)
SET X=YR_"0101"
+14 ;S X=$$NOW^XLFDT()-10000\1 ;one year old
+15 IF DT0<X
SET OUT(1)="-1,Cannot request HEC 10-10 forms prior to Jan 1 of previous calendar year."
QUIT
+16 QUIT
End DoDot:1
if OUT(1)["-1"
QUIT
+17 ;EndDate get last IEN
SET IEN=$ORDER(^MAG(2005,"AD",Y,0))
if $GET(LMT)=2
SET IEN=$ORDER(^MAG(2005,"AD",Y," "),-1)
+18 ;no image for the date DT0
IF 'IEN
SET DT0=Y
SET FW=$SELECT('$ORDER(^MAG(2005,"AD",DT0)):-1,$GET(LMT)=2:-1,1:1)
Begin DoDot:1
+19 ;find near DATE
FOR DAY=1:1:7
SET DT0=$ORDER(^MAG(2005,"AD",DT0),FW)
if 'DT0
QUIT
Begin DoDot:2
+20 ;last/1st IEN of DATE
SET IEN=$SELECT($GET(LMT)=2:$ORDER(^MAG(2005,"AD",DT0," "),-1),1:$ORDER(^MAG(2005,"AD",DT0,0)))
End DoDot:2
if IEN
QUIT
+21 QUIT
End DoDot:1
+22 ;3 YR possible range
IF ((DT0-Y)>39999)!((Y-DT0)>39999)
Begin DoDot:1
+23 ;1st IEN
SET DAY=$ORDER(^MAG(2005,"AD",""))
IF (Y<DAY)
SET IEN=$ORDER(^MAG(2005,"AD",DAY,0))
IF IEN
SET Y=DAY
QUIT
+24 SET IEN=0
SET OUT(1)="-1,No image for the date entered."
End DoDot:1
+25 ;MM/DD/YYYY
if IEN
SET OUT(1)=IEN
SET OUT(2)=$PIECE($$FMTE^XLFDT(Y,5),"@")
SET OUT(3)=$PIECE($$FMTE^XLFDT(DT0,5),"@")
+26 QUIT
+27 ;
ERR ; ERROR TRAP FOR RPC
+1 NEW ERR
SET ERR=$$EC^%ZOSV
+2 SET OUT(0)="0,ETRAP: "_ERR
+3 DO @^%ZOSF("ERRTN")
+4 QUIT
