source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DICM3.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.2 KB
RevLine 
[613]1DICM3 ;SFISC/XAK,TKW-PROCESS INDIVIDUAL FILE FOR VAR PTR ;12/7/99 14:59
2 ;;22.0;VA FileMan;**16,4,20**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4DIC ; Does recursive ^DIC call to single pointed-to file.
5 Q:$D(DIVP(+DIVPDIC))
6 I $D(DIV("V")) N % D X % I '$T K Y S Y=-1 D DQ Q
7 . S Y=DIVP,Y(0)=DIVPDIC
8 . S %=$S($G(DIV("V"))]"":DIV("V"),1:$G(DIV("V",1))) Q
9 I '$D(^DIC(+DIVPDIC,0,"GL")) S Y=-1 D DQ Q
10 S (Y,DIC)=^("GL"),%="DIC"_DICR
11 N:'$D(DIVPSEL) DIVPSEL S DIVPSEL(DICR)=0
12 S D=$G(DICR(DICR,4)) S:D="" D="B"
13 I DIC["""" S Y="" F A1=1:1:$L(DIC,",")-1 S A0=$P(DIC,",",A1) S:A0["""" A0=$P(A0,"""")_""""""_$P(A0,"""",2)_""""""_$P(A0,"""",3) S Y=Y_A0_","
14 ;
15 ; Build screen to select only pointed-to entries.
16 K DIC("S") N DICODE S DICODE=""
17 I DIC(0)'["L"!'$D(DICR(DICR,"V")) D
18 . N DIX S DIX=""""_D_"""" D
19 . . I $G(DINDEX("#"))>1 D BLDC^DICM0("("_DIVDIC,DIX,DINDEX("#"),DIFILEI,Y,.DICODE,.DICR) Q
20 . . S DICODE="X ""I 0"" N "_%_$S($D(DICR(DICR,"S")):",%Y"_DICR,1:"")_" "
21 . . S DICODE=DICODE_"F "_%_"=0:0 S "_%_"=$O("_DIVDIC_DIX_",(+Y_"";"_$E(Y,2,99)_"""),"_%_")) Q:"_%_"'>0 I $D("_DIVDIC_%_",0))"
22 . . I DIC(0)["T",DICR=1 S DICODE=DICODE_$$CHKTMP^DICM0(.DIC,DICR,DIFILEI,%)
23 . . I $D(DICR(DICR,"S")) S DICODE=DICODE_" S %Y"_DICR_"=Y,Y="_%_" X DICR("_DICR_",""S"") S Y=%Y"_DICR_" I "
24 . . S DICODE=DICODE_" Q" Q
25 . S:DICODE]"" DIC("S")=DICODE Q
26 ;
27 ; Set DIC(0)
28 S %=DIC(0),DIC(0)="D"_$E("M",%'["B") D
29 . N I F I="E","O","B","T","V" I %[I S DIC(0)=DIC(0)_I
30 . Q
31 I %["L",$D(DICR(DICR,"V")),$$OKTOADD^DICM0(DIVDO,.DINDEX,.DIFINDER) D
32 . I $P(DIVPDIC,U,6)="y" S DIC(0)=DIC(0)_"L"
33 . ; Execute screen code for screened pointer (should set DIC("S")).
34 . K D Q:$P(DIVPDIC,U,5)'="y"
35 . N DICODE S DICODE=$G(^DD(DIVDO,DIVY,"V",DIVP,1)) Q:DICODE=""
36 . N DICSSAV S DICSSAV=$G(DIC("S"))
37 . X DICODE
38 . S DIC("S")=$G(DIC("S"))_$S(DICSSAV]"":" "_DICSSAV,1:"")
39 . Q
40 E K D
41 ; If user passed list of indexes to use on pointed-to file, setup.
42 S %=$G(DIC("PTRIX",DIFILEI,DINDEX(1,"FIELD"),+DIVPDIC))
43 I %]"" N DF,DID S D=% D SETIX^DICM0(.D,.DIC,.DID,.DF)
44 S:$G(D)="" D="B" N DISAVED S DISAVED=D
45 ;
46 ; Write prompt
47 I DIC(0)["E" D
48 . I $G(DICODE)="" D H1^DIE3 W:'$D(DDS) ! Q
49 . D H1 Q
50 ;
51 ; Set up rest of variables needed for DQ^DICQ or ^DIC call.
52 D DO^DIC1
53 N DS,DINDEX,DIFILEI
54 S D=DISAVED K DISAVED
55 ; Handle ? help
56 I X?."?" D D DQ Q
57 . S DZ=X_$E("?",'$D(DICR(DICR,"V")))
58 . D DQ^DICQ S X=$S($D(DZ):DZ,1:"?"),Y=-1 Q
59 ; Do ^DIC call.
60 D X^DIC I $D(DUOUT) D DQ Q
61 ;
62 ; Process output from ^DIC call.
63 S X=+Y_";"_$E(DIC,2,99),%=1 K:Y<0 X
64 I Y<0,DIC(0)["E",$D(DIVP1),$D(DICR(DICR,"V")) W !
65 I '$D(DICR(DICR,"V"))!(DICR>1) K DICR("^",+DIVPDIC) S DIVP(+DIVPDIC)=0
66 I Y>0,'DIVPSEL(DICR),DIC(0)["E",'$P(Y,U,3),$P(@(DIC_"0)"),U,2)'["O" D
67 . N I F I=(DICR-1):-1 Q:'$D(DIVPSEL(I)) S DIVPSEL(I)=1
68 . D S1^DIE3 I $G(%Y)?1"^^".E S (DIROUT,DUOUT)=1
69 . Q
70DQ I $D(DIC("PTRIX")) M DIV("PTRIX")=DIC("PTRIX")
71 K A0,A1,DIC,DO S DIC=DIVDIC,D=$S($D(DICR(DICR,4)):DICR(DICR,4),1:"B")
72 S DIC(0)=DICR(DICR,0)
73 F %="V","PTRIX" I $D(DIV(%)) M DIC(%)=DIV(%)
74 Q
75 ;
76H1 W:'$D(DDS) !
77 N A1,DST,DIPAR S A1="T"
78 S DIPAR(1)=$P(DIVPDIC,U,2),DIPAR(2)=$P($G(^DD(DIVDO,DIVY,0)),U)
79 S DST=$$EZBLD^DIALOG(8097,.DIPAR)
80 D S^DIE3 W:'$D(DDS) ! Q
81 ;
82 ;8070 Searching for a |1|
83 ;8097 Searching for a |1|, (pointed-to by |2|)
84 ;
Note: See TracBrowser for help on using the repository browser.