source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUMF218A.m@ 1150

Last change on this file since 1150 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.1 KB
RevLine 
[613]1XUMF218A ;OIFO-OAK/RAM - Load DMIS ID's;04/15/02
2 ;;8.0;KERNEL;**218,261**;Jul 10, 1995
3 ;
4 ;
5EN ; -- entry point
6 ;
7 N ID,NAME,FDA,ERROR,IEN,IENS,X,XUMF,STANUM,OFNME,AGENCY
8 ;
9 S XUMF=1
10 ;
11 S ID=""
12 F S ID=$O(^TMP("XUMF ARRAY",$J,ID)) Q:ID="" D
13 .S X=^TMP("XUMF ARRAY",$J,ID)
14 .S STANUM=$P(X,U,3)
15 .S IEN=$$IEN^XUMF(4,"DMIS",ID)
16 .I 'IEN,$G(STANUM)'="" S IEN=$O(^DIC(4,"D",STANUM,0))
17 .S IENS=$S(IEN:IEN_",",1:"+1,")
18 .S NAME=$P(X,U,2)
19 .S OFNME=$P(X,U,6)
20 .S AGENCY=$P(X,U,17)
21 .K FDA,IEN1
22 .S FDA(4,IENS,.01)=NAME
23 .S FDA(4,IENS,100)=OFNME
24 .S FDA(4,IENS,95)=$P(AGENCY,"~")
25 .D UPDATE^DIE("E","FDA","IEN1")
26 .I 'IEN S IEN=$G(IEN1(1))
27 .Q:'IEN
28 .S IENS="?+1,"_IEN_","
29 .K FDA
30 .S FDA(4.9999,IENS,.01)="DMIS"
31 .S FDA(4.9999,IENS,.02)=ID
32 .D UPDATE^DIE("E","FDA")
33 ;
34 Q
35 ;
36FTCLEAN ; -- add missing facility types
37 ;
38 N NAME,FULL,FDA
39 ;
40 S NAME=""
41 F S NAME=$O(^TMP("XUMF ARRAY",$J,NAME)) Q:NAME="" D
42 .S FULL=$P(^TMP("XUMF ARRAY",$J,NAME),U,3)
43 .D
44 ..K FDA
45 ..S FDA(4.1,"?+1,",.01)=NAME
46 ..S FDA(4.1,"?+1,",1)=FULL
47 ..S FDA(4.1,"?+1,",3)="N"
48 ..N NAME
49 ..D UPDATE^DIE("E","FDA",,"ERR")
50 ;
51 Q
52 ;
Note: See TracBrowser for help on using the repository browser.