DITMGMRI ;SFISC/EDE(OHPRD)-INITIALIZTION FOR ^DITMGMRG ;11/18/94 15:45
;;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.
;
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDITMGMRI 2137 printed Nov 22, 2024@18:04:20 Page 2
DITMGMRI ;SFISC/EDE(OHPRD)-INITIALIZTION FOR ^DITMGMRG ;11/18/94 15:45
+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 ;
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
