Return to DIEV1.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIEV1.m, revision 1.1.1.1

1.1       snw         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