- DIPS95 ;SFISC/MKO-POST INSTALL ROUTINE FOR PATCH DI*22*95 ;8:38 AM 18 Sep 2002
- ;;22.0;VA FileMan;**95**;Mar 30, 1999;Build 1
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- ;Recompile all input templates that contain fields with new-style
- ;cross-references defined on them.
- RECOMP N CNT,FIL,FLD,NAM,TEM
- K ^TMP("DIPS95",$J)
- D BMES^XPDUTL("Recompiling input templates...")
- S FIL=.9999 F S FIL=$O(^DD("IX","F",FIL)) Q:'FIL D
- . S FLD=0 F S FLD=$O(^DD("IX","F",FIL,FLD)) Q:'FLD D
- .. S TEM=0 F S TEM=$O(^DIE("AF",FIL,FLD,TEM)) Q:'TEM D
- ... Q:$D(^TMP("DIPS95",$J,"TEM",TEM)) S ^(TEM)=""
- ... S NAM=$G(^DIE(TEM,"ROUOLD")) Q:NAM=""
- ... S CNT=$G(CNT)+1
- ... D MES^XPDUTL(" #"_TEM_" "_$P($G(^DIE(TEM,0)),U)_" File #"_$P($G(^DIE(TEM,0)),U,4)_" ^"_NAM)
- ... D EN2^DIEZ(TEM,"",NAM)
- D:'$G(CNT) MES^XPDUTL(" -- No input template needed to be recompiled.")
- K ^TMP("DIPS95",$J)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIPS95 937 printed Mar 13, 2025@21:58:17 Page 2
- DIPS95 ;SFISC/MKO-POST INSTALL ROUTINE FOR PATCH DI*22*95 ;8:38 AM 18 Sep 2002
- +1 ;;22.0;VA FileMan;**95**;Mar 30, 1999;Build 1
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- +4 ;Recompile all input templates that contain fields with new-style
- +5 ;cross-references defined on them.
- RECOMP NEW CNT,FIL,FLD,NAM,TEM
- +1 KILL ^TMP("DIPS95",$JOB)
- +2 DO BMES^XPDUTL("Recompiling input templates...")
- +3 SET FIL=.9999
- FOR
- SET FIL=$ORDER(^DD("IX","F",FIL))
- if 'FIL
- QUIT
- Begin DoDot:1
- +4 SET FLD=0
- FOR
- SET FLD=$ORDER(^DD("IX","F",FIL,FLD))
- if 'FLD
- QUIT
- Begin DoDot:2
- +5 SET TEM=0
- FOR
- SET TEM=$ORDER(^DIE("AF",FIL,FLD,TEM))
- if 'TEM
- QUIT
- Begin DoDot:3
- +6 if $DATA(^TMP("DIPS95",$JOB,"TEM",TEM))
- QUIT
- SET ^(TEM)=""
- +7 SET NAM=$GET(^DIE(TEM,"ROUOLD"))
- if NAM=""
- QUIT
- +8 SET CNT=$GET(CNT)+1
- +9 DO MES^XPDUTL(" #"_TEM_" "_$PIECE($GET(^DIE(TEM,0)),U)_" File #"_$PIECE($GET(^DIE(TEM,0)),U,4)_" ^"_NAM)
- +10 DO EN2^DIEZ(TEM,"",NAM)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +11 if '$GET(CNT)
- DO MES^XPDUTL(" -- No input template needed to be recompiled.")
- +12 KILL ^TMP("DIPS95",$JOB)
- +13 QUIT
