Return to DIFG.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIFG.m, revision 1.1

1.1     ! snw         1: DIFG   ;SFISC/DG(OHPRD)-FILEGRAM INSTALLER ;2/3/93  1:52 PM
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        I $D(DIFGREI) S DIFGLO="^DIAR(1.13,"_DIFGREI_",21," K DIFGLC
        !             5:        I '$D(DIFGLO) S DIFGER="1^0" Q
        !             6:        I $E(DIFGLO,$L(DIFGLO))=","!($E(DIFGLO,$L(DIFGLO))="(")
        !             7:        E  S DIFGER="1.25^0" K DIFGLO,DIFGREI Q
        !             8:        S DIFGCHKG=$S($E(DIFGLO,$L(DIFGLO))=",":$E(DIFGLO,1,$L(DIFGLO)-1)_")",1:$P(DIFGLO,"("))
        !             9:        I '$D(@(DIFGCHKG)) S DIFGER="1.5^0" K DIFGCHKG,DIFGLO,DIFGREI Q
        !            10:        D INIT,START,KILLVAR,EOJ^DIFG5
        !            11:        Q
        !            12:        ;
        !            13: INIT   S U="^"
        !            14:        K ^UTILITY("DIFG",$J),^UTILITY("DIFGFG",$J),^UTILITY("DIFGX",$J),^UTILITY("DIFG@",$J)
        !            15:        D DT^DICRW
        !            16:        S DIFGEXC="F DIFGL=1:1 Q:$E(DIFGDIX,DIFGL)'="" """
        !            17:        S DIFGLINE="S DIFGY=$O("_DIFGLO_"DIFGY)) Q:DIFGY'>0  S DIFGDIX=^(DIFGY,0) X DIFGEXC S DIFGDIX=$E(DIFGDIX,DIFGL,255)"
        !            18:        Q
        !            19:        ;
        !            20: START  S (DIFG,DIFGER,DIFGMULT,DIFGEND,DIFGO,DIFGCT,DIFGADD,DIFGTYPE,DIFGINCR,DIFGNDC)=0,DIFGY=$S('$D(DIFGLC):.9999,1:DIFGLC-.0001),DIFGNODL=1 D FILEGRAM,KILLVAR
        !            21:        D:'DIFGER ^DIFG6
        !            22:        Q
        !            23:        ;
        !            24: FILEGRAM       X DIFGLINE
        !            25:        I $P(DIFGDIX,"^")'="$DAT" S DIFGER=2_U_DIFGY D ERROR G X1
        !            26:        S DIFG("PARAM")=$P(DIFGDIX,U,4)
        !            27:        X DIFGLINE
        !            28: A      I $P(DIFGDIX,":")="ENVIRONMENT" S @($P($P(DIFGDIX,":",2),"=")_"="_$P(DIFGDIX,"=",2)) X DIFGLINE G A
        !            29:        D BASEFILE^DIFG0B G:DIFGER X1
        !            30:        D FILE
        !            31: X1     Q
        !            32:        ;
        !            33: FILE   F DIFGL=0:0 X DIFGLINE D EVAL I DIFGTYPE="TERM"!DIFGER S DIFGTYPE="" Q
        !            34:        Q
        !            35:        ;
        !            36: EVAL   D GETTYPE
        !            37:        I DIFGER G X3
        !            38:        I DIFGTYPE="TERM" G X3
        !            39:        I DIFGTYPE="MV FIELD" D ^DIFG2 G X3
        !            40:        I DIFGTYPE="SV FIELD" D ^DIFG1 G X3
        !            41:        I DIFGTYPE="WP FIELD" D ^DIFG1 G X3
        !            42:        I DIFGTYPE="SWITCH" D SWITCH^DIFG0A G X3
        !            43:        I DIFGTYPE="SKIP" ;computed field, do not process
        !            44: X3     Q
        !            45:        ;
        !            46: GETTYPE        I DIFGDIX="^"!(DIFGDIX=":")!(DIFGDIX="$END DAT") S DIFGTYPE="TERM" G X4
        !            47:        I $P(DIFGDIX,U)="$DAT"!($P(DIFGDIX,":")="$DAT") S DIFGER=3_U_DIFGY,DIFGEND=1,DIFGTYPE="TERM" D ERROR G X4
        !            48:        I $P(DIFGDIX,U,2)[":" S DIFGSTRT=$F(DIFGDIX,"^"),DIFGFIND=$E(DIFGDIX,DIFGSTRT,245) I $E(DIFGFIND,$F(DIFGFIND,":"))="^" S DIFGTYPE="SWITCH" G X4
        !            49:        D EVALFLD
        !            50: X4     Q
        !            51:        ;
        !            52: EVALFLD        I DIFG("PARAM")["N" S DIFGNUM=+$P(DIFGDIX,U,2)
        !            53:        E  S DIFGNUM=$O(^DD(DIC,"B",$P(DIFGDIX,U),""))
        !            54:        I '$D(^DD(DIC,DIFGNUM)) S DIFGER=4_U_DIFGY D ERROR G X5
        !            55:        I $P(^DD(DIC,DIFGNUM,0),U,2)["C" S DIFGTYPE="SKIP" G X5
        !            56:        I +$P(^DD(DIC,DIFGNUM,0),U,2) S DIFGMLND=^DD(DIC,DIFGNUM,0),DIFGFLDN=DIFGNUM,DIFGNUM=+$P(DIFGMLND,U,2) S DIFGTYPE=$S($P(^DD(DIFGNUM,.01,0),U,2)'["W":"MV FIELD",1:"WP FIELD")
        !            57:        E  S DIFGTYPE="SV FIELD"
        !            58: X5     Q
        !            59:        ;
        !            60: ERROR  NEW DA,DIC,DIE,X,Y
        !            61:        S X=$P(DIFGER,U,2),DIC("DR")=".02////"_$P(DIFGER,U),DIC="^DIAR(1.13,",DIC(0)="FL" D FILE^DICN S DIFGLOG=$S(Y>0:+Y,1:-1) G:DIFGLOG=-1 X6
        !            62:        S B=0 F A=$S($D(DIFGLC):DIFGLC-.0001,1:0):0 S A=$O(@(DIFGLO_"A)")) Q:'A  S B=B+1,^DIAR(1.13,+Y,21,B,0)=$S('$D(^UTILITY("DIFGFG",$J,A)):@(DIFGLO_"A,0)"),1:^UTILITY("DIFGFG",$J,A)) S:A=$P(DIFGER,U,2) $P(DIFGER,U,2)=B Q:^(0)["$END DAT"
        !            63:        S ^DIAR(1.13,+Y,21,0)="^^"_B_"^"_B_"^"_DT
        !            64:        S DIE="^DIAR(1.13,",DA=DIFGLOG,DR=".01///"_$P(DIFGER,U,2) D ^DIE K DIE,DA,DR
        !            65:        S DIFGEROR=""
        !            66: X6     K A,B Q
        !            67:        ;
        !            68: KILLVAR        K DIFGFILE,DIFGSAVE,DA,DIC,DIFGTYPE,DIFGM,DIFGNDC,DIFGNODL,DIFGADD,DIFGMO,DIFGLAGO,DIFGSKIP,DIFGDI,DIFGDICS,DIFGADD,DIFGINCR,DIFGNODL,DIFGTYPE,DIFG("SAVE")
        !            69:        K DIFGDA,DIFGDIC,DIFGFIND,DIFGFIRP,DIFGFLDN,DIFGHAT,DIFGNODE,DIFGNUM,DIFGSECP,DIFGSTRT,DIFGSVN,DIFGSVVL,DIFGMGBL
        !            70:        Q