Routine: AGTXPER

AGTXPER ; IHS/ASDS/EFG - SCAN AND TRAN PAST TX ERRORS ;

 ;;7.1;PATIENT REGISTRATION;**2**;JAN 31, 2007

S ;

 ;agtxper is tested in SA1+1^AGTX0 to quit and return here if set.

 ;versus returning to scan agpatch

 ;scan all past errors

 S AGDZSITE=DUZ(2),AGR1SAVE=AGR1,AGTXPER=1,AGR1=0

 F  S AGR1=$O(^AGPATCH("ER",AGR1)),AGDTS=AGR1,AGRR1=AGR1 Q:((AGR1="")!(AGR1>9999999))  D

 .S AG("SITE")=0 F  S AG("SITE")=$O(^AGPATCH("ER",AGR1,AG("SITE"))) Q:'AG("SITE")  D

 ..S AGR2=0 F  S AGR2=$O(^AGPATCH("ER",AGR1,AG("SITE"),AGR2)),DFN=AGR2 Q:'AGR2  D

 ...;I $P(^DPT(DFN,0),"^",19)>0 K ^AGPATCH("ER",AGR1,AG("SITE"),AGR2) Q  ;merged patient

 ...I ('$D(^DPT(DFN,0)))!$P($G(^DPT(DFN,0)),U,19)>0 K ^AGPATCH("ER",AGR1,AG("SITE"),AGR2) Q  ;merged patient ;IM20163

 ...I '$D(^AGPATCH(AGR1,AG("SITE"),AGR2)) K ^AGPATCH("ER",AGR1,AG("SITE"),AGR2) Q  ;patch node gone

 ...S DUZ(2)=AG("SITE") D TXPER^AGTX0

 S DUZ(2)=AGDZSITE,AGR1=AGR1SAVE K AGTXPER,AGR1SAVE,AGDZSITE

AGTXPER   ; IHS/ASDS/EFG - SCAN AND TRAN PAST TX ERRORS ;

 +1       ;;7.1;PATIENT REGISTRATION;**2**;JAN 31, 2007

S         ;

 +1       ;agtxper is tested in SA1+1^AGTX0 to quit and return here if set.

 +2       ;versus returning to scan agpatch

 +3       ;scan all past errors

 +4        SET AGDZSITE=DUZ(2)

           SET AGR1SAVE=AGR1

           SET AGTXPER=1

           SET AGR1=0

 +5        FOR

               SET AGR1=$ORDER(^AGPATCH("ER",AGR1))

               SET AGDTS=AGR1

               SET AGRR1=AGR1

               IF ((AGR1="")!(AGR1>9999999))

                   QUIT

               Begin DoDot:1

 +6                SET AG("SITE")=0

FOR

                       SET AG("SITE")=$ORDER(^AGPATCH("ER",AGR1,AG("SITE")))

                       IF 'AG("SITE")

                           QUIT

                       Begin DoDot:2

 +7                        SET AGR2=0

FOR

                               SET AGR2=$ORDER(^AGPATCH("ER",AGR1,AG("SITE"),AGR2))

                               SET DFN=AGR2

                               IF 'AGR2

                                   QUIT

                               Begin DoDot:3

 +8       ;I $P(^DPT(DFN,0),"^",19)>0 K ^AGPATCH("ER",AGR1,AG("SITE"),AGR2) Q  ;merged patient

 +9       ;merged patient ;IM20163

                                   IF ('$DATA(^DPT(DFN,0)))!$PIECE($GET(^DPT(DFN,0)),U,19)>0

                                       KILL ^AGPATCH("ER",AGR1,AG("SITE"),AGR2)

                                       QUIT

 +10      ;patch node gone

                                   IF '$DATA(^AGPATCH(AGR1,AG("SITE"),AGR2))

                                       KILL ^AGPATCH("ER",AGR1,AG("SITE"),AGR2)

                                       QUIT

 +11                               SET DUZ(2)=AG("SITE")

                                   DO TXPER^AGTX0

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +12       SET DUZ(2)=AGDZSITE

           SET AGR1=AGR1SAVE

           KILL AGTXPER,AGR1SAVE,AGDZSITE

 +13       QUIT

AGTXPER.m