Routine: XUMF261P

XUMF261P ;OIFO-OAK/RAM - XUMF *261 post init;04/15/02

 ;;8.0;KERNEL;**261**;Jul 10, 1995

POST ; -- post init

 N DIK,DA,STA,IEN,IENS,FDA,FTYP,XUMF

 ; delete existing traditional x-ref on IDENTIFIER .02

 D DELIX^DDMOD(4.9999,.02,1)

 D DELIX^DDMOD(4.9999,.02,2)

 K ^DIC(4,"A XUMF ID")

 K ^DIC(4,"A XUMF IEN")

 S XUMF=1

 ; populate VA station number in IDENTIFIER

 S STA=""

 F  S STA=$O(^DIC(4,"D",STA)) Q:STA=""  D

 .S IEN=$O(^DIC(4,"D",STA,0))

 .S IENS="?+1,"_IEN_","

 .K FDA

 .S FDA(4.9999,IENS,.01)="VASTANUM"

 .S FDA(4.9999,IENS,.02)=STA

.D

 ..N IEN,STA

 ..D UPDATE^DIE("E","FDA")

 ; re-index IDENTIFIER .02 (XUMFID and XUMFIDX)

 S IEN=0

 F  S IEN=$O(^DIC(4,IEN)) Q:'IEN  D

 .S DIK="^DIC(4,"_IEN_",9999,"

 .S DA(1)=IEN,DIK(1)=".02"

 .D ENALL^DIK

 K ^DIC(4,"XUMFID","DMIS")

 K ^DIC(4,"XUMFID","VASTANUM")

 ; task job to load DMIS IDs

 D BG^XUMF218

XUMF261P  ;OIFO-OAK/RAM - XUMF *261 post init;04/15/02

 +1       ;;8.0;KERNEL;**261**;Jul 10, 1995

 +2       ;

 +3        QUIT

 +4       ;

POST      ; -- post init

 +1       ;

 +2        NEW DIK,DA,STA,IEN,IENS,FDA,FTYP,XUMF

 +3       ;

 +4       ; delete existing traditional x-ref on IDENTIFIER .02

 +5        DO DELIX^DDMOD(4.9999,.02,1)

 +6        DO DELIX^DDMOD(4.9999,.02,2)

 +7       ;

 +8        KILL ^DIC(4,"A XUMF ID")

 +9        KILL ^DIC(4,"A XUMF IEN")

 +10      ;

 +11       SET XUMF=1

 +12      ;

 +13      ; populate VA station number in IDENTIFIER

 +14       SET STA=""

 +15       FOR

               SET STA=$ORDER(^DIC(4,"D",STA))

               IF STA=""

                   QUIT

               Begin DoDot:1

 +16               SET IEN=$ORDER(^DIC(4,"D",STA,0))

 +17               SET IENS="?+1,"_IEN_","

 +18               KILL FDA

 +19               SET FDA(4.9999,IENS,.01)="VASTANUM"

 +20               SET FDA(4.9999,IENS,.02)=STA

 +21               Begin DoDot:2

 +22                   NEW IEN,STA

 +23                   DO UPDATE^DIE("E","FDA")

                   End DoDot:2

               End DoDot:1

 +24      ;

 +25      ; re-index IDENTIFIER .02 (XUMFID and XUMFIDX)

 +26       SET IEN=0

 +27       FOR

               SET IEN=$ORDER(^DIC(4,IEN))

               IF 'IEN

                   QUIT

               Begin DoDot:1

 +28               SET DIK="^DIC(4,"_IEN_",9999,"

 +29               SET DA(1)=IEN

                   SET DIK(1)=".02"

 +30               DO ENALL^DIK

               End DoDot:1

 +31      ;

 +32       KILL ^DIC(4,"XUMFID","DMIS")

 +33       KILL ^DIC(4,"XUMFID","VASTANUM")

 +34      ;

 +35      ; task job to load DMIS IDs

 +36       DO BG^XUMF218

 +37      ;

 +38       QUIT

 +39      ;

XUMF261P.m