DITMGMRI.m

DITMGMRI ;SFISC/EDE(OHPRD)-INITIALIZTION FOR ^DITMGMRG ;11/18/94  15:45

 ;;22.0;VA FileMan;;Mar 30, 1999

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

 ;

INIT ;

 K DITMGMQF,DITMGMRG("QFLG")

 S:$D(ZTQUEUED) DITMGMRG("NOTALK")=1

 S:$D(ZTSK) DITMGMRG("NOTALK")=1 ; old Kernel

 I '$D(DITMGMRG("FILE")) S DITMGMQF=20 Q

 I 'DITMGMRG("FILE") S DITMGMQF=20 Q

 I '$D(^DIC(DITMGMRG("FILE"),0,"GL")) S DITMGMQF=20 Q

 S DITMGMFG=^("GL")

 S DITMGMFL=DITMGMRG("FILE")

 I '$D(DITMGMRG("FR"))!('$D(DITMGMRG("TO"))) S DITMGMQF=21 Q

 I 'DITMGMRG("FR")!('DITMGMRG("TO"))!(DITMGMRG("FR")=DITMGMRG("TO")) S DITMGMQF=22 Q

 I '$D(@(DITMGMFG_DITMGMRG("FR")_",0)")) S DITMGMQF=23 Q

 I '$D(@(DITMGMFG_DITMGMRG("TO")_",0)")) S DITMGMQF=24 Q

 S DITMGMF=DITMGMRG("FR")

 S DITMGMT=DITMGMRG("TO")

 I $D(DITMGMRG("EXCLUDE")) D EXCLFL

 I $D(DITMGMRG("PACKAGE")),'DITMGMRG("PACKAGE") D EXCLPK

 I $D(DITMGMRG("PACKAGE")),DITMGMRG("PACKAGE") D INCLPK

 Q

 ;

EXCLFL ; EXCLUDE SUBFILES FOR EXCLUDED FILES

 NEW F,S,X,V

 S V="EXCLUDE"

 F DITMGEFL=0:0 S DITMGEFL=$O(DITMGMRG("EXCLUDE",DITMGEFL)) Q:'DITMGEFL  S F=DITMGEFL D EXCSF

 K DITMGEFL

 Q

 ;

