source: WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCIBKM.m@ 1742

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

initial load of WorldVistAEHR

File size: 3.1 KB
Line 
1GMRCIBKM ;SLC/JFR - MONITOR IFC BKG PARAMS ; 2/14/02 21:22
2 ;;3.0;CONSULT/REQUEST TRACKING;**22**;DEC 27, 1997
3EN ; -- main entry point for GMRC IFC MONITOR BKG JOB
4 D REFRESH
5 D EN^VALM("GMRC IF MONITOR BKG JOB")
6 Q
7 ;
8HDR ; -- header code
9 S VALMHDR(1)="Inter-facility Consults background job parameter display"
10 Q
11 ;
12BLD ; Build list for LM display
13 N GMRCBST,GMRCNOW,GMRCBFI,CNT,GMRCBSTE,GMRCBFIE,TXT
14 K ^TMP("GMRCBK",$J)
15 S GMRCNOW=$$NOW^XLFDT
16 S GMRCBST=$$GET^XPAR("SYS","GMRC IFC BACKGROUND START",1)
17 S GMRCBSTE=$S($G(GMRCBST):$$FMTE^XLFDT(GMRCBST),1:"Unknown")
18 S GMRCBFI=$$GET^XPAR("SYS","GMRC IFC BACKGROUND FINISH",1)
19 S GMRCBFIE=$S($G(GMRCBFI):$$FMTE^XLFDT(GMRCBFI),1:"Unknown")
20 S ^TMP("GMRCBK",$J,1,0)=""
21 I GMRCBST>GMRCNOW S TXT(2)="The IFC background job is delayed until: "
22 I '$D(TXT(2)) S TXT(2)="The IFC background job last started: "
23 S ^TMP("GMRCBK",$J,2,0)=TXT(2)_GMRCBSTE
24 S TXT(3)="The IFC background job last finished: "
25 S ^TMP("GMRCBK",$J,3,0)=TXT(3)_GMRCBFIE
26 S ^TMP("GMRCBK",$J,4,0)=""
27 I GMRCBST>GMRCNOW D Q
28 . S ^TMP("GMRCBK",$J,5,0)="The start parameter for this job has been "
29 . S ^TMP("GMRCBK",$J,6,0)="intentionally set to a future date/time."
30 . S ^TMP("GMRCBK",$J,7,0)=""
31 . S ^TMP("GMRCBK",$J,8,0)="The background job will not start until the "
32 . S ^TMP("GMRCBK",$J,9,0)="date/time indicated in this parameter"
33 I $$FMDIFF^XLFDT(GMRCBST,GMRCBFI,2)>4500 D Q
34 . S ^TMP("GMRCBK",$J,5,0)="The background job is overdue."
35 . S ^TMP("GMRCBK",$J,6,0)="IRMS should review the system for errors"
36 . S ^TMP("GMRCBK",$J,7,0)="related to the IFC background job."
37 . S ^TMP("GMRCBK",$J,8,0)=" "
38 . S ^TMP("GMRCBK",$J,9,0)="If errors can not be resolved, contact NVS"
39 . S ^TMP("GMRCBK",$J,10,0)="for assistance."
40 I GMRCNOW>GMRCBST,$$FMDIFF^XLFDT(GMRCNOW,GMRCBST,2)>4500 D Q
41 . S ^TMP("GMRCBK",$J,5,0)="The background job is overdue."
42 . S ^TMP("GMRCBK",$J,6,0)="IRMS should review the system for errors"
43 . S ^TMP("GMRCBK",$J,7,0)="related to the IFC background job."
44 . S ^TMP("GMRCBK",$J,8,0)=" "
45 . S ^TMP("GMRCBK",$J,9,0)="If errors can not be resolved, contact NVS"
46 . S ^TMP("GMRCBK",$J,10,0)="for assistance."
47 D ; all is well
48 . S ^TMP("GMRCBK",$J,5,0)="The IFC background job is on schedule or is"
49 . S ^TMP("GMRCBK",$J,6,0)="running. "
50 . S ^TMP("GMRCBK",$J,7,0)=""
51 . S ^TMP("GMRCBK",$J,8,0)="It may be delayed by editing the start time"
52 . S ^TMP("GMRCBK",$J,9,0)="to a future date/time using the Edit start "
53 . S ^TMP("GMRCBK",$J,10,0)="time action."
54 Q
55 ;
56EDSTRT ; edit the start parameter
57 ;
58 N DIR,X,Y,DIRUT,DTOUT,DUOUT,DIROUT,GMRCLATE,GMRCSTRT
59 D FULL^VALM1
60 S GMRCLATE=$$FMADD^XLFDT($$NOW^XLFDT,4)
61 S GMRCSTRT=$$GET^XPAR("SYS","GMRC IFC BACKGROUND START",1)
62 S DIR(0)="D0A^"_DT_":"_GMRCLATE_":ETSR"
63 S DIR("A",1)=""
64 S DIR("A")="Next date/time the IFC background job should run: "
65 S DIR("B")=$$FMTE^XLFDT(GMRCSTRT)
66 D ^DIR
67 I '+Y S VALMBCK="R" Q
68 D EN^XPAR("SYS","GMRC IFC BACKGROUND START",1,Y)
69 D REFRESH
70 Q
71 ;
72REFRESH ; rebuild list
73 D BLD
74 S VALMBCK="R",VALMCNT=$O(^TMP("GMRCBK",$J," "),-1)
75 S VALMBG=1
76 Q
77HELP ; -- help code
78 S X="?" D DISP^XQORM1 W !!
79 Q
80 ;
81EXIT ; -- exit code
82 K ^TMP("GMRCBK",$J)
83 S VALMBCK="Q"
84 Q
85 ;
Note: See TracBrowser for help on using the repository browser.