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

MAGGTU5.m

Go to the documentation of this file. 
  1. MAGGTU5 ;WOIFO/GEK - Silent Utilities ; [ 06/20/2001 08:57 ]
  1.  ;;3.0;IMAGING;**8,48**;Jan 11, 2005
  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. CLOSE ;Close Execute for the WS.DAT Device
  1.  Q:IO["nul"  ; OPENM calls this 'close execute' twice, we get "" array.
  1.  N MAGDT
  1.  ; IF NOT CALLED FROM IMAGING ROUTINE, USE ^TMP GLOBAL
  1.  I '$D(MAGRPTY) S MAGRPTY=$NA(^TMP($J,"WSDAT")) K @MAGRPTY
  1.  S MAGDT=$$FMTE^XLFDT($$NOW^XLFDT,"1P")
  1.  N I S I=3
  1.  U IO W !!,"** END REPORT "_MAGDT_" **",!
  1.  S X=$$REWIND^%ZIS(IO,IOT,IOPAR) I 'X S @MAGRPTY@(0)="0^Failed: Rewinding to beginning of Host File. Call IRM" Q
  1.  IF $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D EOF^MAGGTU5"
  1.  E  S X="EOF^MAGGTU5",@^%ZOSF("TRAP")
  1.  F  U IO R X:5 D  Q:X["** END REPORT "_MAGDT_" **"
  1.  . I X[$C(8)_"_" D
  1.  . . ;strip backspaces and separate underline if they exist saf 4/19/00
  1.  . . S @MAGRPTY@(I)=$E(X,1,$FIND(X,$P(X,$C(8)))-1),I=I+1
  1.  . . S @MAGRPTY@(I)=$E(X,$FIND(X,$P(X,"_")),$L(X)),I=I+1
  1.  . E  S @MAGRPTY@(I)=$$TRIM(X),I=I+1
  1.  S @MAGRPTY@(0)="1^Report Complete"
  1.  Q
  1. EOF ;
  1.  S X=$$EC^%ZOSV
  1.  I ((X["ENDOFFILE")!(X["EOF")) S @MAGRPTY(0)="1^Report Complete" Q
  1.  D ^%ZTER
  1.  S @MAGRPTY@(0)="0^ERROR: "_$$EC^%ZOSV
  1.  Q
  1.  ;
  1. DTTM(MAGRY,INDT,NOFDT) ; RPC [MAGG DTTM] Call to return DHCP Date/Time
  1.  ; Output MAGRY 
  1.  ;  0^Error message
  1.  ;  1 ^ External Date  in "Jan 04, 1999@11:55"   format  ^ Internal DateTime
  1.  ;  INDT         is the input, it is validated and the external value is returned.
  1.  ;       NOFDT   1|0
  1.  ;               Flag to Not Allow Future Dates.
  1.  ;               prior to P48 we allowed future dates.  Now the Parameter can stop that.
  1.  ;
  1.  N INPUT,Y
  1.  S X=INDT,NOFDT=+$G(NOFDT)
  1.  S %DT="TS" D ^%DT
  1.  I Y=-1 S MAGRY="0^Incorrect date format: "_X Q
  1.  S MAGRY="1^"_$$FMTE^XLFDT(Y,"1")_U_Y
  1.  Q:'NOFDT
  1.  ;    Now error if future.
  1.  S INPUT=$P(Y,".",1)
  1.  D NOW^%DTC
  1.  S X=$P(X,".",1)
  1.  I INPUT]X S MAGRY="0^Future dates are not allowed."
  1.  Q
  1. TRIM(X) ;trim backspace characters
  1.  N I,Y
  1.  S Y=X
  1.  I X[$C(8) D
  1.  . S Y=""
  1.  . F I=1:1:$L(X) I $E(X,I)'=$C(8) S Y=Y_$E(X,I)
  1.  Q Y