ORY130 ; slc/CLA - Special routine to report mirrored and cyclical Kernel Alert surrogates ;12/15/01 16:34
;;3.0;ORDER ENTRY/RESULTS REPORTING;**130**;Dec 17, 1997
EN ; check for problematic surrogates
N ORUSER,ORSURO,ORCYC
S ORUSER=0
W !!,"Searching for mirrored and circular Kernel Alert surrogates..."
F S ORUSER=$O(^VA(200,ORUSER)) Q:+$G(ORUSER)<.1 D
.S ORSURO=$$CURRSURO^XQALSURO(ORUSER)
.I +$G(ORSURO)>0 D
..S ORCYC=$$CYCLIC(ORSURO,ORUSER)
..I $L($P(ORCYC,U))>0 W !!,$P(ORCYC,U),":",!?3,$P(ORCYC,U,2)
W !!,"Surrogate search completed."
Q
CYCLIC(ORSURO,ORUSER) ; check for circular and mirrored surrogates
N ORX,ORMSG,ORF,ORA,ORTMSG
S ORMSG="",ORF=0
S ORTMSG=$P(^VA(200,ORUSER,0),U)_" => "_$P(^VA(200,ORSURO,0),U)
I ORSURO=ORUSER D
.S ORF=1
.S ORMSG=$P(^VA(200,ORUSER,0),U)_" cannot specify "_$P(^VA(200,ORSURO,0),U)_" as surrogate - remove surrogate!"
Q:ORF=1 ORMSG
S ORX=$$CURRSURO^XQALSURO(ORSURO) I +$G(ORX)>0 D
.S ORTMSG=ORTMSG_" => "_$P(^VA(200,ORX,0),U)
.I ORX=ORUSER D
..S ORF=1
..S ORMSG="Mirrored surrogates! Remove one or both surrogates"_U_ORTMSG
.F S ORX=$$CURRSURO^XQALSURO(ORX) Q:ORX'>0!(ORF=1) D
..S ORTMSG=ORTMSG_" => "_$P(^VA(200,ORX,0),U)
..I $D(ORA(ORX)) S ORF=1 Q
..S ORA(ORX)=""
..I $D(ORA(ORUSER)) D
...S ORMSG="Circular surrogate loop. Remove one or more surrogates"
...S ORF=1
Q ORMSG_U_ORTMSG
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORY130 1396 printed Nov 22, 2024@17:48:20 Page 2
ORY130 ; slc/CLA - Special routine to report mirrored and cyclical Kernel Alert surrogates ;12/15/01 16:34
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**130**;Dec 17, 1997
EN ; check for problematic surrogates
+1 NEW ORUSER,ORSURO,ORCYC
+2 SET ORUSER=0
+3 WRITE !!,"Searching for mirrored and circular Kernel Alert surrogates..."
+4 FOR
SET ORUSER=$ORDER(^VA(200,ORUSER))
if +$GET(ORUSER)<.1
QUIT
Begin DoDot:1
+5 SET ORSURO=$$CURRSURO^XQALSURO(ORUSER)
+6 IF +$GET(ORSURO)>0
Begin DoDot:2
+7 SET ORCYC=$$CYCLIC(ORSURO,ORUSER)
+8 IF $LENGTH($PIECE(ORCYC,U))>0
WRITE !!,$PIECE(ORCYC,U),":",!?3,$PIECE(ORCYC,U,2)
End DoDot:2
End DoDot:1
+9 WRITE !!,"Surrogate search completed."
+10 QUIT
CYCLIC(ORSURO,ORUSER) ; check for circular and mirrored surrogates
+1 NEW ORX,ORMSG,ORF,ORA,ORTMSG
+2 SET ORMSG=""
SET ORF=0
+3 SET ORTMSG=$PIECE(^VA(200,ORUSER,0),U)_" => "_$PIECE(^VA(200,ORSURO,0),U)
+4 IF ORSURO=ORUSER
Begin DoDot:1
+5 SET ORF=1
+6 SET ORMSG=$PIECE(^VA(200,ORUSER,0),U)_" cannot specify "_$PIECE(^VA(200,ORSURO,0),U)_" as surrogate - remove surrogate!"
End DoDot:1
+7 if ORF=1
QUIT ORMSG
+8 SET ORX=$$CURRSURO^XQALSURO(ORSURO)
IF +$GET(ORX)>0
Begin DoDot:1
+9 SET ORTMSG=ORTMSG_" => "_$PIECE(^VA(200,ORX,0),U)
+10 IF ORX=ORUSER
Begin DoDot:2
+11 SET ORF=1
+12 SET ORMSG="Mirrored surrogates! Remove one or both surrogates"_U_ORTMSG
End DoDot:2
+13 FOR
SET ORX=$$CURRSURO^XQALSURO(ORX)
if ORX'>0!(ORF=1)
QUIT
Begin DoDot:2
+14 SET ORTMSG=ORTMSG_" => "_$PIECE(^VA(200,ORX,0),U)
+15 IF $DATA(ORA(ORX))
SET ORF=1
QUIT
+16 SET ORA(ORX)=""
+17 IF $DATA(ORA(ORUSER))
Begin DoDot:3
+18 SET ORMSG="Circular surrogate loop. Remove one or more surrogates"
+19 SET ORF=1
End DoDot:3
End DoDot:2
End DoDot:1
+20 QUIT ORMSG_U_ORTMSG
