APCPFIXD.m

APCPFIXD ; IHS/TUCSON/LAB - OHPRD-TUCSON/EDE FIX "APCIS" XREF AUGUST 14, 1992 ; [ 09/16/02 12:08 PM ]

 ;;2.0;IHS PCC DATA EXTRACTION SYSTEM;**6**;APR 03, 1998

 ;

 ; This should not be necessary, but alas, things never seem to

 ; be the way they should be.  If this routine finds any xrefs

 ; to delete, it is symptomatic of a problem elsewhere.

 ;

START ;

 Q

 W:'$D(ZTQUEUED) !!,"Checking ""APCIS"" xref <WAIT>"

 S U="^"

 S D="" F  S D=$O(^AUPNVSIT("APCIS",D)) Q:D'=+D  D CHECK

 K D,X,E

 Q

 ;

CHECK ;

 S X="" F  S X=$O(^AUPNVSIT("APCIS",D,X)) Q:X'=+X  I $P(^AUPNVSIT(X,0),U,11) D KILL

 Q

 ;

KILL ;

 S E=1

 W:'$D(ZTQUEUED) !,X,"  ",$D(^AUPNVSIT("APCIS",$P(^AUPNVSIT(X,0),U,2),X)) K ^(X)

 K ^AUPNVSIT("APCIS",D,X)

 Q

APCPFIXD  ; IHS/TUCSON/LAB - OHPRD-TUCSON/EDE FIX "APCIS" XREF AUGUST 14, 1992 ; [ 09/16/02 12:08 PM ]

 +1       ;;2.0;IHS PCC DATA EXTRACTION SYSTEM;**6**;APR 03, 1998

 +2       ;

 +3       ; This should not be necessary, but alas, things never seem to

 +4       ; be the way they should be.  If this routine finds any xrefs

 +5       ; to delete, it is symptomatic of a problem elsewhere.

 +6       ;

START     ;

 +1        QUIT 

 +2        IF '$DATA(ZTQUEUED)

               WRITE !!,"Checking ""APCIS"" xref <WAIT>"

 +3        SET U="^"

 +4        SET D=""

           FOR 

               SET D=$ORDER(^AUPNVSIT("APCIS",D))

               IF D'=+D

                   QUIT 

               DO CHECK

 +5        KILL D,X,E

 +6        QUIT 

 +7       ;

CHECK     ;

 +1        SET X=""

           FOR 

               SET X=$ORDER(^AUPNVSIT("APCIS",D,X))

               IF X'=+X

                   QUIT 

               IF $PIECE(^AUPNVSIT(X,0),U,11)

                   DO KILL

 +2        QUIT 

 +3       ;

KILL      ;

 +1        SET E=1

 +2        IF '$DATA(ZTQUEUED)

               WRITE !,X,"  ",$DATA(^AUPNVSIT("APCIS",$PIECE(^AUPNVSIT(X,0),U,2),X))

           KILL ^(X)

 +3        KILL ^AUPNVSIT("APCIS",D,X)

 +4        QUIT