CIAZALTQ.m

CIAZALTQ ;CIA/PLS - Query Alert Global for Corrupt Entries;16-Aug-2004 08:43;PLS

 ;;1.0

EN ;

 D CLEANUP

 D:$$CHECK() PROMPT

 D CLEANUP

 Q

CHECK() ;Entry to loop thru the ^XTV(8992 global looking for entries

 ;without a zero node.

 U IO

 W !,"Checking Alert Global..."

 N CIAUSR,CIAADT

 S CIAUSR=0

 F  S CIAUSR=$O(^XTV(8992,CIAUSR)) Q:CIAUSR<.1  D

 . S CIAADT=0 F  S CIAADT=$O(^XTV(8992,CIAUSR,"XQA",CIAADT)) Q:CIAADT<1  D

 . . I '$D(^XTV(8992,CIAUSR,"XQA",CIAADT,0)) D

 . . . S ^TMP($J,"CIAZALTQ",CIAUSR,CIAADT)=""  ;store info for potential deletion

 . . . W !,"Alert: "_CIAADT_" for user: "_CIAUSR_" is missing the zero node."

 W !,"Checking complete.",!!

 Q $D(^TMP($J,"CIAZALTQ"))

 ;

PROMPT ;Prompt user to delete bad nodes

 I $$ASK^CIAU("Would you like to delete the nodes identified above") D

 . N CIAUSR,CIAADT

 . S CIAUSR=0

 . F  S CIAUSR=$O(^TMP($J,"CIAZALTQ",CIAUSR)) Q:CIAUSR<.1  D

 . . S CIAADT=0 F  S CIAADT=$O(^TMP($J,"CIAZALTQ",CIAUSR,CIAADT)) Q:CIAADT<1  D

 . . . K ^XTV(8992,CIAUSR,"XQA",CIAADT)

 . . . W !,"Entry: "_CIAUSR_" :: "_CIAADT_"    deleted..."

 Q

CLEANUP ;

 K ^TMP($J,"CIAZALTQ")

 Q

 ;

FIXXQA ; Fix XQA node in Alert File for user

 N IEN

 S IEN=0 F  S IEN=$O(^XTV(8992,IEN)) Q:'IEN  D

 .I '$P($G(^XTV(8992,IEN,"XQA",0)),U,2) D

 ..W !,"Fixing Corrupted Node..."_IEN

 .S $P(^XTV(8992,IEN,"XQA",0),U,2)="8992.01DA"

 Q

CIAZALTQ  ;CIA/PLS - Query Alert Global for Corrupt Entries;16-Aug-2004 08:43;PLS

 +1       ;;1.0

EN        ;

 +1        DO CLEANUP

 +2        IF $$CHECK()

               DO PROMPT

 +3        DO CLEANUP

 +4        QUIT 

CHECK()   ;Entry to loop thru the ^XTV(8992 global looking for entries

 +1       ;without a zero node.

 +2        USE IO

 +3        WRITE !,"Checking Alert Global..."

 +4        NEW CIAUSR,CIAADT

 +5        SET CIAUSR=0

 +6        FOR 

               SET CIAUSR=$ORDER(^XTV(8992,CIAUSR))

               IF CIAUSR<.1

                   QUIT 

               Begin DoDot:1

 +7                SET CIAADT=0

                   FOR 

                       SET CIAADT=$ORDER(^XTV(8992,CIAUSR,"XQA",CIAADT))

                       IF CIAADT<1

                           QUIT 

                       Begin DoDot:2

 +8                        IF '$DATA(^XTV(8992,CIAUSR,"XQA",CIAADT,0))

                               Begin DoDot:3

 +9       ;store info for potential deletion

                                   SET ^TMP($JOB,"CIAZALTQ",CIAUSR,CIAADT)=""

 +10                               WRITE !,"Alert: "_CIAADT_" for user: "_CIAUSR_" is missing the zero node."

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +11       WRITE !,"Checking complete.",!!

 +12       QUIT $DATA(^TMP($JOB,"CIAZALTQ"))

 +13      ;

PROMPT    ;Prompt user to delete bad nodes

 +1        IF $$ASK^CIAU("Would you like to delete the nodes identified above")

               Begin DoDot:1

 +2                NEW CIAUSR,CIAADT

 +3                SET CIAUSR=0

 +4                FOR 

                       SET CIAUSR=$ORDER(^TMP($JOB,"CIAZALTQ",CIAUSR))

                       IF CIAUSR<.1

                           QUIT 

                       Begin DoDot:2

 +5                        SET CIAADT=0

                           FOR 

                               SET CIAADT=$ORDER(^TMP($JOB,"CIAZALTQ",CIAUSR,CIAADT))

                               IF CIAADT<1

                                   QUIT 

                               Begin DoDot:3

 +6                                KILL ^XTV(8992,CIAUSR,"XQA",CIAADT)

 +7                                WRITE !,"Entry: "_CIAUSR_" :: "_CIAADT_"    deleted..."

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +8        QUIT 

CLEANUP   ;

 +1        KILL ^TMP($JOB,"CIAZALTQ")

 +2        QUIT 

 +3       ;

FIXXQA    ; Fix XQA node in Alert File for user

 +1        NEW IEN

 +2        SET IEN=0

           FOR 

               SET IEN=$ORDER(^XTV(8992,IEN))

               IF 'IEN

                   QUIT 

               Begin DoDot:1

 +3                IF '$PIECE($GET(^XTV(8992,IEN,"XQA",0)),U,2)

                       Begin DoDot:2

 +4                        WRITE !,"Fixing Corrupted Node..."_IEN

                       End DoDot:2

 +5                SET $PIECE(^XTV(8992,IEN,"XQA",0),U,2)="8992.01DA"

               End DoDot:1

 +6        QUIT