Return to DIEV1.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DIEV1	;SFISC/DPC -- VARIABLE POINTER VALIDATION ;5/9/94  09:15
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    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"),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" 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,"","",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"),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