Return to DIFG1.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIFG1.m, revision 1.1

1.1     ! snw         1: DIFG1  ;SFISC/DG(OHPRD)-SINGLE VALUED FIELDS ; [ 02/03/93  3:17 PM ]
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4: START  ;ASSIGNMENT STATEMENT FOR SINGLE VALUED FIELD
        !             5:        I DIFGTYPE="WP FIELD" D WPFIELD G X1
        !             6:        S DIFGSECP=$P(DIFGDIX,"=",2)
        !             7:        I DIFGSECP="^" S DIFGVAL="@" D SETDR G X1
        !             8:        I DIFGSECP?1"@"1N.N,'^UTILITY("DIFG@",$J,DIFGSECP),$D(DIFG("UNRESOLVED",DIFGSECP)) S DIFGER=21_U_DIFGY D ERROR^DIFG G X2
        !             9:        I $P(^DD(DIC,DIFGNUM,0),U,2)["P",DIFGSECP'?1"@"1N.N D LOOKUP I 1
        !            10:        E  I DIFGSECP'?1"@"1N.N,DIFGSECP[";" D PARSE S DIFGVAL="^S X="_DIFGSECP I 1
        !            11:        E  S DIFGVAL=$S(DIFGSECP'?1"@"1N.N:DIFGSECP,^UTILITY("DIFG@",$J,DIFGSECP)[DIFGSECP:"^S X="_"""`""_^UTILITY(""DIFG@"","_$J_","""_DIFGSECP_""")",DIFGNUM'=.01:"/"_^UTILITY("DIFG@",$J,DIFGSECP),1:"`"_^UTILITY("DIFG@",$J,DIFGSECP))
        !            12:        I DIFGER G X1
        !            13:        D SETDR
        !            14:        K DIFGSECP,DIFGPC,DIFGFLD,DIFGVAL,DIFGDOL,DIFGNOLK,DIFGPARS,DIFGDOLF
        !            15: X1     Q
        !            16:        ;
        !            17: PARSE  ; PARSE AND CHANGE DIFGSECP IF CONTAINS ";"
        !            18:        NEW I S DIFGPARS="" F I=0:0 S DIFGDOLF=$F(DIFGSECP,";") Q:'DIFGDOLF  S DIFGPARS=DIFGPARS_$S(DIFGDOLF>2:""""_$E(DIFGSECP,1,DIFGDOLF-2)_"""_",1:"")_"$C(59)_" S DIFGSECP=$E(DIFGSECP,DIFGDOLF,245)
        !            19:        S DIFGSECP=$S(DIFGSECP="":$E(DIFGPARS,1,$L(DIFGPARS)-1),1:DIFGPARS_""""_DIFGSECP_"""")
        !            20:        Q
        !            21:        ;
        !            22: SETDR  ;
        !            23:        S:'$D(^UTILITY("DIFG",$J,DIFGINCR,DIC,"DR")) ^("DR")=""
        !            24:        I $L(^UTILITY("DIFG",$J,DIFGINCR,DIC,"DR"))+$L(DIFGNUM_"///"_DIFGVAL_";")<241 S ^("DR")=^("DR")_DIFGNUM_"///"_DIFGVAL_";" G X2
        !            25:        I $D(^UTILITY("DIFG",$J,DIFGINCR,DIC,"DR",DIFGNDC)),$L(^(DIFGNDC))+$L(DIFGNUM_"///"_DIFGVAL_";")<241 S ^(DIFGNDC)=^(DIFGNDC)_DIFGNUM_"///"_DIFGVAL_";"
        !            26:        E  S DIFGNDC=DIFGNDC+1,^(DIFGNDC)=DIFGNUM_"///"_DIFGVAL_";"
        !            27: X2     Q
        !            28:        ;
        !            29: LOOKUP ;FIELD LOOKUP
        !            30:        S DIFG=DIFG+1
        !            31:        S X=$P(DIFGDIX,"=",2)
        !            32:        S DIFGLAGO=0
        !            33:        I $P(^DD(DIC,DIFGNUM,0),U,2)'["'"!($D(DIFGENV("LAYGO",DIC,DIFGNUM))) S DIFGLAGO=1
        !            34:        D ^DIFG3
        !            35:        I DIFGER G X3
        !            36:        I Y>0 S DIFGVAL="/"_+Y G X3
        !            37:        S DIFGVAL="^S X="_"""`""_"_DIFGALNK
        !            38: X3     S DIFG=DIFG-1
        !            39:        K Y,DIFGLAGO
        !            40:        Q
        !            41:        ;
        !            42: WPFIELD        ;PROCESS WP FIELD
        !            43:        S DIFG("COUNT")=0
        !            44:        S ^UTILITY("DIFG",$J,DIFGINCR,DIC,"WP",DIFG("COUNT"))=DIFGFLDN
        !            45:        F DIFGL=0:0 X DIFGLINE Q:DIFGDIX="."  S DIFG("COUNT")=DIFG("COUNT")+1 D BUILD
        !            46:        K DIFG("COUNT")
        !            47:        Q
        !            48:        ;
        !            49: BUILD  ;
        !            50:        S ^UTILITY("DIFG",$J,DIFGINCR,DIC,"WP",DIFG("COUNT"))=$E(DIFGDIX,2,$L(DIFGDIX)-1)
        !            51:        Q
        !            52:        ;