source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DIC4.m@ 1710

Last change on this file since 1710 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.9 KB
RevLine 
[613]1DIC4 ;SFISC/TKW-VA FileMan Lookup utilities ;5:59 AM 20 Sep 2002
2 ;;22.0;VA FileMan;**4,20,70**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4EXACT ; Find next exact match on a compound index
5 N DIFLAGS,DIFIELDS,DIWRITE,DIIENS,DIFORCE,DIERR,DISCR,DIQUIET,DIIX
6 S DIFLAGS="lX" D GETPAR N DINDEX
7 D FIND^DICF(.DIFILEI,DIIENS,DIFIELDS,DIFLAGS,.DIVAL,"*",.DIFORCE,.DISCR,$G(DIC("W")),"DS","DIERR",.DIIX,.DIC,.DIY,.DIYX)
8 D:$G(DIERR) PROCERR Q
9 ;
10PARTIAL ; Find next partial match on a compound index
11 N DIFLAGS,DIFIELDS,DIWRITE,DIIENS,DIFORCE,DIERR,DISCR,DIQUIET,DIIX
12 S DIFLAGS="l" D GETPAR K DIIX("DONE") N DINDEX
13 I DIFLAGS'["Q",$G(DS("INT"))]"","VP"[DIIX(1,"TYPE") N I M I=DIVAL N DIVAL D
14 . S (I,I(1),DIIX(1),DIIX(1,"FROM"),DIIX(1,"PART"))=DS("INT")
15 . S DIIX(1,"TYPE")="F" M DIVAL=I K I Q
16 D FIND^DICF(.DIFILEI,DIIENS,DIFIELDS,DIFLAGS,.DIVAL,"*",.DIFORCE,.DISCR,$G(DIC("W")),"DS","DIERR",.DIIX,.DIC,.DIY,.DIYX)
17 D:$G(DIERR) PROCERR Q
18 ;
19SET I $P(DS(0),U,2) D SETY Q
20 S Y=-1 Q:'DS(0) D SETOUT Q
21 ;
22SETOUT ; Set variables if user up-arrowed or timed out.
23 S Y=-1 N I S I=$P(DS(0),U,2)
24 I I="U",DIC(0)'["A" S DUOUT=1
25 S:I="T" DTOUT=1 Q
26 ;
27SETY ; If entry was selected by user, set output variables.
28 S Y=DS(0,"Y")
29 S:$D(DDS) DST=DS(0,"DST")
30 S (X,X(1))=DS(0,"X"),DIYX=DS(0,"DIYX"),DIY=DS(0,"DIY")
31 N % S:$G(DIX)]"" %=DIX M DIX=DS(0,1) K DS(0),DIX("F") S:$D(%) DIX=%
32 D GOT^DIC2 I Y<0 S DS(0)="1^" Q
33 S DS(0)="1^"_+Y Q
34 ;
35GETPAR ; Set parameters for Finder call
36 D:DIFLAGS'["Q"
37 . N I S I=0 I $A(X)=34,X?.E1"""" S I=1
38 . I I!(DIC(0)["U")!(DIC(0)["M")!($G(DICR)) S DIFLAGS=DIFLAGS_"Q"
39 . Q
40 S DIIENS=$S(DIC(0)["p":",",1:DIENS)
41 I DIC(0)'["E" S DIQUIET=1
42 S (DIFORCE,DIFORCE(1))=1,DIFORCE(0)=DINDEX
43 I $D(DIC("PTRIX")) M DIFORCE("PTRIX")=DIC("PTRIX")
44 D:$G(DIC("S"))]""
45 . M DISCR("S")=DIC("S")
46 . S I="S" F S I=$O(DIC(I)) Q:$E(I)'="S" S DISCR(I)=DIC(I)
47 . Q
48 I $D(DIC("V"))]"" M DISCR("V")=DIC("V")
49 S DIFIELDS="@" M DIIX=DINDEX Q
50 ;
51ADDIX(DIFILEI,Y,DINDEX,DIX,DISCREEN) ; Put index values into DIX variable for display
52 N DISUB,DIVAL,DI0NODE,DIFILE S DI0NODE=$G(@DIFILEI(DIFILEI)@(Y,0)),DIX(1)="" M DIFILE=DIFILEI
53 I $G(DINDEX("OLDSUB")) N DIO,DIN S DIN=0 F DIO=1:1:DINDEX("OLDSUB") D
54 . S DIVAL=""
55 . I $G(DISCREEN("X",DIO,"GET"))]"" D
56 . . X DISCREEN("X",DIO,"GET") Q
57 . E S DIN=$O(DINDEX(DIN)) I DIN,DIN'>DINDEX("#") S DISUB=DIN D GETVAL
58 . S:DIVAL]"" DIX(DIO)=DIVAL Q
59 Q:$G(DINDEX("OLDSUB"))
60 F DISUB=1:1:DINDEX("#") D GETVAL S:DIVAL]"" DIX(DISUB)=DIVAL
61 Q
62GETVAL ; Return index value in DIVAL
63 I $G(DINDEX(DISUB,"TRANOUT"))]"" D Q
64 . S DIVAL=DINDEX(DISUB) Q:DIVAL="" N X S X=DIVAL
65 . X DINDEX(DISUB,"TRANOUT") S:X]"" DIVAL=X Q
66 S @DINDEX(DISUB,"GET") Q:DIVAL=""
67 I "VPSD"[DINDEX(DISUB,"TYPE")!(DISUB=1&($G(DS("INT"))]"")) D
68 . I DISUB>1,"VP"[DINDEX(DISUB,"TYPE") Q
69 . S DIVAL=$$EXT^DIC2(DINDEX(DISUB,"FILE"),DINDEX(DISUB,"FIELD"),DIVAL) Q
70 Q
71 ;
72IXCHK(DIFILEI,DINDEX,DIOK,DIALLVAL,DIVAL,DID) ; Build INDEX info, make sure indexed field not a pointer.
73 S DIOK=0 N DIVALX S DIVALX=$G(DIVAL(1))
74 N DIXIEN S DIXIEN=+$O(^DD("IX","BB",DIFILEI,DINDEX,""))
75 I DIXIEN,$G(DID)="",$P($G(^DD("IX",DIXIEN,0)),U,14)'["L" Q
76 I 'DIXIEN!('$O(^DD("IX",DIXIEN,11.1,"AC",1))) D Q
77 . N DIFLAGS S DIFLAGS="hql" S:$G(DILONGX)!(DIC(0)["T") DIFLAGS="4l"
78 . I +$P(DIVALX,"E")=DIVALX,DIC(0)["E" S DIFLAGS="4l"
79 . D INDEX^DICUIX(.DIFILEI,DIFLAGS,.DINDEX)
80 . I +$P(DIVALX,"E")=DIVALX,$G(DINDEX(1,"TYPE"))="P" D Q ;22*70
81 . . I DIC(0)["T",DIC(0)["E" S (DIOK,DIOK("T"))=1 ;22*70
82 . S DIOK=1 Q
83 D INDEX^DICUIX(.DIFILEI,"4l",.DINDEX,"",.DIVAL)
84 S (DIALLVAL,DIOK)=1
85 N I F I=1:1:DINDEX("#") S:$G(DINDEX(I,"PART"))="" DIALLVAL=0
86 Q
87 ;
88PROCERR ; Display errors generated from call to Finder.
89 I DIC(0)'["E" K DIERR Q
90 W $C(7) W:'$D(DDS) !
91 N A1,DDH,I,J S DDH=0
92 F I=1:1:+DIERR F J=0:0 S J=$O(DIERR("DIERR",I,"TEXT",J)) Q:'J D
93 . I '$D(DDS) W DIERR("DIERR",I,"TEXT",J),! Q
94 . S DDH=DDH+1,DDH(DDH)=DIERR("DIERR",I,"TEXT",J) Q
95 K DIERR I '$D(DDS) W !! Q
96 S A1="T" D LIST^DDSU Q
97 ;
Note: See TracBrowser for help on using the repository browser.