- DIPOS104 ;SFISC/SO,GFT-POST INSTALL ROUTINE FOR PATCH DI*22.0*104 ;5:37 AM 5 Jun 2002
- ;;22.0;VA FileMan;**104**;Mar 30, 1999;Build 1
- ;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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIPOS104 730 printed Apr 23, 2025@19:07:25 Page 2
- DIPOS104 ;SFISC/SO,GFT-POST INSTALL ROUTINE FOR PATCH DI*22.0*104 ;5:37 AM 5 Jun 2002
- +1 ;;22.0;VA FileMan;**104**;Mar 30, 1999;Build 1
- +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
