- 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 Mar 13, 2025@21:43:23 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
