KMPDUTL4 ;OAK/RAK; Reverse Video Header/Footer ;2/17/04 10:54
;;3.0;KMPD;;Jan 22, 2009;Build 42
;
CONTINUE(KMPDMSSG,KMPDLN,KMPDY) ;-- press return to continue
;---------------------------------------------------------------------
; KMPDMSSG. (optional) Message to display to user (if not defined then
; default message by ^DIR is used).
; KMPDLN... Lines to go down before printing
; KMPDY.... Return value: 0 - do not continue.
; 1 - continue.
; Access by reference.
;---------------------------------------------------------------------
;
S KMPDMSSG=$G(KMPDMSSG),KMPDLN=+$G(KMPDLN),KMPDY=0
;
; if not terminal continue without displaying message.
I $E(IOST,1,2)'="C-" S KMPDY=1 Q
;
N DIR,I,X,Y
S DIR(0)="EO"
S:KMPDMSSG]"" DIR("A")=KMPDMSSG
I KMPDLN F I=1:1:KMPDLN W !
D ^DIR
S KMPDY=+$G(Y)
;
Q
;
HDR(TITLE1,TITLE2) ;header
;---------------------------------------------------------------------
; clear screen and print header in reverse video
;
; if TITLE1 is not defined routine will quit
;---------------------------------------------------------------------
S TITLE1=$G(TITLE1),TITLE2=$G(TITLE2) Q:TITLE1']""
I $G(IORVON)']""!($G(IORVOFF)']"") N IORVON,IORVOFF,X D
.S X="IORVON;IORVOFF" D ENDR^%ZISS
S TITLE1=IORVON_" "_TITLE1_" "_IORVOFF
I TITLE2]"" S TITLE2=IORVON_" "_TITLE2_" "_IORVOFF
W @IOF
W !?(IOM-$L(TITLE1)/2),TITLE1
I TITLE2]"" W !?(IOM-$L(TITLE2)/2),TITLE2
Q
;
FTR(FOOTER,VALUE) ;print footer
;---------------------------------------------------------------------
; line feed to IOSL-3 and place message on screen
; if IOSL or IOM are not defined routine will quit
;
; FOOTER - text to appear at the bottom of the screen
; if footer is not defined then the message
; 'Press RETURN to continue, '^' to exit' will appear
;
; footer appears in the middle of the screen
;
; VALUE - value returned:
; "" - if IOSL or IOM are not defined
; 0 - if an uparrow '^' is entered
; 1 - if return is entered
;---------------------------------------------------------------------
;
S VALUE="" I '$G(IOSL)!('$G(IOM)) Q
N DIR,I,X,Y
I $G(FOOTER)']"" S FOOTER="Press RETURN to continue, '^' to exit"
I $G(IORVON)']""!($G(IORVOFF)']"") N IORVON,IORVOFF,X D
.S X="IORVON;IORVOFF" D ENDR^%ZISS
S FOOTER=IORVON_" "_FOOTER_" "_IORVOFF
S DIR(0)="EA",DIR("A")=$J(" ",(IOM-$L(FOOTER)/2))_FOOTER
F I=$Y:1:(IOSL-3) W !
D ^DIR S VALUE=Y
Q
;
PTNPSEL() ;-- extrinsic function - select prime time, non-prime time or both
;---------------------------------------------------------------------
; Return: 1^Prime Time
; 2^Non-Prime Time
; 3^Both Prime Time & Non-Prime Time
; "" - no selection made
;---------------------------------------------------------------------
N DIR,X,Y
S DIR(0)="SO^1:Prime Time;2:Non-Prime Time"
S DIR("A")="Select Time Frame",DIR("B")=1
S DIR("?",1)="Select one of the following:"
S DIR("?",2)=""
S DIR("?",3)=" PRIME TIME => Weekdays 8 am till 5 pm"
S DIR("?",4)=" - or -"
S DIR("?",5)=" NON-PRIME TIME => Weekdays after 5 pm and before 8 am"
S DIR("?")=" and Weekends all day"
D ^DIR
Q:$G(Y)=""!($G(Y)="^") ""
Q $S(Y:Y_"^"_$G(Y(0)),1:Y)
;
STRIP(TEXT) ;-- function to strip leading spaces from text string
;---------------------------------------------------------------------
; input TEXT = text string
;---------------------------------------------------------------------
;
N I,LEN
;
S LEN=$L(TEXT)
F I=1:1:LEN Q:$E(TEXT)'=" " D
.S TEXT=$E(TEXT,2,LEN)
;
Q TEXT
;
COMMA(TEXT) ;-- function to remove commas from text string
;---------------------------------------------------------------------
; input TEXT = text string
;---------------------------------------------------------------------
;
S TEXT=$TR(TEXT,",")
;
Q TEXT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HKMPDUTL4 4021 printed Dec 13, 2024@01:41:20 Page 2
KMPDUTL4 ;OAK/RAK; Reverse Video Header/Footer ;2/17/04 10:54
+1 ;;3.0;KMPD;;Jan 22, 2009;Build 42
+2 ;
CONTINUE(KMPDMSSG,KMPDLN,KMPDY) ;-- press return to continue
+1 ;---------------------------------------------------------------------
+2 ; KMPDMSSG. (optional) Message to display to user (if not defined then
+3 ; default message by ^DIR is used).
+4 ; KMPDLN... Lines to go down before printing
+5 ; KMPDY.... Return value: 0 - do not continue.
+6 ; 1 - continue.
+7 ; Access by reference.
+8 ;---------------------------------------------------------------------
+9 ;
+10 SET KMPDMSSG=$GET(KMPDMSSG)
SET KMPDLN=+$GET(KMPDLN)
SET KMPDY=0
+11 ;
+12 ; if not terminal continue without displaying message.
+13 IF $EXTRACT(IOST,1,2)'="C-"
SET KMPDY=1
QUIT
+14 ;
+15 NEW DIR,I,X,Y
+16 SET DIR(0)="EO"
+17 if KMPDMSSG]""
SET DIR("A")=KMPDMSSG
+18 IF KMPDLN
FOR I=1:1:KMPDLN
WRITE !
+19 DO ^DIR
+20 SET KMPDY=+$GET(Y)
+21 ;
+22 QUIT
+23 ;
HDR(TITLE1,TITLE2) ;header
+1 ;---------------------------------------------------------------------
+2 ; clear screen and print header in reverse video
+3 ;
+4 ; if TITLE1 is not defined routine will quit
+5 ;---------------------------------------------------------------------
+6 SET TITLE1=$GET(TITLE1)
SET TITLE2=$GET(TITLE2)
if TITLE1']""
QUIT
+7 IF $GET(IORVON)']""!($GET(IORVOFF)']"")
NEW IORVON,IORVOFF,X
Begin DoDot:1
+8 SET X="IORVON;IORVOFF"
DO ENDR^%ZISS
End DoDot:1
+9 SET TITLE1=IORVON_" "_TITLE1_" "_IORVOFF
+10 IF TITLE2]""
SET TITLE2=IORVON_" "_TITLE2_" "_IORVOFF
+11 WRITE @IOF
+12 WRITE !?(IOM-$LENGTH(TITLE1)/2),TITLE1
+13 IF TITLE2]""
WRITE !?(IOM-$LENGTH(TITLE2)/2),TITLE2
+14 QUIT
+15 ;
FTR(FOOTER,VALUE) ;print footer
+1 ;---------------------------------------------------------------------
+2 ; line feed to IOSL-3 and place message on screen
+3 ; if IOSL or IOM are not defined routine will quit
+4 ;
+5 ; FOOTER - text to appear at the bottom of the screen
+6 ; if footer is not defined then the message
+7 ; 'Press RETURN to continue, '^' to exit' will appear
+8 ;
+9 ; footer appears in the middle of the screen
+10 ;
+11 ; VALUE - value returned:
+12 ; "" - if IOSL or IOM are not defined
+13 ; 0 - if an uparrow '^' is entered
+14 ; 1 - if return is entered
+15 ;---------------------------------------------------------------------
+16 ;
+17 SET VALUE=""
IF '$GET(IOSL)!('$GET(IOM))
QUIT
+18 NEW DIR,I,X,Y
+19 IF $GET(FOOTER)']""
SET FOOTER="Press RETURN to continue, '^' to exit"
+20 IF $GET(IORVON)']""!($GET(IORVOFF)']"")
NEW IORVON,IORVOFF,X
Begin DoDot:1
+21 SET X="IORVON;IORVOFF"
DO ENDR^%ZISS
End DoDot:1
+22 SET FOOTER=IORVON_" "_FOOTER_" "_IORVOFF
+23 SET DIR(0)="EA"
SET DIR("A")=$JUSTIFY(" ",(IOM-$LENGTH(FOOTER)/2))_FOOTER
+24 FOR I=$Y:1:(IOSL-3)
WRITE !
+25 DO ^DIR
SET VALUE=Y
+26 QUIT
+27 ;
PTNPSEL() ;-- extrinsic function - select prime time, non-prime time or both
+1 ;---------------------------------------------------------------------
+2 ; Return: 1^Prime Time
+3 ; 2^Non-Prime Time
+4 ; 3^Both Prime Time & Non-Prime Time
+5 ; "" - no selection made
+6 ;---------------------------------------------------------------------
+7 NEW DIR,X,Y
+8 SET DIR(0)="SO^1:Prime Time;2:Non-Prime Time"
+9 SET DIR("A")="Select Time Frame"
SET DIR("B")=1
+10 SET DIR("?",1)="Select one of the following:"
+11 SET DIR("?",2)=""
+12 SET DIR("?",3)=" PRIME TIME => Weekdays 8 am till 5 pm"
+13 SET DIR("?",4)=" - or -"
+14 SET DIR("?",5)=" NON-PRIME TIME => Weekdays after 5 pm and before 8 am"
+15 SET DIR("?")=" and Weekends all day"
+16 DO ^DIR
+17 if $GET(Y)=""!($GET(Y)="^")
QUIT ""
+18 QUIT $SELECT(Y:Y_"^"_$GET(Y(0)),1:Y)
+19 ;
STRIP(TEXT) ;-- function to strip leading spaces from text string
+1 ;---------------------------------------------------------------------
+2 ; input TEXT = text string
+3 ;---------------------------------------------------------------------
+4 ;
+5 NEW I,LEN
+6 ;
+7 SET LEN=$LENGTH(TEXT)
+8 FOR I=1:1:LEN
if $EXTRACT(TEXT)'=" "
QUIT
Begin DoDot:1
+9 SET TEXT=$EXTRACT(TEXT,2,LEN)
End DoDot:1
+10 ;
+11 QUIT TEXT
+12 ;
COMMA(TEXT) ;-- function to remove commas from text string
+1 ;---------------------------------------------------------------------
+2 ; input TEXT = text string
+3 ;---------------------------------------------------------------------
+4 ;
+5 SET TEXT=$TRANSLATE(TEXT,",")
+6 ;
+7 QUIT TEXT
+8 ;
