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

DICUIX.m

Go to the documentation of this file.
  1. DICUIX ;SEA/TOAD,SF/TKW - FileMan: Lookup Tools, 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;**20,28,67,165,1035,1041**
  1. ;
  1. ;
  1. INDEX(DIFILE,DIFLAGS,DINDEX,DIFROM,DIPART,DINUMBER,DISCREEN,DILIST,DIOUT) ;
  1. ;
  1. ; build DINDEX array data for index
  1. ;
  1. I1 ; try to find Index in Index file
  1. ;
  1. N DICODE,DIGET,DILENGTH,DINODE,DISUB,DITEMP,DITEMP2,DITO,DITOIEN,DITYPE,DIWAY,DIXIEN
  1. S DINDEX("FLIST")="",DINDEX("AT")=1,DIFROM("IEN")=+$G(DIFROM("IEN")),DIXIEN="",DIGET=1
  1. S:DINDEX'="#" DIXIEN=$O(^DD("IX","BB",DIFILE,DINDEX,""))
  1. I 'DIXIEN D XREF(.DIFILE,.DIFLAGS,.DINDEX,.DIPART,.DIFROM) Q
  1. ;
  1. I2 ; in Index file, build list of subscript data
  1. ;
  1. S DINODE=^DD("IX",DIXIEN,0)
  1. S DINDEX("IXTYPE")=$P(DINODE,U,4) S:DIFLAGS["4" DINDEX("IXFILE")=DIXIEN
  1. S DINDEX("#")=0
  1. S DISUB=$O(^DD("IX",DIXIEN,11.1,"AC","Z"),-1)
  1. I $G(DIFROM(DISUB+1)) M DIFROM("IEN")=DIFROM(DISUB+1)
  1. S (DISUB,DIOUT)=0 N S
  1. F D Q:'DISUB Q:DIOUT
  1. . S DISUB=$O(^DD("IX",DIXIEN,11.1,"AC",DISUB)) Q:'DISUB S S=$O(^(DISUB,0)) Q:'S
  1. . S DINDEX("#")=DISUB,DIGET=1
  1. . S DINODE=$G(^DD("IX",DIXIEN,11.1,S,0))
  1. . I DIFLAGS["l" N X D S DINDEX(DISUB,"PROMPT")=X
  1. . . S X=$P(DINODE,U,8) Q:X]""
  1. EGP . . I $P(DINODE,U,3),$P(DINODE,U,4) S X=$$LABEL^DIALOGZ($P(DINODE,U,3),$P(DINODE,U,4)) ;**
  1. . . Q
  1. . S DINDEX(DISUB,"FIELD")=$P(DINODE,U,4)
  1. . S DINDEX(DISUB,"FILE")=$P(DINODE,U,3)
  1. . I $P(DINODE,U,2)["C"!(DINDEX(DISUB,"FILE")="") S DINDEX(DISUB,"FIELD")=""
  1. . I DINDEX(DISUB,"FILE"),DINDEX(DISUB,"FIELD") D
  1. . . I $G(^DD("IX",DIXIEN,11.1,S,4))]"" S DINDEX(DISUB,"TRANCODE")=^(4) ;TRANSFORM FOR LOOKUP
  1. . . I $G(^DD("IX",DIXIEN,11.1,S,2))]"" D
  1. . . . I $G(^DD("IX",DIXIEN,11.1,S,3))="" S DIGET=0 Q
  1. . . . S DINDEX(DISUB,"TRANOUT")=^DD("IX",DIXIEN,11.1,S,3),DIGET=3 Q ;TRANSFORM FOR DISPLAY
  1. . . I "KSMU"[DINDEX("IXTYPE") S DIGET=2
  1. . . Q
  1. . S DILENGTH=$P(DINODE,U,5) I 'DILENGTH S DILENGTH=30 ;!(DILENGTH>100) ;GETS THE LENGTH FROM THE DEFINITION OF THE INDEX
  1. . S DIWAY=$S($P(DINODE,U,7)="B":-1,1:1)
  1. . D COMMON1^DICUIX2
  1. . Q
  1. I DIOUT S @DILIST@(0)="0^"_DINUMBER_"^0" D OUT^DICL Q
  1. D:DIFLAGS'["q" COMMON2^DICUIX2
  1. S DINDEX("FLIST")=DINDEX("FLIST")_"^"
  1. I DIFLAGS'["l",DIFLAGS'["h" Q
  1. N F,F1,F2,I S F=DINDEX("FLIST")
  1. F I=1:1:DINDEX("#") I $G(DINDEX(I,"GETEXT"))=0 S F1=$G(DINDEX(I,"FILE")),F2=$G(DINDEX(I,"FIELD")) I F1=DIFILEI,F2 D
  1. . S F1=$F(F,("^"_F2_"^")) Q:'F1 S F1=F1-2
  1. . S $E(F,(F1-$L(F2)),F1)="" Q
  1. S DINDEX("FLISTD")=F Q
  1. ;
  1. ;
  1. ;
  1. XREF(DIFILE,DIFLAGS,DINDEX,DIPART,DIFROM) ;
  1. ; Index is in "IX" nodes
  1. ;
  1. X1 ; Set DINDEX for search through upright file
  1. ;
  1. I DINDEX="#" D Q
  1. . S DINDEX("#")=0,DINDEX(1,"FILE")=DIFILE,DINDEX(1,"ROOT")=DIFILE(DIFILE),DINDEX(1,"TYPE")="N"
  1. . N X S X=$S($G(DIFROM(1)):DIFROM(1),DIPART(1):DIPART(1),1:$G(DIFROM("IEN")))
  1. . S (DIFROM,DIFROM(1))=X S:X DIFROM("IEN")=X
  1. . I DIFLAGS["l"!(DIFLAGS["h") S DINDEX("FLISTD")=""
  1. . D:DIFLAGS'["q" COMMON2^DICUIX2 Q
  1. S DINDEX("#")=1,DINDEX("IXTYPE")="R"
  1. S DINDEX(1,"FILE")=$O(^DD(DIFILE,0,"IX",DINDEX,""))
  1. ;
  1. X2 ; Build DINDEX for index in IX nodes.
  1. ;
  1. S DIOUT=0,DILENGTH=30
  1. S DINDEX(1,"FIELD")=""
  1. I DINDEX(1,"FILE") S DINDEX(1,"FIELD")=$O(^DD(DIFILE,0,"IX",DINDEX,DINDEX(1,"FILE"),""))
  1. I DINDEX(1,"FIELD")="",DINDEX="B" D
  1. . S DINDEX(1,"FILE")=DIFILE
  1. . S DINDEX(1,"FIELD")=.01 Q
  1. I DIFLAGS[3,DINDEX="B",'$D(@DIFILE(DIFILE)@("B")) D
  1. . D TMPB^DICUIX1(.DITEMP,DIFILE)
  1. . S DIFILE(DIFILE,"NO B")=DITEMP Q
  1. I DIFLAGS["l" S DINDEX(1,"PROMPT")=""
  1. I DINDEX(1,"FILE"),DINDEX(1,"FIELD") D I DINDEX("IXTYPE")="*" K DINDEX S DINDEX="" Q
  1. EGP2 . I DIFLAGS["l" S DINDEX(1,"PROMPT")=$$LABEL^DIALOGZ(DINDEX(1,"FILE"),DINDEX(1,"FIELD")) ;** FIELD LABEL
  1. . N I,X,Y,DIXFILE,DIXFIELD S DIXFILE=DINDEX(1,"FILE"),DIXFIELD=DINDEX(1,"FIELD")
  1. . F I=0:0 S I=$O(^DD(DINDEX(1,"FILE"),DINDEX(1,"FIELD"),1,I)) Q:'I S X=$G(^(I,0)) I $P(X,U,2)=DINDEX S Y=$G(^(1)) D Q
  1. . . S X=$E($P(X,U,3),1,2)
  1. . . S DINDEX("IXTYPE")=$S(X="":"R",X="KW":"K",X="SO":"S",(X="TR")!(X="BU"):"*",X]"":X,1:"R") ;WHAT KIND OF CROSS-REF IS IT?
  1. . . I "KSMU"[DINDEX("IXTYPE") S DIGET=2
  1. . . S DILENGTH=+$P(Y,"$E(X,1,",2)
  1. . . S:'DILENGTH DILENGTH=30 ;!(DILENGTH>100)
  1. . . S X=$P($P(^DD(DINDEX(1,"FILE"),DINDEX(1,"FIELD"),0),U,2),"t",2) I X,$G(^DI(.81,+X,201,2,31))]"" D ;V 23.0: EXTENDED DATA TYPE INPUT TRANSFORM
  1. ...S DINDEX(1,"TRANEX","EXTENDED")=^(31)
  1. ...S DINDEX(1,"TRANEX")="N DIPA,DIQUIET S DIQUIET=1 D DIPA^DIETLIBF("_DIXFILE_","_DIXFIELD_") X DINDEX(1,""TRANEX"",""EXTENDED"") I '$D(X) S X="""""
  1. I $G(DIFROM(2)) S DIFROM("IEN")=DIFROM(2)
  1. S DISUB=1,DIWAY=1,DIOUT=0
  1. N I,X,Y
  1. D COMMON1^DICUIX2
  1. I DIOUT S @DILIST@(0)="0^"_DINUMBER_"^0" D OUT^DICL Q
  1. D:DIFLAGS'["q" COMMON2^DICUIX2
  1. S DINDEX("FLIST")=DINDEX("FLIST")_"^"
  1. I DIFLAGS["l"!(DIFLAGS["h") D
  1. . I DIGET=2 S DINDEX("FLISTD")="^^" Q
  1. . S DINDEX("FLISTD")=DINDEX("FLIST") Q
  1. S DITEMP=$G(DIFILE(DIFILE,"NO B")) I DITEMP]"" D BLDB^DICUIX1(DIFILE(DIFILE),DITEMP)
  1. Q
  1. ;
  1. ;