ORY130.m

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

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