DITMGM2B ;SFISC/EDE(OHPRD),TKW-CONTINUATION OF DITMGM2 ;4/7/94 10:09
;;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.
;
;
SEARCH ; $O THRU DATA GBL
Q:'$O(@(DITMGMG_"0)"))
W:'$D(DITMGM2("NOTALK")) !,"No REGULAR xref on ",DITMGMFL,",",DITMGMFD,". ",+$P(^(0),U,4)," entries. Searching data global."
F DITMGMN=0:0 S DITMGMN=$O(@(DITMGMG_DITMGMN_")")) Q:DITMGMN'=+DITMGMN D
. I DITMGMMU D SEARCHM Q
. I $D(^(DITMGMN,DITMGMNO)),$P(^(DITMGMNO),U,DITMGMPC)=DITMGMF D ENTRY
. Q
Q
;
SEARCHM ; $O THRU DATA GBL FOR MULTIPLES (TOP)
S DITMGMDN=+$P(DITMGMGM,"DA(",2)
S DA(DITMGMDN)=DITMGMN,DITMGDA(DITMGMDN)=DITMGMN
S DITMGMGG=$P(DITMGMGM,"DA(",1)_"DA("_DITMGMDN_"),"
S DITMGMDN=DITMGMDN-1
NEW DITMGMN
D SEARCHM2
K DA,DITMGDA,DITMGMGG
Q
;
SEARCHM2 ; MIDDLE (CALLED RECURSIVELY)
I '$F(DITMGMGM,"DA("_DITMGMDN_"),") D SEARCHM3 Q
S DITMGMGG=$P(DITMGMGM,",DA("_DITMGMDN_"),",1)_","
F DITMGDA(DITMGMDN)=0:0 S DITMGDA(DITMGMDN)=$O(@(DITMGMGG_DITMGDA(DITMGMDN)_")")) Q:DITMGDA(DITMGMDN)'=+DITMGDA(DITMGMDN) S DA(DITMGMDN)=DITMGDA(DITMGMDN) D SEARCHM4
Q
;
SEARCHM3 ; BOTTOM
D SETDA
F DITMGMN=0:0 S DITMGMN=$O(@(DITMGMGM_DITMGMN_")")) Q:DITMGMN'=+DITMGMN I $D(^(DITMGMN,DITMGMNO)),$P(^(DITMGMNO),U,DITMGMPC)=DITMGMF D ENTRY,SETDA
Q
;
SETDA ; SET DA ARRAY
K DA
F I=1:1 Q:'$D(DITMGDA(I)) S DA(I)=DITMGDA(I)
Q
;
SEARCHM4 ; RECURSE
S DITMGMDN=DITMGMDN-1
D SEARCHM2
S DITMGMDN=DITMGMDN+1
Q
;
ENTRY ; PROCESS ONE FILE/SUBFILE ENTRY
D ENTRY^DITMGM2C
Q
;
INIT ;
K DITMGMQF
K DITMGMRG("ERROR") S DITMGMEC=0
S:$D(ZTQUEUED) DITMGM2("NOTALK")=1
S:$D(ZTSK) DITMGM2("NOTALK")=1 ; old Kernel
I '$D(DITMGMFL) S DITMGMQF=20 Q
I 'DITMGMFL S DITMGMQF=20 Q
I '$D(^DIC(DITMGMFL,0,"GL")) S DITMGMQF=20 Q
S DITMGMFG=^("GL")
I '$D(DITMGMF)!('$D(DITMGMT)) S DITMGMQF=21 Q
I 'DITMGMF!('DITMGMT)!(DITMGMF=DITMGMT) S DITMGMQF=22 Q
I '$D(@(DITMGMFG_DITMGMF_",0)")) S DITMGMQF=23 Q
I '$D(@(DITMGMFG_DITMGMT_",0)")) S DITMGMQF=24 Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDITMGM2B 2259 printed Nov 22, 2024@18:04:17 Page 2
DITMGM2B ;SFISC/EDE(OHPRD),TKW-CONTINUATION OF DITMGM2 ;4/7/94 10:09
+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 ;
SEARCH ; $O THRU DATA GBL
+1 if '$ORDER(@(DITMGMG_"0)"))
QUIT
+2 if '$DATA(DITMGM2("NOTALK"))
WRITE !,"No REGULAR xref on ",DITMGMFL,",",DITMGMFD,". ",+$PIECE(^(0),U,4)," entries. Searching data global."
+3 FOR DITMGMN=0:0
SET DITMGMN=$ORDER(@(DITMGMG_DITMGMN_")"))
if DITMGMN'=+DITMGMN
QUIT
Begin DoDot:1
+4 IF DITMGMMU
DO SEARCHM
QUIT
+5 IF $DATA(^(DITMGMN,DITMGMNO))
IF $PIECE(^(DITMGMNO),U,DITMGMPC)=DITMGMF
DO ENTRY
+6 QUIT
End DoDot:1
+7 QUIT
+8 ;
SEARCHM ; $O THRU DATA GBL FOR MULTIPLES (TOP)
+1 SET DITMGMDN=+$PIECE(DITMGMGM,"DA(",2)
+2 SET DA(DITMGMDN)=DITMGMN
SET DITMGDA(DITMGMDN)=DITMGMN
+3 SET DITMGMGG=$PIECE(DITMGMGM,"DA(",1)_"DA("_DITMGMDN_"),"
+4 SET DITMGMDN=DITMGMDN-1
+5 NEW DITMGMN
+6 DO SEARCHM2
+7 KILL DA,DITMGDA,DITMGMGG
+8 QUIT
+9 ;
SEARCHM2 ; MIDDLE (CALLED RECURSIVELY)
+1 IF '$FIND(DITMGMGM,"DA("_DITMGMDN_"),")
DO SEARCHM3
QUIT
+2 SET DITMGMGG=$PIECE(DITMGMGM,",DA("_DITMGMDN_"),",1)_","
+3 FOR DITMGDA(DITMGMDN)=0:0
SET DITMGDA(DITMGMDN)=$ORDER(@(DITMGMGG_DITMGDA(DITMGMDN)_")"))
if DITMGDA(DITMGMDN)'=+DITMGDA(DITMGMDN)
QUIT
SET DA(DITMGMDN)=DITMGDA(DITMGMDN)
DO SEARCHM4
+4 QUIT
+5 ;
SEARCHM3 ; BOTTOM
+1 DO SETDA
+2 FOR DITMGMN=0:0
SET DITMGMN=$ORDER(@(DITMGMGM_DITMGMN_")"))
if DITMGMN'=+DITMGMN
QUIT
IF $DATA(^(DITMGMN,DITMGMNO))
IF $PIECE(^(DITMGMNO),U,DITMGMPC)=DITMGMF
DO ENTRY
DO SETDA
+3 QUIT
+4 ;
SETDA ; SET DA ARRAY
+1 KILL DA
+2 FOR I=1:1
if '$DATA(DITMGDA(I))
QUIT
SET DA(I)=DITMGDA(I)
+3 QUIT
+4 ;
SEARCHM4 ; RECURSE
+1 SET DITMGMDN=DITMGMDN-1
+2 DO SEARCHM2
+3 SET DITMGMDN=DITMGMDN+1
+4 QUIT
+5 ;
ENTRY ; PROCESS ONE FILE/SUBFILE ENTRY
+1 DO ENTRY^DITMGM2C
+2 QUIT
+3 ;
INIT ;
+1 KILL DITMGMQF
+2 KILL DITMGMRG("ERROR")
SET DITMGMEC=0
+3 if $DATA(ZTQUEUED)
SET DITMGM2("NOTALK")=1
+4 ; old Kernel
if $DATA(ZTSK)
SET DITMGM2("NOTALK")=1
+5 IF '$DATA(DITMGMFL)
SET DITMGMQF=20
QUIT
+6 IF 'DITMGMFL
SET DITMGMQF=20
QUIT
+7 IF '$DATA(^DIC(DITMGMFL,0,"GL"))
SET DITMGMQF=20
QUIT
+8 SET DITMGMFG=^("GL")
+9 IF '$DATA(DITMGMF)!('$DATA(DITMGMT))
SET DITMGMQF=21
QUIT
+10 IF 'DITMGMF!('DITMGMT)!(DITMGMF=DITMGMT)
SET DITMGMQF=22
QUIT
+11 IF '$DATA(@(DITMGMFG_DITMGMF_",0)"))
SET DITMGMQF=23
QUIT
+12 IF '$DATA(@(DITMGMFG_DITMGMT_",0)"))
SET DITMGMQF=24
QUIT
+13 QUIT
