| [613] | 1 | XUMF218 ;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 | ;
|
|---|
| 8 | MAIN ; -- main
|
|---|
| 9 | ;
|
|---|
| 10 | I $$CNT<1000 Q
|
|---|
| 11 | ;
|
|---|
| 12 | D BG
|
|---|
| 13 | ;
|
|---|
| 14 | Q
|
|---|
| 15 | ;
|
|---|
| 16 | BG ; -- 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 | ;
|
|---|
| 29 | EN ; -- entry point
|
|---|
| 30 | ;
|
|---|
| 31 | UPDATE ; -- 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 | ;
|
|---|
| 75 | MFS0 ; -- 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 | ;
|
|---|
| 86 | MFS1 ; -- 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 | ;
|
|---|
| 99 | CNT() ; -- 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 | ;
|
|---|
| 107 | EXIT ; -- 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 | ;
|
|---|
