AZAXPIFX.m

AZAXPIFX;IHS/PHXAO/AEF - FIX BAD NODES IN ^AUPNPRVT GLOBAL

 ;;1.0;ANNE'S SPECIAL ROUTINES;;MAY 21, 2004     

 ;

DESC ;----- ROUTINE DESCRIPTION

 ;;

 ;;This routine can be used to SCAN and DELETE bad entries in the Private

 ;;Insurance Eligible file.  You should first run the routine in SCAN mode

 ;;to determine which entries have bad data.  It is HIGHLY RECOMMENDED that

 ;;you make a backup copy of your ^AUPNPRVT global before you delete the

 ;;bad entries.

 ;;

 ;;$$END

 ;

EN ;EP --- MAIN ENTRY POINT

 ;

 N DEL,OUT

 ;

 D TXT

 ;

 S (DEL,OUT)=0

 ;

 D ASK(.DEL,.OUT)

 Q:OUT

 ;

 I DEL D BKU(.OUT)

 Q:OUT

 ;

 D LOOP(DEL)

 ;

 Q

LOOP(DEL) ;

 ;----- LOOP THROUGH PRIVATE INSURANCE ELIGIBLE ^AUPNPRVT GLOBAL

 ;

 N CNT,D0,D1

 ;

 W !!,"Checking Private Insurance Eligible File... PLEASE WAIT",!!

 ;

 S CNT=0

 ;

 S D0=0

 F  S D0=$O(^AUPNPRVT(D0)) Q:'D0  D

 . S D1=0

 . F  S D1=$O(^AUPNPRVT(D0,11,D1)) Q:'D1  D

 . . D ONE(D0,D1,DEL,.CNT)

 ;

 I CNT W !!,CNT," ENTRIES ",$S(DEL:"FIXED",1:"FOUND")

 I 'CNT W !!,"NO BAD ENTRIES FOUND"

 W !!,"DONE!",!!

 Q

ONE(D0,D1,DEL,CNT) ;

 ;----- PROCESS ONE ENTRY

 ;

 Q:+$G(^AUPNPRVT(D0,11,D1,0))

 ;

 S CNT=$G(CNT)+1

 ;

 W !," bad entry at ien: ",D0,"  ^AUPNPRVT(",D0,",11,",D1,",0)=",^AUPNPRVT(D0,11,D1,0)

 ;

 Q:'DEL

 K ^AUPNPRVT(D0,11,D1,0)

 ; 

 W !,"fixed"

 Q

ASK(DEL,OUT) ;

 ;----- ASK IF SCAN OR DELETE MODE

 ;

 N DIR,DIRUT,DTOUT,DUOUT,X,Y

 S OUT=0

 S DIR(0)="S^0:SCAN;1:DELETE"

 S DIR("A")="Run in SCAN or DELETE mode?"

 S DIR("B")="SCAN"

 D ^DIR

 I $D(DTOUT)!($D(DUOUT))!($D(DIRUT)) S OUT=1

 S DEL=+Y

 Q

BKU(OUT) ;

 ;----- ASK IF BACKUP COPY OF ^AUPNPRVT GLOBAL HAS BEEN DONE

 ;

 N DIR,DIRUT,DTOUT,DUOUT,X,Y

 S DIR(0)="Y"

 S DIR("A")="Did you make a backup copy of the ^AUPNPRVT global?"

 S DIR("B")="NO"

 D ^DIR

 I $D(DTOUT)!($D(DUOUT))!($D(DIRUT)) S OUT=1

 I +Y'>0 S OUT=1

 Q

