DIFROMSK.m

DIFROMSK ;SCISC/DCL-DIFROM SERVER DELETE PARTS ;9:27 AM  4 Jan 2007

 ;;22.0;VA FileMan;**128,153**;Mar 30, 1999;Build 1

 ;Per VHA Directive 10-93-142, this routine should not be modified.

 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

 ;

DIFROMSK  ;SCISC/DCL-DIFROM SERVER DELETE PARTS ;9:27 AM  4 Jan 2007

 +1       ;;22.0;VA FileMan;**128,153**;Mar 30, 1999;Build 1

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

 +3        QUIT 

 +4       ;

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       ;