Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DICF2

DICF2.m

Go to the documentation of this file.
  1. DICF2 ;SEA/TOAD,SF/TKW - VA FileMan: Finder, Part 3 (All Indexes) ;24SEP2016
  1. ;;22.2;VA FileMan;**2**;Jan 05, 2016;Build 139
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
  1. ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
  1. ;;Licensed under the terms of the Apache License, Version 2.0.
  1. ;;GFT;**4,20**;
  1. ;
  1. ;
  1. CHKALL(DIFILE,DIEN,DIFIEN,DIFLAGS,DIVALUE,DISCREEN,DINUMBER,DIFORCE,DINDEX,DIDENT,DILIST,DIC,DIY,DIYX) ;
  1. ; Loop through all indexes to be searched, perform data type
  1. ; transforms on lookup values.
  1. N DIOUT
  1. I DIFLAGS["O",DIFLAGS'["p" S DIOUT=DIFLAGS N DIFLAGS S DIFLAGS=DIOUT_"X"
  1. S DIOUT=0 N DISKIP
  1. 41 F D Q:$G(DIERR)!($G(DINDEX("DONE")))!DIOUT
  1. . S DISKIP=0
  1. . N DILINK S DILINK=DIFILE_U_DINDEX
  1. . I DINDEX="#" D
  1. . . S DIFILE("CHAIN",DILINK)=""
  1. . . Q:+$P(DIVALUE,"E")'=DIVALUE Q:'$D(@DIFILE(DIFILE)@(DIVALUE))
  1. . . N DIEN S DIEN=DIVALUE D ENTRY^DICF1 Q
  1. . I '$D(DIFILE("CHAIN",DILINK)) D K DIFILE("CHAIN",DILINK)
  1. . . S DIFILE("CHAIN",DILINK)=""
  1. . . D:DIFLAGS'["Q" PREPIX(.DIFILE,DIFLAGS,.DINDEX,.DIVALUE,.DISKIP)
  1. . . I 'DISKIP D CHKONE^DICF3(.DIFLAGS,.DIVALUE,.DINDEX,.DIDENT,.DIFILE,.DIEN,DIFIEN,.DISCREEN,.DILIST,.DIC,.DIY,.DIYX)
  1. . . D CLEANIX(.DINDEX,.DIVALUE) Q
  1. 43 . I $G(DIERR)!($G(DINDEX("DONE"))) Q
  1. . I DIFLAGS["l" S (DIOUT,DINDEX("DONE"))=1 Q
  1. . D NXTINDX(.DINDEX,.DIFORCE,.DIFILE,.DIFLAGS,.DIVALUE,DINUMBER)
  1. . I DINDEX="" D Q:DINDEX=""
  1. . . S DIOUT=1
  1. . . Q:DIFLAGS'["O" Q:DIFLAGS'["X" Q:DIFLAGS["p" Q:DIDENT(-1)
  1. . . S DIFLAGS=$TR(DIFLAGS,"X"),DIOUT=0,DIFORCE(1)=1
  1. . . S DINDEX=$S(DIFLAGS["l":DINDEX("START"),DIFORCE:$P(DIFORCE(0),U),1:$$DINDEX^DICL(DIFILE,DIFLAGS))
  1. . . I DINDEX="" S DIOUT=1 Q
  1. . . D FIRSTIDX(.DINDEX,.DIFORCE,.DIFILE,DIFLAGS,.DIVALUE,DINUMBER)
  1. . . Q
  1. . D
  1. . . N DICRSR S DICRSR=0
  1. . . I DIFLAGS["P" D Q:'DICRSR
  1. . . . F S DICRSR=$O(DIDENT(DICRSR)) Q:'DICRSR Q:$D(DIDENT(DICRSR,0,1,"E"))
  1. . . . Q
  1. . . Q:'$D(DIDENT(DICRSR,0,1,"E"))
  1. . . N DISAVNO,DISAVENT S DISAVNO=DINDEX("#"),DINDEX("#")=1,DISAVENT=$G(DIDENT),DIDENT="IXE"
  1. . . D THROW^DICU11(DIFLAGS,.DIDENT,"IXE",DICRSR,1,"E",.DINDEX,1)
  1. . . S DINDEX("#")=DISAVNO,DIDENT=DISAVENT Q
  1. . Q
  1. Q
  1. ;
  1. PREPIX(DIFILE,DIFLAGS,DINDEX,DIVALUE,DISKIP) ;
  1. ; CHKALL--lookup index data type, add transform values to list
  1. N DISUB,DITYPE,DITRANEX
  1. F DISUB=1:1:DINDEX("#") D:DIVALUE(DISUB)]"" Q:$G(DIERR)
  1. . I $G(DINDEX("IXTYPE"))="S" D Q
  1. . . N X S X=$$SOUNDEX^DICF5(DINDEX(DISUB)) Q:'X
  1. . . S DIVALUE(DISUB,5)=X Q
  1. . S DITYPE=DINDEX(DISUB,"TYPE"),DITRANEX=$G(DINDEX(DISUB,"TRANEX"))
  1. . I DITYPE["F"!(DITYPE["N")!(DITRANEX]"") D
  1. . .N X,IX S IX=$G(DINDEX(DISUB,"TRANCODE")) I IX="" S IX=DITRANEX
  1. . . Q:IX=""
  1. . . S X=DIVALUE(DISUB) X IX Q:X=""
  1. . . S DIVALUE(DISUB,5)=X
  1. . . Q
  1. . N DINODE S DINODE=$G(^DD(+DINDEX(DISUB,"FILE"),+DINDEX(DISUB,"FIELD"),0))
  1. . I DITYPE["D" D PREPD^DICF5(DISUB,.DINDEX,DINODE,.DIVALUE) Q
  1. . I DITYPE["S" D PREPS^DICF5(DIFLAGS,DISUB,.DINDEX,DINODE,.DIVALUE) Q
  1. . I DITYPE'["P",DITYPE'["V" Q
  1. . I DISUB'=1 D POINT^DICF5(DISUB,DIFLAGS,.DIFILE,.DINDEX,.DIVALUE,.DISCREEN) Q
  1. . D POINT^DICF4(.DIFILE,.DIFLAGS,.DINDEX,.DIDENT,.DIEN,DIFIEN,.DISCREEN,.DIVALUE,.DIC,.DIFORCE)
  1. . I '$D(DINDEX(1,"IXROOT"))!($G(DIERR)) S DISKIP=1
  1. . I $G(DTOUT)!($G(DIROUT)) S (DISKIP,DINDEX("DONE"))=1
  1. . Q:DISKIP
  1. . Q:$G(DINDEX(1,"TRANCODE"))=""
  1. . N DII,X
  1. . S DII="" F S DII=$O(@DINDEX(1,"ROOT")@(DII)) Q:DII="" D
  1. . . K @DINDEX(1,"ROOT")@(DII)
  1. . . S X=$P(DII,"^",2) X DINDEX(1,"TRANCODE") Q:X=""
  1. . . S X=$P(DII,"^")_"^"_X,@DINDEX(1,"ROOT")@(X)="" Q
  1. . Q
  1. Q
  1. ;
  1. CLEANIX(DINDEX,DIVALUE) ;
  1. ; CHKALL--clear transform values for this index from DIVALUE arrays
  1. ; clear temporary list of pointed-to entries.
  1. N I,DISUB
  1. F DISUB=1:1:DINDEX("#") D
  1. . I $G(DINDEX(DISUB,"IXROOT"))]"" D
  1. . . I DISUB=1,DIFLAGS["l" S I=$O(@DINDEX(DISUB,"ROOT")@("")),DS("INT")=$P(I,U,2)
  1. . . S I=$P(DINDEX(DISUB,"ROOT"),",""B"")",1) Q:I=""
  1. . . K @(I_")") Q
  1. . S I=4
  1. . F S I=$O(DIVALUE(DISUB,I)) Q:'I K DIVALUE(DISUB,I)
  1. . Q
  1. Q
  1. ;
  1. FIRSTIDX(DINDEX,DIFORCE,DIFILE,DIFLAGS,DIVALUE,DINUMBER) ;
  1. ; Return data for starting index before second loop when flags["O"
  1. D N3 Q
  1. ;
  1. NXTINDX(DINDEX,DIFORCE,DIFILE,DIFLAGS,DIVALUE,DINUMBER) ;
  1. ; Return next index
  1. N D,DIGO,I,J,K,DIX1,DIX2,DIOK,DIOLDL
  1. S D=DINDEX,I=$G(DINDEX("START")),K=$G(DINDEX("MAXSUB"))
  1. D:DIFLAGS'["h"
  1. . F J=1:1:DINDEX("#") S DIOLDL(J)=DINDEX(J,"LENGTH")
  1. K DINDEX S DINDEX=D,DINDEX("WAY")=1
  1. S:I]"" DINDEX("START")=I S:K]"" DINDEX("MAXSUB")=K
  1. S (DIGO,DIOK)=0
  1. N1 I DIFORCE F D Q:DIOK!(DIGO)
  1. . I DIFLAGS["M",DIFORCE(1)=1,$P(DIFORCE(0),U,2)="" S DIGO=1 Q
  1. . S DIFORCE(1)=DIFORCE(1)+1,DINDEX=$P(DIFORCE(0),U,DIFORCE(1))
  1. . I DINDEX="#",DIFLAGS'["l",DIFLAGS'["h" S DIOK=1 Q
  1. . S:DINDEX=-1 DINDEX="" I DINDEX="" S DIOK=1 Q
  1. . I $O(^DD(DIFILE,0,"IX",DINDEX,0)),$$IDXOK(DIFILE,DINDEX) S DIOK=1 Q
  1. . S I=$O(^DD("IX","BB",DIFILE,DINDEX,0)) Q:'I
  1. . S DIOK=1 Q
  1. N2 I ('DIFORCE)!DIGO D
  1. . S (DIX1,DIX2)=DINDEX
  1. . F S DIX1=$O(^DD(DIFILE,0,"IX",DIX1)) Q:DIX1="" Q:$$IDXOK(DIFILE,DIX1)
  1. . S DIOK=0 F S DIX2=$O(^DD("IX","BB",DIFILE,DIX2)) Q:DIX2="" D Q:DIOK
  1. . . S I=$O(^DD("IX","BB",DIFILE,DIX2,0)) Q:'I
  1. . . Q:$P($G(^DD("IX",I,0)),U,14)'["L"
  1. . . S J=$O(^DD("IX",I,11.1,"AC",1,0)) Q:'J Q:$G(^DD("IX",I,11.1,J,0))=""
  1. . . S DIOK=1 Q
  1. . I DIX1'="",DIX2=""!(DIX2]DIX1) S DINDEX=DIX1 Q
  1. . S DINDEX=DIX2 Q
  1. . Q
  1. N3 Q:DINDEX="" Q:DIFLAGS["h"
  1. D INDEX^DICUIX(.DIFILE,DIFLAGS,.DINDEX,"",.DIVALUE,DINUMBER,.DISCREEN)
  1. I DINDEX("#")>1 F D=1:1:DINDEX("#") S DIVALUE(D)=$G(DIVALUE(D))
  1. N DINEWVAL S DINEWVAL=0 D
  1. . N J F J=1:1:DINDEX("#") I DIVALUE(J)]"",DINDEX(J,"LENGTH")'=$G(DIOLDL(J)) S DINEWVAL=1 Q
  1. . I DINEWVAL D XFORM^DICF1(DIFLAGS,.DIVALUE,.DISCREEN,.DINDEX)
  1. Q
  1. ;
  1. IDXOK(DIFILE,%) ; See whether selected index exists in 1 nodes of DD
  1. N DIX,%Y,DD,X Q:%="" 0
  1. S DIX=$O(^DD(DIFILE,0,"IX",%,0)) Q:'DIX 0
  1. S %Y=$O(^DD(DIFILE,0,"IX",%,DIX,0)) Q:'%Y 0
  1. F DD=0:0 S DD=$O(^DD(DIX,%Y,1,DD)) Q:'DD S X=$P($G(^(DD,0)),U,2) Q:X=%
  1. Q:'DD 0
  1. Q 1
  1. ;