TXT ;----- PRINT OPTION TEXT

 ;

 N I,X

 F I=1:1 S X=$P($T(DESC+I),";",3) Q:X["$$END"  W !,X

 Q

AZAXPIFX;IHS/PHXAO/AEF 

*** ERROR ***

 +1       ;;1.0;ANNE'S SPECIAL ROUTINES;;MAY 21, 2004     

 +2       ;

DESC      ;----- ROUTINE DESCRIPTION

 +1       ;;

 +2       ;;This routine can be used to SCAN and DELETE bad entries in the Private

 +3       ;;Insurance Eligible file.  You should first run the routine in SCAN mode

 +4       ;;to determine which entries have bad data.  It is HIGHLY RECOMMENDED that

 +5       ;;you make a backup copy of your ^AUPNPRVT global before you delete the

 +6       ;;bad entries.

 +7       ;;

 +8       ;;$$END

 +9       ;

EN        ;EP --- MAIN ENTRY POINT

 +1       ;

 +2        NEW DEL,OUT

 +3       ;

 +4        DO TXT

 +5       ;

 +6        SET (DEL,OUT)=0

 +7       ;

 +8        DO ASK(.DEL,.OUT)

 +9        IF OUT

               QUIT 

 +10      ;

 +11       IF DEL

               DO BKU(.OUT)

 +12       IF OUT

               QUIT 

 +13      ;

 +14       DO LOOP(DEL)

 +15      ;

 +16       QUIT 

LOOP(DEL) ;

 +1       ;----- LOOP THROUGH PRIVATE INSURANCE ELIGIBLE ^AUPNPRVT GLOBAL

 +2       ;

 +3        NEW CNT,D0,D1

 +4       ;

 +5        WRITE !!,"Checking Private Insurance Eligible File... PLEASE WAIT",!!

 +6       ;

 +7        SET CNT=0

 +8       ;

 +9        SET D0=0

 +10       FOR 

               SET D0=$ORDER(^AUPNPRVT(D0))

               IF 'D0

                   QUIT 

               Begin DoDot:1

 +11               SET D1=0

 +12               FOR 

                       SET D1=$ORDER(^AUPNPRVT(D0,11,D1))

                       IF 'D1

                           QUIT 

                       Begin DoDot:2

 +13                       DO ONE(D0,D1,DEL,.CNT)

                       End DoDot:2

               End DoDot:1

 +14      ;

 +15       IF CNT

               WRITE !!,CNT," ENTRIES ",$SELECT(DEL:"FIXED",1:"FOUND")

 +16       IF 'CNT

               WRITE !!,"NO BAD ENTRIES FOUND"

 +17       WRITE !!,"DONE!",!!

 +18       QUIT 

ONE(D0,D1,DEL,CNT) ;

 +1       ;----- PROCESS ONE ENTRY

 +2       ;

 +3        IF +$GET(^AUPNPRVT(D0,11,D1,0))

               QUIT 

 +4       ;

 +5        SET CNT=$GET(CNT)+1

 +6       ;

 +7        WRITE !," bad entry at ien: ",D0,"  ^AUPNPRVT(",D0,",11,",D1,",0)=",^AUPNPRVT(D0,11,D1,0)

 +8       ;

 +9        IF 'DEL

               QUIT 

 +10       KILL ^AUPNPRVT(D0,11,D1,0)

 +11      ; 

 +12       WRITE !,"fixed"

 +13       QUIT 

ASK(DEL,OUT) ;

 +1       ;----- ASK IF SCAN OR DELETE MODE

 +2       ;

 +3        NEW DIR,DIRUT,DTOUT,DUOUT,X,Y

 +4        SET OUT=0

 +5        SET DIR(0)="S^0:SCAN;1:DELETE"

 +6        SET DIR("A")="Run in SCAN or DELETE mode?"

 +7        SET DIR("B")="SCAN"

 +8        DO ^DIR

 +9        IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))

               SET OUT=1

 +10       SET DEL=+Y

 +11       QUIT 

BKU(OUT)  ;

 +1       ;----- ASK IF BACKUP COPY OF ^AUPNPRVT GLOBAL HAS BEEN DONE

 +2       ;

 +3        NEW DIR,DIRUT,DTOUT,DUOUT,X,Y

 +4        SET DIR(0)="Y"

 +5        SET DIR("A")="Did you make a backup copy of the ^AUPNPRVT global?"

 +6        SET DIR("B")="NO"

 +7        DO ^DIR

 +8        IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))

               SET OUT=1

 +9        IF +Y'>0

               SET OUT=1

 +10       QUIT 

TXT       ;----- PRINT OPTION TEXT

 +1       ;

 +2        NEW I,X

 +3        FOR I=1:1

               SET X=$PIECE($TEXT(DESC+I),";",3)

               IF X["$$END"

                   QUIT 

               WRITE !,X

 +4        QUIT