MAGGTU5 ;WOIFO/GEK - Silent Utilities ; [ 06/20/2001 08:57 ]
;;3.0;IMAGING;**8,48**;Jan 11, 2005
;; +---------------------------------------------------------------+
;; | 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
CLOSE ;Close Execute for the WS.DAT Device
Q:IO["nul" ; OPENM calls this 'close execute' twice, we get "" array.
N MAGDT
; IF NOT CALLED FROM IMAGING ROUTINE, USE ^TMP GLOBAL
I '$D(MAGRPTY) S MAGRPTY=$NA(^TMP($J,"WSDAT")) K @MAGRPTY
S MAGDT=$$FMTE^XLFDT($$NOW^XLFDT,"1P")
N I S I=3
U IO W !!,"** END REPORT "_MAGDT_" **",!
S X=$$REWIND^%ZIS(IO,IOT,IOPAR) I 'X S @MAGRPTY@(0)="0^Failed: Rewinding to beginning of Host File. Call IRM" Q
IF $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D EOF^MAGGTU5"
E S X="EOF^MAGGTU5",@^%ZOSF("TRAP")
F U IO R X:5 D Q:X["** END REPORT "_MAGDT_" **"
. I X[$C(8)_"_" D
. . ;strip backspaces and separate underline if they exist saf 4/19/00
. . S @MAGRPTY@(I)=$E(X,1,$FIND(X,$P(X,$C(8)))-1),I=I+1
. . S @MAGRPTY@(I)=$E(X,$FIND(X,$P(X,"_")),$L(X)),I=I+1
. E S @MAGRPTY@(I)=$$TRIM(X),I=I+1
S @MAGRPTY@(0)="1^Report Complete"
Q
EOF ;
S X=$$EC^%ZOSV
I ((X["ENDOFFILE")!(X["EOF")) S @MAGRPTY(0)="1^Report Complete" Q
D ^%ZTER
S @MAGRPTY@(0)="0^ERROR: "_$$EC^%ZOSV
Q
;
DTTM(MAGRY,INDT,NOFDT) ; RPC [MAGG DTTM] Call to return DHCP Date/Time
; Output MAGRY
; 0^Error message
; 1 ^ External Date in "Jan 04, 1999@11:55" format ^ Internal DateTime
; INDT is the input, it is validated and the external value is returned.
; NOFDT 1|0
; Flag to Not Allow Future Dates.
; prior to P48 we allowed future dates. Now the Parameter can stop that.
;
N INPUT,Y
S X=INDT,NOFDT=+$G(NOFDT)
S %DT="TS" D ^%DT
I Y=-1 S MAGRY="0^Incorrect date format: "_X Q
S MAGRY="1^"_$$FMTE^XLFDT(Y,"1")_U_Y
Q:'NOFDT
; Now error if future.
S INPUT=$P(Y,".",1)
D NOW^%DTC
S X=$P(X,".",1)
I INPUT]X S MAGRY="0^Future dates are not allowed."
Q
TRIM(X) ;trim backspace characters
N I,Y
S Y=X
I X[$C(8) D
. S Y=""
. F I=1:1:$L(X) I $E(X,I)'=$C(8) S Y=Y_$E(X,I)
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGGTU5 3017 printed Nov 22, 2024@17:13:37 Page 2
MAGGTU5 ;WOIFO/GEK - Silent Utilities ; [ 06/20/2001 08:57 ]
+1 ;;3.0;IMAGING;**8,48**;Jan 11, 2005
+2 ;; +---------------------------------------------------------------+
+3 ;; | Property of the US Government. |
+4 ;; | No permission to copy or redistribute this software is given. |
+5 ;; | Use of unreleased versions of this software requires the user |
+6 ;; | to execute a written test agreement with the VistA Imaging |
+7 ;; | Development Office of the Department of Veterans Affairs, |
+8 ;; | telephone (301) 734-0100. |
+9 ;; | |
+10 ;; | The Food and Drug Administration classifies this software as |
+11 ;; | a medical device. As such, it may not be changed in any way. |
+12 ;; | Modifications to this software may result in an adulterated |
+13 ;; | medical device under 21CFR820, the use of which is considered |
+14 ;; | to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
+17 QUIT
CLOSE ;Close Execute for the WS.DAT Device
+1 ; OPENM calls this 'close execute' twice, we get "" array.
if IO["nul"
QUIT
+2 NEW MAGDT
+3 ; IF NOT CALLED FROM IMAGING ROUTINE, USE ^TMP GLOBAL
+4 IF '$DATA(MAGRPTY)
SET MAGRPTY=$NAME(^TMP($JOB,"WSDAT"))
KILL @MAGRPTY
+5 SET MAGDT=$$FMTE^XLFDT($$NOW^XLFDT,"1P")
+6 NEW I
SET I=3
+7 USE IO
WRITE !!,"** END REPORT "_MAGDT_" **",!
+8 SET X=$$REWIND^%ZIS(IO,IOT,IOPAR)
IF 'X
SET @MAGRPTY@(0)="0^Failed: Rewinding to beginning of Host File. Call IRM"
QUIT
+9 IF $$NEWERR^%ZTER
NEW $ETRAP,$ESTACK
SET $ETRAP="D EOF^MAGGTU5"
+10 IF '$TEST
SET X="EOF^MAGGTU5"
SET @^%ZOSF("TRAP")
+11 FOR
USE IO
READ X:5
Begin DoDot:1
+12 IF X[$CHAR(8)_"_"
Begin DoDot:2
+13 ;strip backspaces and separate underline if they exist saf 4/19/00
+14 SET @MAGRPTY@(I)=$EXTRACT(X,1,$FIND(X,$PIECE(X,$CHAR(8)))-1)
SET I=I+1
+15 SET @MAGRPTY@(I)=$EXTRACT(X,$FIND(X,$PIECE(X,"_")),$LENGTH(X))
SET I=I+1
End DoDot:2
+16 IF '$TEST
SET @MAGRPTY@(I)=$$TRIM(X)
SET I=I+1
End DoDot:1
if X["** END REPORT "_MAGDT_" **"
QUIT
+17 SET @MAGRPTY@(0)="1^Report Complete"
+18 QUIT
EOF ;
+1 SET X=$$EC^%ZOSV
+2 IF ((X["ENDOFFILE")!(X["EOF"))
SET @MAGRPTY(0)="1^Report Complete"
QUIT
+3 DO ^%ZTER
+4 SET @MAGRPTY@(0)="0^ERROR: "_$$EC^%ZOSV
+5 QUIT
+6 ;
DTTM(MAGRY,INDT,NOFDT) ; RPC [MAGG DTTM] Call to return DHCP Date/Time
+1 ; Output MAGRY
+2 ; 0^Error message
+3 ; 1 ^ External Date in "Jan 04, 1999@11:55" format ^ Internal DateTime
+4 ; INDT is the input, it is validated and the external value is returned.
+5 ; NOFDT 1|0
+6 ; Flag to Not Allow Future Dates.
+7 ; prior to P48 we allowed future dates. Now the Parameter can stop that.
+8 ;
+9 NEW INPUT,Y
+10 SET X=INDT
SET NOFDT=+$GET(NOFDT)
+11 SET %DT="TS"
DO ^%DT
+12 IF Y=-1
SET MAGRY="0^Incorrect date format: "_X
QUIT
+13 SET MAGRY="1^"_$$FMTE^XLFDT(Y,"1")_U_Y
+14 if 'NOFDT
QUIT
+15 ; Now error if future.
+16 SET INPUT=$PIECE(Y,".",1)
+17 DO NOW^%DTC
+18 SET X=$PIECE(X,".",1)
+19 IF INPUT]X
SET MAGRY="0^Future dates are not allowed."
+20 QUIT
TRIM(X) ;trim backspace characters
+1 NEW I,Y
+2 SET Y=X
+3 IF X[$CHAR(8)
Begin DoDot:1
+4 SET Y=""
+5 FOR I=1:1:$LENGTH(X)
IF $EXTRACT(X,I)'=$CHAR(8)
SET Y=Y_$EXTRACT(X,I)
End DoDot:1
+6 QUIT Y
