- 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 Feb 18, 2025@23:52:46 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