XUMF218A.m

XUMF218A ;OIFO-OAK/RAM - Load DMIS ID's;04/15/02

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

 ;

 ;

EN ; -- entry point

 ;

 N ID,NAME,FDA,ERROR,IEN,IENS,X,XUMF,STANUM,OFNME,AGENCY

 ;

 S XUMF=1

 ;

 S ID=""

 F  S ID=$O(^TMP("XUMF ARRAY",$J,ID)) Q:ID=""  D

 .S X=^TMP("XUMF ARRAY",$J,ID)

 .S STANUM=$P(X,U,3)

 .S IEN=$$IEN^XUMF(4,"DMIS",ID)

 .I 'IEN,$G(STANUM)'="" S IEN=$O(^DIC(4,"D",STANUM,0))

 .S IENS=$S(IEN:IEN_",",1:"+1,")

 .S NAME=$P(X,U,2)

 .S OFNME=$P(X,U,6)

 .S AGENCY=$P(X,U,17)

 .K FDA,IEN1

 .S FDA(4,IENS,.01)=NAME

 .S FDA(4,IENS,100)=OFNME

 .S FDA(4,IENS,95)=$P(AGENCY,"~")

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

 .I 'IEN S IEN=$G(IEN1(1))

 .Q:'IEN

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

 .K FDA

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

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

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

 ;

 Q

 ;

FTCLEAN ; -- add missing facility types

 ;

 N NAME,FULL,FDA

 ;

 S NAME=""

 F  S NAME=$O(^TMP("XUMF ARRAY",$J,NAME)) Q:NAME=""  D

 .S FULL=$P(^TMP("XUMF ARRAY",$J,NAME),U,3)

 .D

 ..K FDA

 ..S FDA(4.1,"?+1,",.01)=NAME

 ..S FDA(4.1,"?+1,",1)=FULL

 ..S FDA(4.1,"?+1,",3)="N"

 ..N NAME

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

 ;

 Q

 ;

XUMF218A  ;OIFO-OAK/RAM - Load DMIS ID's;04/15/02

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

 +2       ;

 +3       ;

EN        ; -- entry point

 +1       ;

 +2        NEW ID,NAME,FDA,ERROR,IEN,IENS,X,XUMF,STANUM,OFNME,AGENCY

 +3       ;

 +4        SET XUMF=1

 +5       ;

 +6        SET ID=""

 +7        FOR 

               SET ID=$ORDER(^TMP("XUMF ARRAY",$JOB,ID))

               IF ID=""

                   QUIT 

               Begin DoDot:1

 +8                SET X=^TMP("XUMF ARRAY",$JOB,ID)

 +9                SET STANUM=$PIECE(X,U,3)

 +10               SET IEN=$$IEN^XUMF(4,"DMIS",ID)

 +11               IF 'IEN

                       IF $GET(STANUM)'=""

                           SET IEN=$ORDER(^DIC(4,"D",STANUM,0))

 +12               SET IENS=$SELECT(IEN:IEN_",",1:"+1,")

 +13               SET NAME=$PIECE(X,U,2)

 +14               SET OFNME=$PIECE(X,U,6)

 +15               SET AGENCY=$PIECE(X,U,17)

 +16               KILL FDA,IEN1

 +17               SET FDA(4,IENS,.01)=NAME

 +18               SET FDA(4,IENS,100)=OFNME

 +19               SET FDA(4,IENS,95)=$PIECE(AGENCY,"~")

 +20               DO UPDATE^DIE("E","FDA","IEN1")

 +21               IF 'IEN

                       SET IEN=$GET(IEN1(1))

 +22               IF 'IEN

                       QUIT 

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

 +24               KILL FDA

 +25               SET FDA(4.9999,IENS,.01)="DMIS"

 +26               SET FDA(4.9999,IENS,.02)=ID

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

               End DoDot:1

 +28      ;

 +29       QUIT 

 +30      ;

FTCLEAN   ; -- add missing facility types

 +1       ;

 +2        NEW NAME,FULL,FDA

 +3       ;

 +4        SET NAME=""

 +5        FOR 

               SET NAME=$ORDER(^TMP("XUMF ARRAY",$JOB,NAME))

               IF NAME=""

                   QUIT 

               Begin DoDot:1

 +6                SET FULL=$PIECE(^TMP("XUMF ARRAY",$JOB,NAME),U,3)

 +7                Begin DoDot:2

 +8                    KILL FDA

 +9                    SET FDA(4.1,"?+1,",.01)=NAME

 +10                   SET FDA(4.1,"?+1,",1)=FULL

 +11                   SET FDA(4.1,"?+1,",3)="N"

 +12                   NEW NAME

 +13                   DO UPDATE^DIE("E","FDA",,"ERR")

                   End DoDot:2

               End DoDot:1

 +14      ;

 +15       QUIT 

 +16      ;