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

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

initial load of WorldVistAEHR

File size: 2.6 KB
Line 
1DIEV1 ;SFISC/DPC -- VARIABLE POINTER VALIDATION ;1:39 PM 12 Sep 2002
2 ;;22.0;VA FileMan;**26,72,90,112**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4VP(DIEVF,DIEVFLD,DIEVFLG,DIEVAL,DIEV0,DIVPOUT) ;
5 N DIVPY,DIVPHITF,DIVPZ,DIVPVP,DIVPRNUM,DIVPFILE,DIVPSAVV,DIVPAMB,DIVPFLK
6 K DIVPOUT
7 S DIVPAMB=0
8 I DIEVAL'["."!($P(DIEVAL,".")="") D ALL,DONE Q
9 S DIVPSAVV=DIEVAL,DIVPFLK=$P(DIVPSAVV,"."),DIEVAL=$P(DIVPSAVV,".",2,99)
10 N DIVPVPS D VPNUMS(DIEVF,DIEVFLD,DIVPFLK,.DIVPVPS)
11 I $D(DIVPVPS) D
12 . S DIVPVP=""
13 . F S DIVPVP=$O(DIVPVPS(DIVPVP)) Q:DIVPVP="" D FINDVP Q:DIVPAMB
14 I DIVPAMB S DIVPOUT=U Q
15 I $D(DIVPY) D DONE Q
16 S DIEVAL=DIVPSAVV
17 D ALL,DONE
18 Q
19 ;
20ALL ;
21 N DIVPORD S DIVPORD=0
22 F S DIVPORD=$O(^DD(DIEVF,DIEVFLD,"V","O",DIVPORD)) Q:'DIVPORD D Q:DIVPAMB
23 . S DIVPVP=$O(^DD(DIEVF,DIEVFLD,"V","O",DIVPORD,""))
24 . D FINDVP
25 Q
26 ;
27VPNUMS(DIEVF,DIEVFLD,DIVPFLK,DIVPVPS) ;
28 I $D(^DD(DIEVF,DIEVFLD,"V","P",DIVPFLK)) S DIVPVPS($O(^(DIVPFLK,"")))="" Q
29 N DIVPMES S DIVPMES=""
30 F S DIVPMES=$O(^DD(DIEVF,DIEVFLD,"V","M",DIVPMES)) Q:DIVPMES="" D
31 . I $P(DIVPMES,DIVPFLK)="" S DIVPVPS($O(^DD(DIEVF,DIEVFLD,"V","M",DIVPMES,"")))=""
32 S DIVPFILE=0
33 F S DIVPFILE=$O(^DD(DIEVF,DIEVFLD,"V","B",DIVPFILE)) Q:DIVPFILE="" D
34 . I $P($$GET1^DID(DIVPFILE,"","","NAME","","","A"),DIVPFLK)="" S DIVPVPS($O(^DD(DIEVF,DIEVFLD,"V","B",DIVPFILE,"")))=""
35 Q
36 ;
37FINDVP ;
38 S DIVPZ=^DD(DIEVF,DIEVFLD,"V",DIVPVP,0)
39 S DIVPFILE=+DIVPZ Q:'DIVPFILE
40 N DIVPECNT S DIVPECNT=$G(DIERR)
41 I $P(DIVPZ,U,5)="y",$G(^DD(DIEVF,DIEVFLD,"V",DIVPVP,1))]"" N DIC X ^DD(DIEVF,DIEVFLD,"V",DIVPVP,1)
42 I DIVPECNT'=$G(DIERR) D HKERR^DILIBF(DIEVF,"",DIEVFLD,"variable pointer screen") Q
43 S DIVPRNUM=$$FIND1^DIC(DIVPFILE,"","BO",DIEVAL,"",$G(DIC("S")))
44 I $D(^TMP("DIERR",$J,"E",299)) K DIVPY S DIVPAMB=1
45 I 'DIVPRNUM Q
46 I DIVPRNUM,'$D(DIVPY) S DIVPY=DIVPRNUM,DIVPHITF=DIVPFILE Q
47 I DIVPRNUM,$D(DIVPY) D
48 . K DIVPY
49 . S DIVPAMB=1
50 . N DIVPP S DIVPP(1)=DIEVAL D BLD^DIALOG(299,.DIVPP,.DIVPP)
51 Q
52 ;
53DONE ;
54 I '$G(DIVPY) S DIVPOUT=U Q
55 S DIVPOUT=DIVPY_";"_$E($$GET1^DID(DIVPHITF,"","","GLOBAL NAME","","","A"),2,99)
56 D IT
57 I DIVPOUT=U Q
58 I DIEVFLG["E" S DIVPOUT(0)=$$EXTERNAL^DILFD(DIEVF,DIEVFLD,"",DIVPOUT)
59 Q
60 ;
61IT ;
62 N X S X=DIVPOUT
63 N DIVPECNT S DIVPECNT=$G(DIERR)
64 I $G(DIEV0) X $P(DIEV0,U,5,99)
65 I '$G(DIEV0) X $P(^DD(DIEVF,DIEVFLD,0),U,5,99)
66 I DIVPECNT'=$G(DIERR) S DIVPOUT=U D HKERR^DILIBF(DIEVF,"",DIEVFLD,"input transform") Q
67 S DIVPOUT=$G(X,U)
68 Q
69 ;
70VPFILES(DIEVF,DIEVFLD,DIVPFLK,DIVPANS) ;
71 N DIVPVPS,DIEVFILE
72 D VPNUMS(DIEVF,DIEVFLD,DIVPFLK,.DIVPVPS)
73 I '$D(DIVPVPS) Q
74 N DIVPVP S DIVPVP=""
75 F S DIVPVP=$O(DIVPVPS(DIVPVP)) Q:DIVPVP="" D
76 . S DIVPANS(+^DD(DIEVF,DIEVFLD,"V",DIVPVP,0))=""
77 Q
Note: See TracBrowser for help on using the repository browser.