| [613] | 1 | ORY130 ; slc/CLA - Special routine to report mirrored and cyclical Kernel Alert surrogates ;12/15/01 16:34
|
|---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**130**;Dec 17, 1997
|
|---|
| 3 | EN ; check for problematic surrogates
|
|---|
| 4 | N ORUSER,ORSURO,ORCYC
|
|---|
| 5 | S ORUSER=0
|
|---|
| 6 | W !!,"Searching for mirrored and circular Kernel Alert surrogates..."
|
|---|
| 7 | F S ORUSER=$O(^VA(200,ORUSER)) Q:+$G(ORUSER)<.1 D
|
|---|
| 8 | .S ORSURO=$$CURRSURO^XQALSURO(ORUSER)
|
|---|
| 9 | .I +$G(ORSURO)>0 D
|
|---|
| 10 | ..S ORCYC=$$CYCLIC(ORSURO,ORUSER)
|
|---|
| 11 | ..I $L($P(ORCYC,U))>0 W !!,$P(ORCYC,U),":",!?3,$P(ORCYC,U,2)
|
|---|
| 12 | W !!,"Surrogate search completed."
|
|---|
| 13 | Q
|
|---|
| 14 | CYCLIC(ORSURO,ORUSER) ; check for circular and mirrored surrogates
|
|---|
| 15 | N ORX,ORMSG,ORF,ORA,ORTMSG
|
|---|
| 16 | S ORMSG="",ORF=0
|
|---|
| 17 | S ORTMSG=$P(^VA(200,ORUSER,0),U)_" => "_$P(^VA(200,ORSURO,0),U)
|
|---|
| 18 | I ORSURO=ORUSER D
|
|---|
| 19 | .S ORF=1
|
|---|
| 20 | .S ORMSG=$P(^VA(200,ORUSER,0),U)_" cannot specify "_$P(^VA(200,ORSURO,0),U)_" as surrogate - remove surrogate!"
|
|---|
| 21 | Q:ORF=1 ORMSG
|
|---|
| 22 | S ORX=$$CURRSURO^XQALSURO(ORSURO) I +$G(ORX)>0 D
|
|---|
| 23 | .S ORTMSG=ORTMSG_" => "_$P(^VA(200,ORX,0),U)
|
|---|
| 24 | .I ORX=ORUSER D
|
|---|
| 25 | ..S ORF=1
|
|---|
| 26 | ..S ORMSG="Mirrored surrogates! Remove one or both surrogates"_U_ORTMSG
|
|---|
| 27 | .F S ORX=$$CURRSURO^XQALSURO(ORX) Q:ORX'>0!(ORF=1) D
|
|---|
| 28 | ..S ORTMSG=ORTMSG_" => "_$P(^VA(200,ORX,0),U)
|
|---|
| 29 | ..I $D(ORA(ORX)) S ORF=1 Q
|
|---|
| 30 | ..S ORA(ORX)=""
|
|---|
| 31 | ..I $D(ORA(ORUSER)) D
|
|---|
| 32 | ...S ORMSG="Circular surrogate loop. Remove one or more surrogates"
|
|---|
| 33 | ...S ORF=1
|
|---|
| 34 | Q ORMSG_U_ORTMSG
|
|---|
