source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGTU5.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.9 KB
Line 
1MAGGTU5 ;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
19CLOSE ;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
38EOF ;
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 ;
45DTTM(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
66TRIM(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
Note: See TracBrowser for help on using the repository browser.