| 1 | DIEV1 ;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.
|
|---|
| 4 | VP(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 | ;
|
|---|
| 20 | ALL ;
|
|---|
| 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 | ;
|
|---|
| 27 | VPNUMS(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 | ;
|
|---|
| 37 | FINDVP ;
|
|---|
| 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 | ;
|
|---|
| 53 | DONE ;
|
|---|
| 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 | ;
|
|---|
| 61 | IT ;
|
|---|
| 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 | ;
|
|---|
| 70 | VPFILES(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
|
|---|
