MAGUTL10 ;WOIFO/SG - UTILITIES FOR REASONS ; 5/4/09 11:54am
;;3.0;IMAGING;**93**;Dec 02, 2009;Build 163
;; 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
;
;##### RETURNS THE REASON PROPERTIES
;
; RSNID Identifier of the reason: Internal Entry Number of
; the record in the MAG REASON file (#2005.88) or the
; reason code (see the FLAGS parameter).
;
; [FLAGS] Flags that control execution (can be combined):
;
; C By default, value of the RSNID parameter is
; treated as the reason IEN. If this flag is
; provided, then the reason code should be passed
; as the value of the RSNID.
;
; F Include full details (description text).
; By default, only the summary data is returned.
;
; [.DESCR] Reference to a local array where the description is
; returned if the F flag is provided.
;
; Return Values
; =============
; <0 Error descriptor (see the $$ERROR^MAGUERR)
; >0 Reason summary
; ^01: IEN of the reason in file #2005.88
; ^02: Text of the reason
; ^03: Types of the reason (combination of
; "C", "D", "P", and/or "S")
; ^04: Date of inactivation (FileMan)
; ^05: Unique code of the reason
;
GETRSN(RSNID,FLAGS,DESCR) ;
N FLDS,I,IEN,IENS,IRES,MAGBUF,MAGMSG,RC,REASON
D CLEAR^MAGUERR(1)
S RC=0,REASON="" K DESCR
;
;=== Validate parameters
S FLAGS=$G(FLAGS)
;--- Check for invalid flag(s)
Q:$TR(FLAGS,"CF")'="" $$IPVE^MAGUERR("FLAGS")
;--- Validate the reason identifier
I FLAGS["C" D Q:RC<0 RC
. S IEN=$$FIND1^DIC(2005.88,,"X",RSNID,"C",,"MAGMSG")
. I $G(DIERR) S RC=$$DBS^MAGUERR("MAGMSG",2005.88) Q
. I IEN'>0 S RC=$$ERROR^MAGUERR(-49,,RSNID) Q
. Q
E S IEN=RSNID Q:(IEN'>0)!(+IEN'=IEN) $$IPVE^MAGUERR("RSNID")
S IENS=IEN_","
;
;=== Load the data
S FLDS=".01;.02;.03;.04"_$S(FLAGS["F":";1",1:"")
D GETS^DIQ(2005.88,IENS,FLDS,"EI","MAGBUF","MAGMSG")
Q:$G(DIERR) $$DBS^MAGUERR("MAGMSG",2005.88,IENS)
;
;=== Compile the reason summary
S REASON=IEN_U_MAGBUF(2005.88,IENS,.01,"E")
S $P(REASON,U,3)=$G(MAGBUF(2005.88,IENS,.02,"I"))
S $P(REASON,U,4)=$G(MAGBUF(2005.88,IENS,.03,"I"))
S $P(REASON,U,5)=$G(MAGBUF(2005.88,IENS,.04,"I"))
;
;=== Copy the description to the output parameter
I FLAGS["F" M DESCR=MAGBUF(2005.88,IENS,1) K DESCR("E"),DESCR("I")
;
;=== Success
Q REASON
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGUTL10 3636 printed Apr 09, 2024@21:00:28 Page 2
MAGUTL10 ;WOIFO/SG - UTILITIES FOR REASONS ; 5/4/09 11:54am
+1 ;;3.0;IMAGING;**93**;Dec 02, 2009;Build 163
+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 ;; | |
+11 ;; | The Food and Drug Administration classifies this software as |
+12 ;; | a medical device. As such, it may not be changed in any way. |
+13 ;; | Modifications to this software may result in an adulterated |
+14 ;; | medical device under 21CFR820, the use of which is considered |
+15 ;; | to be a violation of US Federal Statutes. |
+16 ;; +---------------------------------------------------------------+
+17 ;;
+18 QUIT
+19 ;
+20 ;##### RETURNS THE REASON PROPERTIES
+21 ;
+22 ; RSNID Identifier of the reason: Internal Entry Number of
+23 ; the record in the MAG REASON file (#2005.88) or the
+24 ; reason code (see the FLAGS parameter).
+25 ;
+26 ; [FLAGS] Flags that control execution (can be combined):
+27 ;
+28 ; C By default, value of the RSNID parameter is
+29 ; treated as the reason IEN. If this flag is
+30 ; provided, then the reason code should be passed
+31 ; as the value of the RSNID.
+32 ;
+33 ; F Include full details (description text).
+34 ; By default, only the summary data is returned.
+35 ;
+36 ; [.DESCR] Reference to a local array where the description is
+37 ; returned if the F flag is provided.
+38 ;
+39 ; Return Values
+40 ; =============
+41 ; <0 Error descriptor (see the $$ERROR^MAGUERR)
+42 ; >0 Reason summary
+43 ; ^01: IEN of the reason in file #2005.88
+44 ; ^02: Text of the reason
+45 ; ^03: Types of the reason (combination of
+46 ; "C", "D", "P", and/or "S")
+47 ; ^04: Date of inactivation (FileMan)
+48 ; ^05: Unique code of the reason
+49 ;
GETRSN(RSNID,FLAGS,DESCR) ;
+1 NEW FLDS,I,IEN,IENS,IRES,MAGBUF,MAGMSG,RC,REASON
+2 DO CLEAR^MAGUERR(1)
+3 SET RC=0
SET REASON=""
KILL DESCR
+4 ;
+5 ;=== Validate parameters
+6 SET FLAGS=$GET(FLAGS)
+7 ;--- Check for invalid flag(s)
+8 if $TRANSLATE(FLAGS,"CF")'=""
QUIT $$IPVE^MAGUERR("FLAGS")
+9 ;--- Validate the reason identifier
+10 IF FLAGS["C"
Begin DoDot:1
+11 SET IEN=$$FIND1^DIC(2005.88,,"X",RSNID,"C",,"MAGMSG")
+12 IF $GET(DIERR)
SET RC=$$DBS^MAGUERR("MAGMSG",2005.88)
QUIT
+13 IF IEN'>0
SET RC=$$ERROR^MAGUERR(-49,,RSNID)
QUIT
+14 QUIT
End DoDot:1
if RC<0
QUIT RC
+15 IF '$TEST
SET IEN=RSNID
if (IEN'>0)!(+IEN'=IEN)
QUIT $$IPVE^MAGUERR("RSNID")
+16 SET IENS=IEN_","
+17 ;
+18 ;=== Load the data
+19 SET FLDS=".01;.02;.03;.04"_$SELECT(FLAGS["F":";1",1:"")
+20 DO GETS^DIQ(2005.88,IENS,FLDS,"EI","MAGBUF","MAGMSG")
+21 if $GET(DIERR)
QUIT $$DBS^MAGUERR("MAGMSG",2005.88,IENS)
+22 ;
+23 ;=== Compile the reason summary
+24 SET REASON=IEN_U_MAGBUF(2005.88,IENS,.01,"E")
+25 SET $PIECE(REASON,U,3)=$GET(MAGBUF(2005.88,IENS,.02,"I"))
+26 SET $PIECE(REASON,U,4)=$GET(MAGBUF(2005.88,IENS,.03,"I"))
+27 SET $PIECE(REASON,U,5)=$GET(MAGBUF(2005.88,IENS,.04,"I"))
+28 ;
+29 ;=== Copy the description to the output parameter
+30 IF FLAGS["F"
MERGE DESCR=MAGBUF(2005.88,IENS,1)
KILL DESCR("E"),DESCR("I")
+31 ;
+32 ;=== Success
+33 QUIT REASON
