PRSDXREF.m

PRSDXREF ;HISC/GWB-SET AND KILL CROSS REFERENCES ;6/13/92  09:15

 ;;4.0;PAID;;Sep 21, 1995

KILL ;Kill existing cross reference

 D CHECK G:EXIT EXIT S XSAV=X

 F XREF=0:0 S XREF=$O(^DD(450,FLDNUM,1,XREF)) Q:XREF'>0  S X=XSAV X:$D(^DD(450,FLDNUM,1,XREF,2))#2 ^(2)

 G EXIT

SET ;Set new cross reference

 D CHECK G:EXIT EXIT S XSAV=X

 F XREF=0:0 S XREF=$O(^DD(450,FLDNUM,1,XREF)) Q:XREF'>0  S X=XSAV X:$D(^DD(450,FLDNUM,1,XREF,1))#2 ^(1)

EXIT K EXIT,XREF,XSAV

 Q

CHECK S EXIT=$S('$D(X):1,'$D(FLDNUM):1,X="":1,FLDNUM'>0:1,1:0)

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRSDXREF   536     printed  Apr 09, 2024@21:25:52                                                                                                                                                                                                     Page 2

PRSDXREF  ;HISC/GWB-SET AND KILL CROSS REFERENCES ;6/13/92  09:15

 +1       ;;4.0;PAID;;Sep 21, 1995

KILL      ;Kill existing cross reference

 +1        DO CHECK

           if EXIT

               GOTO EXIT

           SET XSAV=X

 +2        FOR XREF=0:0

               SET XREF=$ORDER(^DD(450,FLDNUM,1,XREF))

               if XREF'>0

                   QUIT 

               SET X=XSAV

               if $DATA(^DD(450,FLDNUM,1,XREF,2))#2

                   XECUTE ^(2)

 +3        GOTO EXIT

SET       ;Set new cross reference

 +1        DO CHECK

           if EXIT

               GOTO EXIT

           SET XSAV=X

 +2        FOR XREF=0:0

               SET XREF=$ORDER(^DD(450,FLDNUM,1,XREF))

               if XREF'>0

                   QUIT 

               SET X=XSAV

               if $DATA(^DD(450,FLDNUM,1,XREF,1))#2

                   XECUTE ^(1)

EXIT       KILL EXIT,XREF,XSAV

 +1        QUIT 

CHECK      SET EXIT=$SELECT('$DATA(X):1,'$DATA(FLDNUM):1,X="":1,FLDNUM'>0:1,1:0)

 +1        QUIT