DINVGTM ;VEN/SMH - GT.M (VMS) Specific Functions;30NOV2012
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
DEL(RN) ; Delete Routine; Fileman Entry Point.
; Input: Routine Name by Value
; Output: None
; Routine is NOT SAC Compliant due to use of GT.M specific IO parameters
LOOP ; Loop entry point
N %ZR ; Output from GT.M %RSEL
N %S,%O ; Source directory, object directory
;
; NB: For future works, %RSEL support * syntax to get a bunch of routines
D SILENT^%RSEL(RN,"SRC") S %S=$G(%ZR(RN)) ; Source Directory
D SILENT^%RSEL(RN,"OBJ") S %O=$G(%ZR(RN)) ; Object Directory
;
I '$L(%S)&('$L(%O)) QUIT
;
S RN=$TR(RN,"%","_") ; change % to _ in routine name
;
N $ET,$ES S $ET="Q:$ES S $EC="""" Q" ; In case somebody else deletes this; we don't crash
;
I $L(%S) D ; If source routine present?
. O %S_RN_".m":(readonly):0
. E Q
. C %S_RN_".m":(delete)
;
I $L(%O) D ; If object code present?
. O %O_RN_".obj":(readonly):0
. E Q
. C %O_RN_".obj":(delete)
G LOOP
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDINVGTM 1277 printed Sep 23, 2025@20:28:20 Page 2
DINVGTM ;VEN/SMH - GT.M (VMS) Specific Functions;30NOV2012
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
DEL(RN) ; Delete Routine; Fileman Entry Point.
+1 ; Input: Routine Name by Value
+2 ; Output: None
+3 ; Routine is NOT SAC Compliant due to use of GT.M specific IO parameters
LOOP ; Loop entry point
+1 ; Output from GT.M %RSEL
NEW %ZR
+2 ; Source directory, object directory
NEW %S,%O
+3 ;
+4 ; NB: For future works, %RSEL support * syntax to get a bunch of routines
+5 ; Source Directory
DO SILENT^%RSEL(RN,"SRC")
SET %S=$GET(%ZR(RN))
+6 ; Object Directory
DO SILENT^%RSEL(RN,"OBJ")
SET %O=$GET(%ZR(RN))
+7 ;
+8 IF '$LENGTH(%S)&('$LENGTH(%O))
QUIT
+9 ;
+10 ; change % to _ in routine name
SET RN=$TRANSLATE(RN,"%","_")
+11 ;
+12 ; In case somebody else deletes this; we don't crash
NEW $ETRAP,$ESTACK
SET $ETRAP="Q:$ES S $EC="""" Q"
+13 ;
+14 ; If source routine present?
IF $LENGTH(%S)
Begin DoDot:1
+15 OPEN %S_RN_".m":(readonly):0
+16 IF '$TEST
QUIT
+17 CLOSE %S_RN_".m":(delete)
End DoDot:1
+18 ;
+19 ; If object code present?
IF $LENGTH(%O)
Begin DoDot:1
+20 OPEN %O_RN_".obj":(readonly):0
+21 IF '$TEST
QUIT
+22 CLOSE %O_RN_".obj":(delete)
End DoDot:1
+23 GOTO LOOP
