source: WorldVistAEHR/trunk/r/CAPACITY_MANAGEMENT_TOOLS-KMPD-KMPL/KMPDUTL4.m@ 1801

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

initial load of WorldVistAEHR

File size: 3.8 KB
RevLine 
[613]1KMPDUTL4 ;OAK/RAK; Reverse Video Header/Footer ;2/17/04 10:54
2 ;;2.0;CAPACITY MANAGEMENT TOOLS;;Mar 22, 2002
3 ;
4CONTINUE(KMPDMSSG,KMPDLN,KMPDY) ;-- press return to continue
5 ;---------------------------------------------------------------------
6 ; KMPDMSSG. (optional) Message to display to user (if not defined then
7 ; default message by ^DIR is used).
8 ; KMPDLN... Lines to go down before printing
9 ; KMPDY.... Return value: 0 - do not continue.
10 ; 1 - continue.
11 ; Access by reference.
12 ;---------------------------------------------------------------------
13 ;
14 S KMPDMSSG=$G(KMPDMSSG),KMPDLN=+$G(KMPDLN),KMPDY=0
15 ;
16 ; if not terminal continue without displaying message.
17 I $E(IOST,1,2)'="C-" S KMPDY=1 Q
18 ;
19 N DIR,I,X,Y
20 S DIR(0)="EO"
21 S:KMPDMSSG]"" DIR("A")=KMPDMSSG
22 I KMPDLN F I=1:1:KMPDLN W !
23 D ^DIR
24 S KMPDY=+$G(Y)
25 ;
26 Q
27 ;
28HDR(TITLE1,TITLE2) ;header
29 ;---------------------------------------------------------------------
30 ; clear screen and print header in reverse video
31 ;
32 ; if TITLE1 is not defined routine will quit
33 ;---------------------------------------------------------------------
34 S TITLE1=$G(TITLE1),TITLE2=$G(TITLE2) Q:TITLE1']""
35 I $G(IORVON)']""!($G(IORVOFF)']"") N IORVON,IORVOFF,X D
36 .S X="IORVON;IORVOFF" D ENDR^%ZISS
37 S TITLE1=IORVON_" "_TITLE1_" "_IORVOFF
38 I TITLE2]"" S TITLE2=IORVON_" "_TITLE2_" "_IORVOFF
39 W @IOF
40 W !?(IOM-$L(TITLE1)/2),TITLE1
41 I TITLE2]"" W !?(IOM-$L(TITLE2)/2),TITLE2
42 Q
43 ;
44FTR(FOOTER,VALUE) ;print footer
45 ;---------------------------------------------------------------------
46 ; line feed to IOSL-3 and place message on screen
47 ; if IOSL or IOM are not defined routine will quit
48 ;
49 ; FOOTER - text to appear at the bottom of the screen
50 ; if footer is not defined then the message
51 ; 'Press RETURN to continue, '^' to exit' will appear
52 ;
53 ; footer appears in the middle of the screen
54 ;
55 ; VALUE - value returned:
56 ; "" - if IOSL or IOM are not defined
57 ; 0 - if an uparrow '^' is entered
58 ; 1 - if return is entered
59 ;---------------------------------------------------------------------
60 ;
61 S VALUE="" I '$G(IOSL)!('$G(IOM)) Q
62 N DIR,I,X,Y
63 I $G(FOOTER)']"" S FOOTER="Press RETURN to continue, '^' to exit"
64 I $G(IORVON)']""!($G(IORVOFF)']"") N IORVON,IORVOFF,X D
65 .S X="IORVON;IORVOFF" D ENDR^%ZISS
66 S FOOTER=IORVON_" "_FOOTER_" "_IORVOFF
67 S DIR(0)="EA",DIR("A")=$J(" ",(IOM-$L(FOOTER)/2))_FOOTER
68 F I=$Y:1:(IOSL-3) W !
69 D ^DIR S VALUE=Y
70 Q
71 ;
72PTNPSEL() ;-- extrinsic function - select prime time, non-prime time or both
73 ;---------------------------------------------------------------------
74 ; Return: 1^Prime Time
75 ; 2^Non-Prime Time
76 ; 3^Both Prime Time & Non-Prime Time
77 ; "" - no selection made
78 ;---------------------------------------------------------------------
79 N DIR,X,Y
80 S DIR(0)="SO^1:Prime Time;2:Non-Prime Time"
81 S DIR("A")="Select Time Frame",DIR("B")=1
82 S DIR("?",1)="Select one of the following:"
83 S DIR("?",2)=""
84 S DIR("?",3)=" PRIME TIME => Weekdays 8 am till 5 pm"
85 S DIR("?",4)=" - or -"
86 S DIR("?",5)=" NON-PRIME TIME => Weekdays after 5 pm and before 8 am"
87 S DIR("?")=" and Weekends all day"
88 D ^DIR
89 Q:$G(Y)=""!($G(Y)="^") ""
90 Q $S(Y:Y_"^"_$G(Y(0)),1:Y)
91 ;
92STRIP(TEXT) ;-- function to strip leading spaces from text string
93 ;---------------------------------------------------------------------
94 ; input TEXT = text string
95 ;---------------------------------------------------------------------
96 ;
97 N I,LEN
98 ;
99 S LEN=$L(TEXT)
100 F I=1:1:LEN Q:$E(TEXT)'=" " D
101 .S TEXT=$E(TEXT,2,LEN)
102 ;
103 Q TEXT
104 ;
105COMMA(TEXT) ;-- function to remove commas from text string
106 ;---------------------------------------------------------------------
107 ; input TEXT = text string
108 ;---------------------------------------------------------------------
109 ;
110 S TEXT=$TR(TEXT,",")
111 ;
112 Q TEXT
113 ;
Note: See TracBrowser for help on using the repository browser.