Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MAGUTL05

MAGUTL05.m

Go to the documentation of this file.
  1. MAGUTL05 ;WOIFO/SG - MISCELLANEOUS UTILITIES ; 3/9/09 12:53pm
  1. ;;3.0;IMAGING;**93**;Dec 02, 2009;Build 163
  1. ;; Per VHA Directive 2004-038, this routine should not be modified.
  1. ;; +---------------------------------------------------------------+
  1. ;; | Property of the US Government. |
  1. ;; | No permission to copy or redistribute this software is given. |
  1. ;; | Use of unreleased versions of this software requires the user |
  1. ;; | to execute a written test agreement with the VistA Imaging |
  1. ;; | Development Office of the Department of Veterans Affairs, |
  1. ;; | telephone (301) 734-0100. |
  1. ;; | |
  1. ;; | The Food and Drug Administration classifies this software as |
  1. ;; | a medical device. As such, it may not be changed in any way. |
  1. ;; | Modifications to this software may result in an adulterated |
  1. ;; | medical device under 21CFR820, the use of which is considered |
  1. ;; | to be a violation of US Federal Statutes. |
  1. ;; +---------------------------------------------------------------+
  1. ;;
  1. Q
  1. ;
  1. ;##### PREPARES THE VALUE FOR INDIRECTION
  1. ;
  1. ; This function returns the value of the parameter prepared for
  1. ; indirect assignment:
  1. ;
  1. ; * canonic numbers are returned as is;
  1. ;
  1. ; * strings are enclosed in double quotes and double quotes inside
  1. ; them are doubled. ;-)
  1. ;
  1. DDQ(VAL) ;
  1. N TMP S TMP=$NA(A(VAL))
  1. Q $E(TMP,3,$L(TMP)-1)
  1. ;
  1. ;##### CHECKS IF THE TEXT BUFFER IS EMPTY
  1. ;
  1. ; MAG8NODE Name of a local or global node that contains the
  1. ; text (either in @MAG8NODE@(i) or in @MAG8NODE@(i,0)
  1. ; sub-nodes).
  1. ;
  1. ; Notes
  1. ; =====
  1. ;
  1. ; This function considers a buffer containing just space characters
  1. ; as empty.
  1. ;
  1. ; Return Values
  1. ; =============
  1. ; 0 The buffer is not empty
  1. ; 1 The buffer is empty
  1. ;
  1. ISWPEMPT(MAG8NODE) ;
  1. N MAG8EMPTY,MAG8I
  1. S MAG8I="",MAG8EMPTY=1
  1. F S MAG8I=$O(@MAG8NODE@(MAG8I)) Q:MAG8I="" D Q:'MAG8EMPTY
  1. . I $G(@MAG8NODE@(MAG8I))'?." " S MAG8EMPTY=0 Q
  1. . S:$G(@MAG8NODE@(MAG8I,0))'?." " MAG8EMPTY=0
  1. . Q
  1. Q MAG8EMPTY
  1. ;
  1. ;***** CHECKS IF A NEW PAGE SHOULD BE STARTED
  1. ;
  1. ; [RESERVE] Number of reserved lines (1, by default).
  1. ; If the current page does not have so many lines
  1. ; available, a new page will be started.
  1. ;
  1. ; [FORCE] Force the prompt
  1. ;
  1. ; Return Values
  1. ; =============
  1. ; -2 Timeout
  1. ; -1 User canceled the output ('^' was entered)
  1. ; 0 Continue
  1. ; 1 New page and continue
  1. ;
  1. ; Notes
  1. ; =====
  1. ;
  1. ; This entry point can also be called as a procedure:
  1. ; D PAGE^MAGUTL05(...) if you do not need its return value.
  1. ;
  1. PAGE(RESERVE,FORCE) ;
  1. N RC
  1. I ($Y'<($G(IOSL,24)-$G(RESERVE,1)))!$G(FORCE) D S $Y=0
  1. . I $E(IOST,1,2)'="C-" W @IOF Q
  1. . N DA,DIR,DIROUT,DTOUT,DUOUT,I,X,Y
  1. . S DIR(0)="E"
  1. . D ^DIR
  1. . S RC=$S($D(DUOUT):-1,$D(DTOUT):-2,1:1)
  1. . Q
  1. ;---
  1. Q:$QUIT +$G(RC) Q
  1. ;
  1. ;##### EMULATES $QUERY WITH 'DIRECTION' PARAMETER
  1. ;
  1. ; MAG8NODE Name of a node
  1. ;
  1. ; [MAG8DIR] Direction:
  1. ; $G(MAG8DIR)'<0 forward
  1. ; MAG8DIR<0 backward
  1. ;
  1. Q(MAG8NODE,MAG8DIR) ;
  1. Q:$G(MAG8DIR)'<0 $Q(@MAG8NODE)
  1. N MAG8I,MAG8PI,MAG8TMP
  1. S MAG8TMP=$QL(MAG8NODE) Q:MAG8TMP'>0 ""
  1. S MAG8I=$QS(MAG8NODE,MAG8TMP),MAG8PI=$NA(@MAG8NODE,MAG8TMP-1)
  1. ;--- Find the previous node on the "lowest" level.
  1. S MAG8I=$O(@MAG8PI@(MAG8I),-1)
  1. ;--- If there is none, then either return the parent node if it
  1. ;--- has data or perform the recursive query for the parent node.
  1. Q:MAG8I="" $S($D(@MAG8PI)#10:MAG8PI,1:$$Q(MAG8PI,-1))
  1. ;--- Otherwise, get the last "lowest" child node.
  1. F S MAG8PI=$NA(@MAG8PI@(MAG8I)) Q:$D(@MAG8PI)<10 D
  1. . S MAG8I=$O(@MAG8PI@(""),-1)
  1. . Q
  1. Q MAG8PI
  1. ;
  1. ;##### "SENTENCE" CASE CONVERSION OF THE STRING
  1. ;
  1. ; STR Source string
  1. ;
  1. ; Return Values
  1. ; =============
  1. ; The source string converted to lover case except the
  1. ; first character, which is converted to upper case.
  1. ;
  1. SNTC(STR) ;
  1. Q $$UP^XLFSTR($E(STR))_$$LOW^XLFSTR($E(STR,2,$L(STR)))
  1. ;
  1. ;##### TRANSLATES CONTROL FLAGS
  1. ;
  1. ; FLAGS Source flags
  1. ;
  1. ; SRC All characters that are not included in the value
  1. ; of the SRC parameter are removed from the string
  1. ; passed in the FLAGS parameter.
  1. ;
  1. ; [DST] If the DST parameter is defined and not empty, then
  1. ; flags defined by the SRC parameter are translated to
  1. ; their counterparts in this parameter (see the
  1. ; $TRANSLATE function for additional details).
  1. ;
  1. TRFLAGS(FLAGS,SRC,DST) ;
  1. N TMP
  1. ;--- Get flags that are not included in the SRC
  1. S TMP=$TR(FLAGS,SRC)
  1. ;--- Remove these flags
  1. S TMP=$TR(FLAGS,TMP)
  1. ;--- Translate valid flags if necessary
  1. Q $S($G(DST)'="":$TR(TMP,SRC,DST),1:TMP)
  1. ;
  1. ;##### TRUNCATES THE STRING AND APPENDS "..."
  1. ;
  1. ; STR Source string
  1. ; MAXLEN Maximum allowed length
  1. ;
  1. TRUNC(STR,MAXLEN) ;
  1. Q $S($L(STR)>MAXLEN:$E(STR,1,MAXLEN-3)_"...",1:STR)
  1. ;
  1. ;##### CHECKS IF THE PARAMETER VALUE IS A VALID PATIENT IEN (DFN)
  1. ;
  1. ; DFN Internal Entry Number of the patient record
  1. ;
  1. ; [.ERR] Reference to a local variable where the error
  1. ; descriptor (see the $$ERROR^MAGUERR) is returned to.
  1. ;
  1. ; After a successful call, this parameter is empty.
  1. ;
  1. ; These descriptors are NOT stored regarless of the
  1. ; mode set by the CLEAR^MAGUERR. If you need to store
  1. ; them (e.g. to return from an RPC), then you have to
  1. ; do this in your code (see the STORE^MAGUERR).
  1. ;
  1. ; Return Values
  1. ; =============
  1. ; 0 Parameter value is not a valid patient IEN (DFN);
  1. ; check the value of the ERR parameter for details.
  1. ; 1 Ok
  1. ;
  1. ;
  1. VALDFN(DFN,ERR) ;
  1. S ERR=""
  1. I (DFN'>0)!(+DFN'=DFN) S ERR=$$ERROR^MAGUERR("-3S",,"DFN",DFN) Q 0
  1. I '($D(^DPT(DFN,0))#2) S ERR=$$ERROR^MAGUERR("-5S",,DFN) Q 0
  1. Q 1
  1. ;
  1. ;##### VALIDATES THE IENS
  1. ;
  1. ; IENS IENS of a record or a subfile; placeholders are not
  1. ; allowed (see FileMan DBS API manual for details).
  1. ;
  1. ; [FLAGS] Flags that control the execution (can be combined):
  1. ;
  1. ; S Subfile IENS are allowed
  1. ;
  1. ; Return Values
  1. ; =============
  1. ; 0 Invalid IENS
  1. ; 1 Ok
  1. ;
  1. VALIENS(IENS,FLAGS) ;
  1. N I,L,IEN,RC
  1. S L=$L(IENS,",")
  1. ;--- The last piece should be empty (trailing comma is required)
  1. Q:$P(IENS,",",L)'="" 0
  1. ;--- The first piece should be either a canonic number or empty
  1. S I=$S(($P(IENS,",")="")&($G(FLAGS)["S"):2,1:1)
  1. ;--- All pieces in between should be canonic numbers
  1. S RC=1
  1. F I=I:1:L-1 S IEN=$P(IENS,",",I) I (IEN'>0)!(+IEN'=IEN) S RC=0 Q
  1. Q RC
  1. ;
  1. ;##### CREATES/UPDATES THE NODE HEADER IN THE ^XTMP GLOBAL
  1. ;
  1. ; SUBSCR Subscript of the node in the ^XTMP global
  1. ; [DKEEP] Number of days to keep the node (1 by default)
  1. ; [DESCR] Description of the node
  1. ;
  1. XTMPHDR(SUBSCR,DKEEP,DESCR) ;
  1. N DATE S DATE=$$DT^XLFDT S:$G(DKEEP)'>0 DKEEP=1
  1. S ^XTMP(SUBSCR,0)=$$FMADD^XLFDT(DATE,DKEEP)_U_DATE_U_$G(DESCR)
  1. Q