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/XUMF218.m@ 1766

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

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1XUMF218 ;OIFO-OAK/RAM - Load DOD DMIS ID's;04/15/02
2 ;;8.0;KERNEL;**218**;Jul 10, 1995
3 ;
4 ; $$PARAM^HLCS2 call supported by IA #3552
5 ;
6 Q
7 ;
8MAIN ; -- main
9 ;
10 I $$CNT<1000 Q
11 ;
12 D BG
13 ;
14 Q
15 ;
16BG ; -- background job
17 ;
18 N ZTRTN,ZTDESC,ZTDTH
19 ;
20 S ZTRTN="EN^XUMF218"
21 S ZTDESC="XUMF Load DOD DMIS ID's"
22 S ZTDTH=$$NOW^XLFDT
23 S ZTIO=""
24 ;
25 D ^%ZTLOAD
26 ;
27 Q
28 ;
29EN ; -- entry point
30 ;
31UPDATE ; -- get FACILITY TYPE, update, get INSTITUTION, update
32 ;
33 ; -- get FACILITY TYPE
34 K ^TMP("XUMF ARRAY",$J)
35 ;
36 N PARAM,XUMFLAG,ERROR,TEST
37 ;
38 S (ERROR,XUMFLAG,TEST)=0
39 ;
40 I $P($$PARAM^HLCS2,U,3)="T" S TEST=1
41 ;
42 L +^TMP("XUMF ARRAY",$J):0 D:'$T
43 .S ERROR="1^another process is using the Master File Server"
44 ;
45 I ERROR D EXIT Q
46 ;
47 D MFS0
48 ;
49 I ERROR D EXIT Q
50 ;
51 I '$D(^TMP("XUMF ARRAY",$J)) D D EXIT Q
52 .S ERROR="1^Connection to master file server failed!"
53 ;
54 ; -- update
55 D FTCLEAN^XUMF4A I ERROR D EXIT Q
56 ;
57 ; -- get INSTITUTION
58 K ^TMP("XUMF ARRAY",$J),^TMP("XUMF MFS",$J)
59 ;
60 D MFS1
61 ;
62 I ERROR D EXIT Q
63 ;
64 I '$D(^TMP("XUMF ARRAY",$J)) D Q
65 .S ERROR="1^Connection to master file server failed!"
66 .D EXIT
67 ;
68 ; -- update
69 D EN^XUMF218A
70 ;
71 D EXIT
72 ;
73 Q
74 ;
75MFS0 ; -- get national facility type file from Master File Server
76 ;
77 S PARAM("LLNK")="XUMF MFR^XUMF "_$S('TEST:"FORUM",1:"TEST")
78 S PARAM("PROTOCOL")=$O(^ORD(101,"B","XUMF MFQ",0))
79 ;
80 D MAIN^XUMFP(4.1,"ALL",7,.PARAM,.ERROR) Q:ERROR
81 D MAIN^XUMFI(4.1,"ALL",7,.PARAM,.ERROR) Q:ERROR
82 D MAIN^XUMFH
83 ;
84 Q
85 ;
86MFS1 ; -- get national facility type file from Master File Server
87 ;
88 S PARAM("CDSYS")="DMIS"
89 S PARAM("LLNK")="XUMF MFR^XUMF "_$S('TEST:"FORUM",1:"TEST")
90 S PARAM("PROTOCOL")=$O(^ORD(101,"B","XUMF MFQ",0))
91 ;
92 D MAIN^XUMFP(4,"ALL",7,.PARAM,.ERROR) Q:ERROR
93 D MAIN^XUMFI(4,"ALL",7,.PARAM,.ERROR) Q:ERROR
94 D MAIN^XUMFH
95 ;
96 Q
97 ;
98 ;
99CNT() ; -- count station numbers in Institution file
100 ;
101 N STA,CNT
102 ;
103 S STA="" F S STA=$O(^DIC(4,"D",STA)) Q:STA="" S CNT=$G(CNT)+1
104 ;
105 Q CNT
106 ;
107EXIT ; -- cleanup and quit
108 ;
109 K ^TMP("XUMF ARRAY",$J),^TMP("XUMF MFS",$J),^TMP("DIERR",$J)
110 ;
111 L -^TMP("XUMF ARRAY",$J)
112 ;
113 S ZTREQ="@"
114 ;
115 Q
116 ;
Note: See TracBrowser for help on using the repository browser.