DG53164P ;ABR/ALB - POST-INIT FOR PTF/MAS 43 Y2K ; 5 JAN 1998
;;5.3;Registration;**164**;Aug 13, 1993
;
; This routine updates the FY entries in the MAS PARAMETERS file (#43) to
; make them Y2K compatible. All 2-digit FYs have been changed to the
; FileMan 3-digit entry (e.g. '91' becomes '291')
;
;
; This routine may be re-run.
;
EN ; POST-INSTALL ENTRY POINT
D FYUP
Q
FYUP ; change FY nodes to FM FY references
N FY,FMFY
D BMES^XPDUTL(">> Updating FY nodes for Year 2000 compatibility.")
F FY=0:0 S FY=$O(^DG(43,1,"FY",FY)) Q:'FY!(FY>200) D
. S FMFY=$S(FY>500:FY,1:(FY+200)_"0000")
. S ^DG(43,1,"FY",FMFY,0)=FMFY_U_$P(^DG(43,1,"FY",FY,0),U,2,99)
. I FY'=FMFY K ^DG(43,1,"FY",FY)
S:$G(FMFY) $P(^DG(43,1,"FY",0),U,3)=FMFY
Q
PTFADMTX ; delete output transform for field 2, file 45.
Q
K ^DD(45,2,2),^(2.1)
D BMES^XPDUTL(">> Deleting unused Output Transform on ADMISSION DATE, PTF file.")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53164P 944 printed Nov 22, 2024@17:46:22 Page 2
DG53164P ;ABR/ALB - POST-INIT FOR PTF/MAS 43 Y2K ; 5 JAN 1998
+1 ;;5.3;Registration;**164**;Aug 13, 1993
+2 ;
+3 ; This routine updates the FY entries in the MAS PARAMETERS file (#43) to
+4 ; make them Y2K compatible. All 2-digit FYs have been changed to the
+5 ; FileMan 3-digit entry (e.g. '91' becomes '291')
+6 ;
+7 ;
+8 ; This routine may be re-run.
+9 ;
EN ; POST-INSTALL ENTRY POINT
+1 DO FYUP
+2 QUIT
FYUP ; change FY nodes to FM FY references
+1 NEW FY,FMFY
+2 DO BMES^XPDUTL(">> Updating FY nodes for Year 2000 compatibility.")
+3 FOR FY=0:0
SET FY=$ORDER(^DG(43,1,"FY",FY))
if 'FY!(FY>200)
QUIT
Begin DoDot:1
+4 SET FMFY=$SELECT(FY>500:FY,1:(FY+200)_"0000")
+5 SET ^DG(43,1,"FY",FMFY,0)=FMFY_U_$PIECE(^DG(43,1,"FY",FY,0),U,2,99)
+6 IF FY'=FMFY
KILL ^DG(43,1,"FY",FY)
End DoDot:1
+7 if $GET(FMFY)
SET $PIECE(^DG(43,1,"FY",0),U,3)=FMFY
+8 QUIT
PTFADMTX ; delete output transform for field 2, file 45.
+1 QUIT
+2 KILL ^DD(45,2,2),^(2.1)
+3 DO BMES^XPDUTL(">> Deleting unused Output Transform on ADMISSION DATE, PTF file.")
