DIPOS104.m

DIPOS104 ;SFISC/SO,GFT-POST INSTALL ROUTINE FOR PATCH DI*22.0*104 ;5:37 AM  5 Jun 2002 [ 12/09/2003  4:13 PM ]

 ;;22.0;VA FileMan;**104,1002**;Mar 30, 1999

 ;Per VHA Directive 10-93-142, this routine should not be modified.

BEGIN ;

 S X="Checking Audit File for bad dates..."

 N DATE,CDATE,IEN,DIA

 D MES^XPDUTL(X)

 F DIA=0:0 S DIA=$O(^DIA(DIA)) Q:'DIA  D

 .S DATE=2700000 F  S DATE=$O(^DIA(DIA,"C",DATE)) Q:'DATE  I DATE?8N D

 ..F IEN=0:0 S IEN=$O(^DIA(DIA,"C",DATE,IEN)) Q:'IEN  K ^(IEN) D

 ...I $P($G(^DIA(DIA,IEN,0)),"^",2)=DATE D

 ....N X,X1,X2

 ....S X1=$E(DATE,1,7),X2=1

 ....D C^%DTC

 ....S CDATE=X

 ...S $P(^DIA(DIA,IEN,0),"^",2)=CDATE,^DIA(DIA,"C",CDATE,IEN)=""

 S X="Finished checking for bad dates."

 D MES^XPDUTL(X)

 Q

DIPOS104  ;SFISC/SO,GFT-POST INSTALL ROUTINE FOR PATCH DI*22.0*104 ;5:37 AM  5 Jun 2002 [ 12/09/2003  4:13 PM ]

 +1       ;;22.0;VA FileMan;**104,1002**;Mar 30, 1999

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

BEGIN     ;

 +1        SET X="Checking Audit File for bad dates..."

 +2        NEW DATE,CDATE,IEN,DIA

 +3        DO MES^XPDUTL(X)

 +4        FOR DIA=0:0

               SET DIA=$ORDER(^DIA(DIA))

               IF 'DIA

                   QUIT 

               Begin DoDot:1

 +5                SET DATE=2700000

                   FOR 

                       SET DATE=$ORDER(^DIA(DIA,"C",DATE))

                       IF 'DATE

                           QUIT 

                       IF DATE?8N

                           Begin DoDot:2

 +6                            FOR IEN=0:0

                                   SET IEN=$ORDER(^DIA(DIA,"C",DATE,IEN))

                                   IF 'IEN

                                       QUIT 

                                   KILL ^(IEN)

                                   Begin DoDot:3

 +7                                    IF $PIECE($GET(^DIA(DIA,IEN,0)),"^",2)=DATE

                                           Begin DoDot:4

 +8                                            NEW X,X1,X2

 +9                                            SET X1=$EXTRACT(DATE,1,7)

                                               SET X2=1

 +10                                           DO C^%DTC

 +11                                           SET CDATE=X

                                           End DoDot:4

 +12                                   SET $PIECE(^DIA(DIA,IEN,0),"^",2)=CDATE

                                       SET ^DIA(DIA,"C",CDATE,IEN)=""

                                   End DoDot:3

                           End DoDot:2

               End DoDot:1

 +13       SET X="Finished checking for bad dates."

 +14       DO MES^XPDUTL(X)

 +15       QUIT