EXCLPK ; EXCLUDE FILES/SUBFILES FROM PACKAGES

 NEW F,S,X,V

 S V="EXCLUDE"

 F DITMGEPK=0:0 S DITMGEPK=$O(^DIC(9.4,"AMRG",$S('$G(DITMGMRG("TOP FILE")):DITMGMRG("FILE"),1:DITMGMRG("TOP FILE")),DITMGEPK)) Q:'DITMGEPK  F F=0:0 S F=$O(^DIC(9.4,DITMGEPK,4,"B",F)) Q:'F  S DITMGMRG("EXCLUDE",F)="" D EXCSF

 K DITMGEPK

 Q

 ;

INCLPK ; INCLUDE FILES/SUBFILES FOR PACKAGE

 NEW F,S,X,V

 S V="PACKAGE"

 S DITMGEPK=DITMGMRG("PACKAGE") F F=0:0 S F=$O(^DIC(9.4,DITMGEPK,4,"B",F)) Q:'F  S DITMGMRG("PACKAGE",F)="" D EXCSF

 K DITMGEPK

 Q

 ;

EXCSF ; EXCLUDE/INCLUDE SUBFILES FOR ONE FILE/SUBFILE (CALLED RECURSIVELY)

 F S=0:0 S S=$O(^DD(F,"SB",S)) Q:'S  S DITMGMRG(V,S)="" D EXCSF2

 Q

 ;

EXCSF2 ; RECURSION FOR SUBFILES WITHIN SUBFILES

 S X=S

 NEW F,S

 S F=X

 D EXCSF

 Q

DITMGMRI  ;SFISC/EDE(OHPRD)-INITIALIZTION FOR ^DITMGMRG ;11/18/94  15:45

 +1       ;;22.0;VA FileMan;;Mar 30, 1999

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

 +3       ;

INIT      ;

 +1        KILL DITMGMQF,DITMGMRG("QFLG")

 +2        IF $DATA(ZTQUEUED)

               SET DITMGMRG("NOTALK")=1

 +3       ; old Kernel

           IF $DATA(ZTSK)

               SET DITMGMRG("NOTALK")=1

 +4        IF '$DATA(DITMGMRG("FILE"))

               SET DITMGMQF=20

               QUIT 

 +5        IF 'DITMGMRG("FILE")

               SET DITMGMQF=20

               QUIT 

 +6        IF '$DATA(^DIC(DITMGMRG("FILE"),0,"GL"))

               SET DITMGMQF=20

               QUIT 

 +7        SET DITMGMFG=^("GL")

 +8        SET DITMGMFL=DITMGMRG("FILE")

 +9        IF '$DATA(DITMGMRG("FR"))!('$DATA(DITMGMRG("TO")))

               SET DITMGMQF=21

               QUIT 

 +10       IF 'DITMGMRG("FR")!('DITMGMRG("TO"))!(DITMGMRG("FR")=DITMGMRG("TO"))

               SET DITMGMQF=22

               QUIT 

 +11       IF '$DATA(@(DITMGMFG_DITMGMRG("FR")_",0)"))

               SET DITMGMQF=23

               QUIT 

 +12       IF '$DATA(@(DITMGMFG_DITMGMRG("TO")_",0)"))

               SET DITMGMQF=24

               QUIT 

 +13       SET DITMGMF=DITMGMRG("FR")

 +14       SET DITMGMT=DITMGMRG("TO")

 +15       IF $DATA(DITMGMRG("EXCLUDE"))

               DO EXCLFL

 +16       IF $DATA(DITMGMRG("PACKAGE"))

               IF 'DITMGMRG("PACKAGE")

                   DO EXCLPK

 +17       IF $DATA(DITMGMRG("PACKAGE"))

               IF DITMGMRG("PACKAGE")

                   DO INCLPK

 +18       QUIT 

 +19      ;

EXCLFL    ; EXCLUDE SUBFILES FOR EXCLUDED FILES

 +1        NEW F,S,X,V

 +2        SET V="EXCLUDE"

 +3        FOR DITMGEFL=0:0

               SET DITMGEFL=$ORDER(DITMGMRG("EXCLUDE",DITMGEFL))

               IF 'DITMGEFL

                   QUIT 

               SET F=DITMGEFL

               DO EXCSF

 +4        KILL DITMGEFL

 +5        QUIT 

 +6       ;

EXCLPK    ; EXCLUDE FILES/SUBFILES FROM PACKAGES

 +1        NEW F,S,X,V

 +2        SET V="EXCLUDE"

 +3        FOR DITMGEPK=0:0

               SET DITMGEPK=$ORDER(^DIC(9.4,"AMRG",$SELECT('$GET(DITMGMRG("TOP FILE")):DITMGMRG("FILE"),1:DITMGMRG("TOP FILE")),DITMGEPK))

               IF 'DITMGEPK

                   QUIT 

               FOR F=0:0

                   SET F=$ORDER(^DIC(9.4,DITMGEPK,4,"B",F))

                   IF 'F

                       QUIT 

                   SET DITMGMRG("EXCLUDE",F)=""

                   DO EXCSF

 +4        KILL DITMGEPK

 +5        QUIT 

 +6       ;

INCLPK    ; INCLUDE FILES/SUBFILES FOR PACKAGE

 +1        NEW F,S,X,V

 +2        SET V="PACKAGE"

 +3        SET DITMGEPK=DITMGMRG("PACKAGE")

           FOR F=0:0

               SET F=$ORDER(^DIC(9.4,DITMGEPK,4,"B",F))

               IF 'F

                   QUIT 

               SET DITMGMRG("PACKAGE",F)=""

               DO EXCSF

 +4        KILL DITMGEPK

 +5        QUIT 

 +6       ;

EXCSF     ; EXCLUDE/INCLUDE SUBFILES FOR ONE FILE/SUBFILE (CALLED RECURSIVELY)

 +1        FOR S=0:0

               SET S=$ORDER(^DD(F,"SB",S))

               IF 'S

                   QUIT 

               SET DITMGMRG(V,S)=""

               DO EXCSF2

 +2        QUIT 

 +3       ;

EXCSF2    ; RECURSION FOR SUBFILES WITHIN SUBFILES

 +1        SET X=S

 +2        NEW F,S

 +3        SET F=X

 +4        DO EXCSF

 +5        QUIT