Return to DIFG5.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIFG5.m, revision 1.1

1.1     ! snw         1: DIFG5  ;SFISC/DG(OHPRD)-MISC FUNCTIONS ;3/11/93  1:25 PM
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4: CHECKY ;CHECKS Y AFTER DIC CALL
        !             5:        I Y>0,DIFGTYP="FILE"!(DIFGTYP="MV FIELD"),$P(DIFGMO(DIFGMULT),U)="L" S ^("MODE")="M"_"^"_$P(^UTILITY("DIFG",$J,DIFGINCR,DIFGDIC,"MODE"),U,2)
        !             6:        I Y>0 G X1
        !             7:        S DIFGCHEK=0 I DIFGTYP="MV FIELD"!(DIFGTYP="FILE") S DIFGCHEK=1
        !             8:        I DIFGCHEK,$P(DIFGMO(DIFGMULT),U)="L",DIFGTYP'="MV FIELD" S X=$S($D(DIFG("ACGRV")):X_"^N",1:X),DIFGSKIP(DIFGMULT)="" D ^DIFG4 G X1 ;Set X to X^N if internal pointer value was used in lookup, lets ^DIFG7 know if X internal value or not
        !             9:        I DIFGCHEK,$P(DIFGMO(DIFGMULT),U)="L",DIFGTYP="MV FIELD" S DIFGSKIP(DIFGMULT)="" G X1
        !            10:        I 'DIFGCHEK D ^DIFG4 G X1
        !            11:        I DIFGCHEK,$P(DIFGMO(DIFGMULT),U)="D" G X1 ;If no entry found to delete, continue
        !            12:        I DIFGCHEK,$P(DIFGMO(DIFGMULT),U)="M" S DIFGER=12_U_DIFGY D ERROR^DIFG G X1 ;Lookup for entry failed (no earlier "add" since DIFGFLUS undefined - if DIFGFLUS defined, wouldn't have done ^DIC)
        !            13: X1     K DIFGCHEK Q
        !            14:        ;
        !            15: KEY    ;DETERMINE @LINK VALUE FROM KEY
        !            16:        S DIFG("KEY","XREF")=""""_$P($P(DIFGDIX,U,3),"=")_"""",DIFG("KEY","VAL")=""""_$P(DIFGDIX,"=",2)_"""",DIFG("KEY","GLO")=^DIC(DIC,0,"GL")
        !            17:        S Y=$O(@(DIFG("KEY","GLO")_DIFG("KEY","XREF")_","_DIFG("KEY","VAL")_","""")"))
        !            18:        I Y="" S Y=-1 S DIFGER=13_U_DIFGY D ERROR^DIFG
        !            19:        I 'DIFGER S (^UTILITY("DIFG@",$J,DIFGSAVE(DIFG,"@NUM")),DIFGALNK)=Y,^UTILITY("DIFGX",$J,DIFGSAVE(DIFG,"@NUM"))=X
        !            20:        Q
        !            21:        ;
        !            22: LINK   ;FINDS @NUMBER TO LINK DFN TO FROM LOOKUP
        !            23:        I $F(DIFGDIX,"@") S DIFGSAVE(DIFG,"@NUM")="@"_+$E(DIFGDIX,$F(DIFGDIX,"@"),99) I $D(^UTILITY("DIFG@",$J,DIFGSAVE(DIFG,"@NUM"))) S DIFGFLUS=""
        !            24:        ;Line before this checks if DIFG("@NUM") exists.  If it exists because it was a modify then don't need to do the lookup.
        !            25:        ;If exists and is equal to itself (+^UTILITY("DIFG@",$J,"@NUM"))=0, then previous reference to this @link was an add and stll don't do lookup
        !            26:        Q
        !            27:        ;
        !            28: ARRAY  ;SETS EXECUTABLE ARRAY FOR DIC("S")
        !            29:        F DIFGI=1:1 I '$D(DIFGDIC(DIC,DIFGI)) S DIFGI=DIFGI-1 Q
        !            30:        S DIFGDIC(DIC,DIFGI)=DIFGDIC(DIC,DIFGI)_+Y,DIFGSVVL(DIFGCT)=+Y
        !            31:        Q
        !            32:        ;
        !            33: IDENSPEC       ;called from ^DIFG3
        !            34:        S %=DIFGLAGO NEW DIFGLAGO S DIFGLAGO=$S(%=0:0,$D(DIFGENV("LAYGO",DIC,DIFGNUMF(DIFGCT))):1,DIFGHAT'["'":1,1:0) K %
        !            35:        S DIFGSAVE(DIFG,"HX")=X,X=$P(DIFGDIX,"=",2) X DIFGLINE
        !            36:        S DIFGSVVL(DIFGCT)="^UTILITY(""DIFG@"","_$J_",""@"_$P(DIFGDIX,"@",2)_""")" D RCR^DIFG3 G:DIFGER X
        !            37:        S:$S($D(Y):Y<0,1:1) DIFGNOLK="" S X=DIFGSAVE(DIFG,"HX")
        !            38:        D:$D(DIFGDIC(DIC))&'$D(DIFGNOLK) ARRAY
        !            39: X      Q
        !            40:        ;
        !            41: DOLO   ;called from ^DIFG3
        !            42:        NEW %,%A
        !            43:        S %A=$S($D(DIFGMGBL(DIFGMULT)):DIFGMGBL(DIFGMULT),1:^DIC(DIC,0,"GL"))
        !            44:        F %=0:0 S %=$O(@(%A_"%)")) Q:'%  I +^(%,0)=X X DIC("S") I $T S DIFG("FOUND")="",Y=% Q
        !            45:        I '$D(DIFG("FOUND")) S Y=-1
        !            46:        Q
        !            47:        ;
        !            48: EOJ    ;
        !            49:        S DIFGEL=DIFGY
        !            50:        S:$G(DIFGBSE)["^UTILITY" DIFGBSE="~"_$P(DIFGBSE,U,2,99) I 'DIFGER!(DIFGER&($S($D(DIFGBSE):$S(+DIFGBSE:1,1:@($TR($P(DIFGBSE,U),"~","^"))),1:0))) S @("DIFGY="_$TR($P(DIFGBSE,U),"~","^")_"_U_$P(DIFGBSE,U,2,3)")
        !            51:        E  S DIFGY=-1
        !            52:        I 'DIFGER K DIFGER
        !            53:        I $D(DIFGREI),($D(DIFGEROR)!'$D(DIFGER)) S DA=DIFGREI,DIK="^DIAR(1.13," D ^DIK K DIK,DA
        !            54:        K DIFGI,DIFGL,DIFGDIX,DIFGLO,DIFGEND,DIFGMULT,DIFGO,DIFGCT,DIFGEXC,DIFGLINE,DIFGALNK,DIFGSAVX,DIFG,DIFGBSE,DIFGDOL,DIFGNUMF,DIFGPC,DIFGPTER,DIFGVAL,DIFGKEY,DIFGMLND,DIFGDINM,DIFGREI,DIFGCHKG,DIFGEROR,DIFGLC,DIFGENV
        !            55:        K ^UTILITY("DIFGX",$J),^UTILITY("DIFG@",$J),^UTILITY("DIFG",$J)
        !            56:        Q