| 1 | DIFG1 ;SFISC/DG(OHPRD)-SINGLE VALUED FIELDS ; [ 02/03/93 3:17 PM ]
|
|---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
|---|
| 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 | ;
|
|---|
