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 Dec 13, 2024@02:53:06 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
