XUMF218 ;OIFO-OAK/RAM - Load DOD DMIS ID's;04/15/02
;;8.0;KERNEL;**218**;Jul 10, 1995
;
; $$PARAM^HLCS2 call supported by IA #3552
;
Q
;
MAIN ; -- main
;
I $$CNT<1000 Q
;
D BG
;
Q
;
BG ; -- background job
;
N ZTRTN,ZTDESC,ZTDTH
;
S ZTRTN="EN^XUMF218"
S ZTDESC="XUMF Load DOD DMIS ID's"
S ZTDTH=$$NOW^XLFDT
S ZTIO=""
;
D ^%ZTLOAD
;
Q
;
EN ; -- entry point
;
UPDATE ; -- get FACILITY TYPE, update, get INSTITUTION, update
;
; -- get FACILITY TYPE
K ^TMP("XUMF ARRAY",$J)
;
N PARAM,XUMFLAG,ERROR,TEST
;
S (ERROR,XUMFLAG,TEST)=0
;
I $P($$PARAM^HLCS2,U,3)="T" S TEST=1
;
L +^TMP("XUMF ARRAY",$J):0 D:'$T
.S ERROR="1^another process is using the Master File Server"
;
I ERROR D EXIT Q
;
D MFS0
;
I ERROR D EXIT Q
;
I '$D(^TMP("XUMF ARRAY",$J)) D D EXIT Q
.S ERROR="1^Connection to master file server failed!"
;
; -- update
D FTCLEAN^XUMF4A I ERROR D EXIT Q
;
; -- get INSTITUTION
K ^TMP("XUMF ARRAY",$J),^TMP("XUMF MFS",$J)
;
D MFS1
;
I ERROR D EXIT Q
;
I '$D(^TMP("XUMF ARRAY",$J)) D Q
.S ERROR="1^Connection to master file server failed!"
.D EXIT
;
; -- update
D EN^XUMF218A
;
D EXIT
;
Q
;
MFS0 ; -- get national facility type file from Master File Server
;
S PARAM("LLNK")="XUMF MFR^XUMF "_$S('TEST:"FORUM",1:"TEST")
S PARAM("PROTOCOL")=$O(^ORD(101,"B","XUMF MFQ",0))
;
D MAIN^XUMFP(4.1,"ALL",7,.PARAM,.ERROR) Q:ERROR
D MAIN^XUMFI(4.1,"ALL",7,.PARAM,.ERROR) Q:ERROR
D MAIN^XUMFH
;
Q
;
MFS1 ; -- get national facility type file from Master File Server
;
S PARAM("CDSYS")="DMIS"
S PARAM("LLNK")="XUMF MFR^XUMF "_$S('TEST:"FORUM",1:"TEST")
S PARAM("PROTOCOL")=$O(^ORD(101,"B","XUMF MFQ",0))
;
D MAIN^XUMFP(4,"ALL",7,.PARAM,.ERROR) Q:ERROR
D MAIN^XUMFI(4,"ALL",7,.PARAM,.ERROR) Q:ERROR
D MAIN^XUMFH
;
Q
;
;
CNT() ; -- count station numbers in Institution file
;
N STA,CNT
;
S STA="" F S STA=$O(^DIC(4,"D",STA)) Q:STA="" S CNT=$G(CNT)+1
;
Q CNT
;
EXIT ; -- cleanup and quit
;
K ^TMP("XUMF ARRAY",$J),^TMP("XUMF MFS",$J),^TMP("DIERR",$J)
;
L -^TMP("XUMF ARRAY",$J)
;
S ZTREQ="@"
;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUMF218 2203 printed Nov 22, 2024@17:20:19 Page 2
XUMF218 ;OIFO-OAK/RAM - Load DOD DMIS ID's;04/15/02
+1 ;;8.0;KERNEL;**218**;Jul 10, 1995
+2 ;
+3 ; $$PARAM^HLCS2 call supported by IA #3552
+4 ;
+5 QUIT
+6 ;
MAIN ; -- main
+1 ;
+2 IF $$CNT<1000
QUIT
+3 ;
+4 DO BG
+5 ;
+6 QUIT
+7 ;
BG ; -- background job
+1 ;
+2 NEW ZTRTN,ZTDESC,ZTDTH
+3 ;
+4 SET ZTRTN="EN^XUMF218"
+5 SET ZTDESC="XUMF Load DOD DMIS ID's"
+6 SET ZTDTH=$$NOW^XLFDT
+7 SET ZTIO=""
+8 ;
+9 DO ^%ZTLOAD
+10 ;
+11 QUIT
+12 ;
EN ; -- entry point
+1 ;
UPDATE ; -- get FACILITY TYPE, update, get INSTITUTION, update
+1 ;
+2 ; -- get FACILITY TYPE
+3 KILL ^TMP("XUMF ARRAY",$JOB)
+4 ;
+5 NEW PARAM,XUMFLAG,ERROR,TEST
+6 ;
+7 SET (ERROR,XUMFLAG,TEST)=0
+8 ;
+9 IF $PIECE($$PARAM^HLCS2,U,3)="T"
SET TEST=1
+10 ;
+11 LOCK +^TMP("XUMF ARRAY",$JOB):0
if '$TEST
Begin DoDot:1
+12 SET ERROR="1^another process is using the Master File Server"
End DoDot:1
+13 ;
+14 IF ERROR
DO EXIT
QUIT
+15 ;
+16 DO MFS0
+17 ;
+18 IF ERROR
DO EXIT
QUIT
+19 ;
+20 IF '$DATA(^TMP("XUMF ARRAY",$JOB))
Begin DoDot:1
+21 SET ERROR="1^Connection to master file server failed!"
End DoDot:1
DO EXIT
QUIT
+22 ;
+23 ; -- update
+24 DO FTCLEAN^XUMF4A
IF ERROR
DO EXIT
QUIT
+25 ;
+26 ; -- get INSTITUTION
+27 KILL ^TMP("XUMF ARRAY",$JOB),^TMP("XUMF MFS",$JOB)
+28 ;
+29 DO MFS1
+30 ;
+31 IF ERROR
DO EXIT
QUIT
+32 ;
+33 IF '$DATA(^TMP("XUMF ARRAY",$JOB))
Begin DoDot:1
+34 SET ERROR="1^Connection to master file server failed!"
+35 DO EXIT
End DoDot:1
QUIT
+36 ;
+37 ; -- update
+38 DO EN^XUMF218A
+39 ;
+40 DO EXIT
+41 ;
+42 QUIT
+43 ;
MFS0 ; -- get national facility type file from Master File Server
+1 ;
+2 SET PARAM("LLNK")="XUMF MFR^XUMF "_$SELECT('TEST:"FORUM",1:"TEST")
+3 SET PARAM("PROTOCOL")=$ORDER(^ORD(101,"B","XUMF MFQ",0))
+4 ;
+5 DO MAIN^XUMFP(4.1,"ALL",7,.PARAM,.ERROR)
if ERROR
QUIT
+6 DO MAIN^XUMFI(4.1,"ALL",7,.PARAM,.ERROR)
if ERROR
QUIT
+7 DO MAIN^XUMFH
+8 ;
+9 QUIT
+10 ;
MFS1 ; -- get national facility type file from Master File Server
+1 ;
+2 SET PARAM("CDSYS")="DMIS"
+3 SET PARAM("LLNK")="XUMF MFR^XUMF "_$SELECT('TEST:"FORUM",1:"TEST")
+4 SET PARAM("PROTOCOL")=$ORDER(^ORD(101,"B","XUMF MFQ",0))
+5 ;
+6 DO MAIN^XUMFP(4,"ALL",7,.PARAM,.ERROR)
if ERROR
QUIT
+7 DO MAIN^XUMFI(4,"ALL",7,.PARAM,.ERROR)
if ERROR
QUIT
+8 DO MAIN^XUMFH
+9 ;
+10 QUIT
+11 ;
+12 ;
CNT() ; -- count station numbers in Institution file
+1 ;
+2 NEW STA,CNT
+3 ;
+4 SET STA=""
FOR
SET STA=$ORDER(^DIC(4,"D",STA))
if STA=""
QUIT
SET CNT=$GET(CNT)+1
+5 ;
+6 QUIT CNT
+7 ;
EXIT ; -- cleanup and quit
+1 ;
+2 KILL ^TMP("XUMF ARRAY",$JOB),^TMP("XUMF MFS",$JOB),^TMP("DIERR",$JOB)
+3 ;
+4 LOCK -^TMP("XUMF ARRAY",$JOB)
+5 ;
+6 SET ZTREQ="@"
+7 ;
+8 QUIT
+9 ;
