Return to DIEV1.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIEV1.m, revision 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