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 ---[H[J[2J[HPRSDXREF 536 printed Oct 16, 2024@18:27 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
