| 1 | MAGGTU5 ;WOIFO/GEK - Silent Utilities ; [ 06/20/2001 08:57 ]
 | 
|---|
| 2 |  ;;3.0;IMAGING;**8,48**;Jan 11, 2005
 | 
|---|
| 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 |  Q
 | 
|---|
| 19 | CLOSE ;Close Execute for the WS.DAT Device
 | 
|---|
| 20 |  Q:IO["nul"  ; OPENM calls this 'close execute' twice, we get "" array.
 | 
|---|
| 21 |  N MAGDT
 | 
|---|
| 22 |  ; IF NOT CALLED FROM IMAGING ROUTINE, USE ^TMP GLOBAL
 | 
|---|
| 23 |  I '$D(MAGRPTY) S MAGRPTY=$NA(^TMP($J,"WSDAT")) K @MAGRPTY
 | 
|---|
| 24 |  S MAGDT=$$FMTE^XLFDT($$NOW^XLFDT,"1P")
 | 
|---|
| 25 |  N I S I=3
 | 
|---|
| 26 |  U IO W !!,"** END REPORT "_MAGDT_" **",!
 | 
|---|
| 27 |  S X=$$REWIND^%ZIS(IO,IOT,IOPAR) I 'X S @MAGRPTY@(0)="0^Failed: Rewinding to beginning of Host File. Call IRM" Q
 | 
|---|
| 28 |  IF $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D EOF^MAGGTU5"
 | 
|---|
| 29 |  E  S X="EOF^MAGGTU5",@^%ZOSF("TRAP")
 | 
|---|
| 30 |  F  U IO R X:5 D  Q:X["** END REPORT "_MAGDT_" **"
 | 
|---|
| 31 |  . I X[$C(8)_"_" D
 | 
|---|
| 32 |  . . ;strip backspaces and separate underline if they exist saf 4/19/00
 | 
|---|
| 33 |  . . S @MAGRPTY@(I)=$E(X,1,$FIND(X,$P(X,$C(8)))-1),I=I+1
 | 
|---|
| 34 |  . . S @MAGRPTY@(I)=$E(X,$FIND(X,$P(X,"_")),$L(X)),I=I+1
 | 
|---|
| 35 |  . E  S @MAGRPTY@(I)=$$TRIM(X),I=I+1
 | 
|---|
| 36 |  S @MAGRPTY@(0)="1^Report Complete"
 | 
|---|
| 37 |  Q
 | 
|---|
| 38 | EOF ;
 | 
|---|
| 39 |  S X=$$EC^%ZOSV
 | 
|---|
| 40 |  I ((X["ENDOFFILE")!(X["EOF")) S @MAGRPTY(0)="1^Report Complete" Q
 | 
|---|
| 41 |  D ^%ZTER
 | 
|---|
| 42 |  S @MAGRPTY@(0)="0^ERROR: "_$$EC^%ZOSV
 | 
|---|
| 43 |  Q
 | 
|---|
| 44 |  ;
 | 
|---|
| 45 | DTTM(MAGRY,INDT,NOFDT) ; RPC [MAGG DTTM] Call to return DHCP Date/Time
 | 
|---|
| 46 |  ; Output MAGRY 
 | 
|---|
| 47 |  ;  0^Error message
 | 
|---|
| 48 |  ;  1 ^ External Date  in "Jan 04, 1999@11:55"   format  ^ Internal DateTime
 | 
|---|
| 49 |  ;  INDT         is the input, it is validated and the external value is returned.
 | 
|---|
| 50 |  ;       NOFDT   1|0
 | 
|---|
| 51 |  ;               Flag to Not Allow Future Dates.
 | 
|---|
| 52 |  ;               prior to P48 we allowed future dates.  Now the Parameter can stop that.
 | 
|---|
| 53 |  ;
 | 
|---|
| 54 |  N INPUT,Y
 | 
|---|
| 55 |  S X=INDT,NOFDT=+$G(NOFDT)
 | 
|---|
| 56 |  S %DT="TS" D ^%DT
 | 
|---|
| 57 |  I Y=-1 S MAGRY="0^Incorrect date format: "_X Q
 | 
|---|
| 58 |  S MAGRY="1^"_$$FMTE^XLFDT(Y,"1")_U_Y
 | 
|---|
| 59 |  Q:'NOFDT
 | 
|---|
| 60 |  ;    Now error if future.
 | 
|---|
| 61 |  S INPUT=$P(Y,".",1)
 | 
|---|
| 62 |  D NOW^%DTC
 | 
|---|
| 63 |  S X=$P(X,".",1)
 | 
|---|
| 64 |  I INPUT]X S MAGRY="0^Future dates are not allowed."
 | 
|---|
| 65 |  Q
 | 
|---|
| 66 | TRIM(X) ;trim backspace characters
 | 
|---|
| 67 |  N I,Y
 | 
|---|
| 68 |  S Y=X
 | 
|---|
| 69 |  I X[$C(8) D
 | 
|---|
| 70 |  . S Y=""
 | 
|---|
| 71 |  . F I=1:1:$L(X) I $E(X,I)'=$C(8) S Y=Y_$E(X,I)
 | 
|---|
| 72 |  Q Y
 | 
|---|