DIFROMSK ;SCISC/DCL-DIFROM SERVER DELETE PARTS ;9:27 AM 4 Jan 2007
;;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.
;
Q
;
DEL(DIFRFILE,DIFRFLG,DIFRSA,DIFRMSGR) ;DELETE TEMPLATES
;FILE_NUMBER,FLAGS,SOURCE_ARRAY,MSG_ARRAY_ROOT
;*
;FILE_NUMBER = Template File Number
;
; (Required) -
; Forms .403 ^DIST(.403, "DIST(.403,"
; Blocks .404 ^DIST(.404, "DIST(.404,"
; Note: only Forms can be deleted in KIDS
; Input Template .402 ^DIE( "DIE"
; Print Template .4 ^DIPT( "DIPT"
; Sort Template .401 ^DIBT( "DIBT"
; Dialog .84 ^DI(.84, "DI(.84,"
;*
;FLAGS = None at this time
;*
;SOURCE_ARRAY = Source Array where the list of internal
; entry numbers are passed (IEN/DA).
; Format is: ARRAY(DA)=""
; In this example "ARRAY" is passed.
;*
;MSG_ARRAY_ROOT = Array Root where the error message will be sent.
;*
I '$D(DIQUIET) N DIQUIET S DIQUIET=1
I '$D(DIFM) N DIFM S DIFM=1
I $G(U)'="^"!($G(DT)'>0)!($G(DTIME)'>0)!('$D(DUZ)) D DT^DICRW
D I '$G(DIFRFILE) D BLD^DIALOG(9529) Q
.I $G(DIFRFILE)'>0 Q
.I DIFRFILE=.4!(DIFRFILE=.401)!(DIFRFILE=.402)!(DIFRFILE=.403)!(DIFRFILE=.404)!(DIFRFILE=.84) Q ;22*128
.S DIFRFILE=0
.Q
I $G(DIFRSA)']"" D BLD^DIALOG(9506) Q
I '$D(@DIFRSA) D BLD^DIALOG(9506) Q
N DIFRDA,DIFROOT,DIFRCR
S DIFRDA=0,DIFROOT=$$ROOT^DILFD(DIFRFILE),DIFRCR=$$ROOT^DILFD(DIFRFILE,"",1)
I DIFROOT']"" D BLD^DIALOG(9529) Q
;I $$NPT(
F S DIFRDA=$O(@DIFRSA@(DIFRDA)) Q:DIFRDA'>0 D:$D(@DIFRCR@(DIFRDA,0))
.I DIFRFILE=.4!(DIFRFILE=.401)!(DIFRFILE=.402) D DT(DIFROOT,DIFRDA) Q
.I DIFRFILE=.403 D DFB(DIFRDA) Q ;22*153 .404 to .403
.I DIFRFILE=.84,DIFRDA>10000 D DT(DIFROOT,DIFRDA) Q ;22*128
.Q
Q
;
DT(DIK,DA) ;Delete Template or Dialog ;22*128
N DIFRFILE,DIFRSA,DIFRFLG,DIFRMSGR,DIFRDA,DIFRCR,DIFROOT
N %,A,B,D0,I,W,X,Y,Z
S Y=""
D ^DIK
Q
;
DFB(DA) ;Delete Forms(.403) and Blocks(.404), within the specified form.
D EN^DDSDFRM(DA)
Q
;
EXIT I $G(DIFRMSGR)]"" D CALLOUT^DIEFU(DIFRMSGR)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIFROMSK 2502 printed Nov 22, 2024@17:58:17 Page 2
DIFROMSK ;SCISC/DCL-DIFROM SERVER DELETE PARTS ;9:27 AM 4 Jan 2007
+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 ;
+7 QUIT
+8 ;
DEL(DIFRFILE,DIFRFLG,DIFRSA,DIFRMSGR) ;DELETE TEMPLATES
+1 ;FILE_NUMBER,FLAGS,SOURCE_ARRAY,MSG_ARRAY_ROOT
+2 ;*
+3 ;FILE_NUMBER = Template File Number
+4 ;
+5 ; (Required) -
+6 ; Forms .403 ^DIST(.403, "DIST(.403,"
+7 ; Blocks .404 ^DIST(.404, "DIST(.404,"
+8 ; Note: only Forms can be deleted in KIDS
+9 ; Input Template .402 ^DIE( "DIE"
+10 ; Print Template .4 ^DIPT( "DIPT"
+11 ; Sort Template .401 ^DIBT( "DIBT"
+12 ; Dialog .84 ^DI(.84, "DI(.84,"
+13 ;*
+14 ;FLAGS = None at this time
+15 ;*
+16 ;SOURCE_ARRAY = Source Array where the list of internal
+17 ; entry numbers are passed (IEN/DA).
+18 ; Format is: ARRAY(DA)=""
+19 ; In this example "ARRAY" is passed.
+20 ;*
+21 ;MSG_ARRAY_ROOT = Array Root where the error message will be sent.
+22 ;*
+23 IF '$DATA(DIQUIET)
NEW DIQUIET
SET DIQUIET=1
+24 IF '$DATA(DIFM)
NEW DIFM
SET DIFM=1
+25 IF $GET(U)'="^"!($GET(DT)'>0)!($GET(DTIME)'>0)!('$DATA(DUZ))
DO DT^DICRW
+26 Begin DoDot:1
+27 IF $GET(DIFRFILE)'>0
QUIT
+28 ;22*128
IF DIFRFILE=.4!(DIFRFILE=.401)!(DIFRFILE=.402)!(DIFRFILE=.403)!(DIFRFILE=.404)!(DIFRFILE=.84)
QUIT
+29 SET DIFRFILE=0
+30 QUIT
End DoDot:1
IF '$GET(DIFRFILE)
DO BLD^DIALOG(9529)
QUIT
+31 IF $GET(DIFRSA)']""
DO BLD^DIALOG(9506)
QUIT
+32 IF '$DATA(@DIFRSA)
DO BLD^DIALOG(9506)
QUIT
+33 NEW DIFRDA,DIFROOT,DIFRCR
+34 SET DIFRDA=0
SET DIFROOT=$$ROOT^DILFD(DIFRFILE)
SET DIFRCR=$$ROOT^DILFD(DIFRFILE,"",1)
+35 IF DIFROOT']""
DO BLD^DIALOG(9529)
QUIT
+36 ;I $$NPT(
+37 FOR
SET DIFRDA=$ORDER(@DIFRSA@(DIFRDA))
if DIFRDA'>0
QUIT
if $DATA(@DIFRCR@(DIFRDA,0))
Begin DoDot:1
+38 IF DIFRFILE=.4!(DIFRFILE=.401)!(DIFRFILE=.402)
DO DT(DIFROOT,DIFRDA)
QUIT
+39 ;22*153 .404 to .403
IF DIFRFILE=.403
DO DFB(DIFRDA)
QUIT
+40 ;22*128
IF DIFRFILE=.84
IF DIFRDA>10000
DO DT(DIFROOT,DIFRDA)
QUIT
+41 QUIT
End DoDot:1
+42 QUIT
+43 ;
DT(DIK,DA) ;Delete Template or Dialog ;22*128
+1 NEW DIFRFILE,DIFRSA,DIFRFLG,DIFRMSGR,DIFRDA,DIFRCR,DIFROOT
+2 NEW %,A,B,D0,I,W,X,Y,Z
+3 SET Y=""
+4 DO ^DIK
+5 QUIT
+6 ;
DFB(DA) ;Delete Forms(.403) and Blocks(.404), within the specified form.
+1 DO EN^DDSDFRM(DA)
+2 QUIT
+3 ;
EXIT IF $GET(DIFRMSGR)]""
DO CALLOUT^DIEFU(DIFRMSGR)
+1 QUIT
+2 ;
