BPSOSU8 ;BHAM ISC/FCS/DRS/FLS - utilities ;06/01/2004
;;1.0;E CLAIMS MGMT ENGINE;**1,5**;JUN 2004;Build 45
;;Per VHA Directive 2004-038, this routine should not be modified.
;*** Collection of FSI UTILITIES ***
;
;EOPQ(LINES,PARAM,Xcode) - Return 0 to continue, 1 to quit.
;PAUSE() Return 1 to continue, 0 to stop.
;ENDRPT()
;DEVICE(DEV,RTN,TITLE,MULTI) S up a device, 1 if successful, 0 not.
;HEADER(PROGRAM,TITLE1,TITLE2,RUNTIME,NOFF,UL) Procedure call
;CENTER
;UNDERLINE
;REPLICATE
;FMPAGE() Handle the screen or printer for an FM print report.
;PAGE0
;STANDBY
;======================================================================
EOPQ(LINESBOT,PARAM,EOPXCODE) ;EP -
; IN: LINESBOT = (optional) # of LINES from bottom (IOSL) before
; determining what to do next. I this is a CRT, we
; will ask user whether to continue; for printers, just
; continue. DEFAULT=6
; PARAM = List of parameter codes (each may occur):
; "M" - Will display "-- More --" at bottom.
; EOPXCODE = xecutable code that will occur if this is the
; end of the page (like, D HEADER^ROU).
;
; OUT: 0 if not end of page, OR if we're EOP but we're continuing;
; 1 if user wants to quit.
; May call this as DO in some cases (like a little trailer on report)
;
N X,Y,%,DIR
;
I '$G(IOSL) Q 0 ;if we don't know page length, then not at end
S LINESBOT=$S($G(LINESBOT):LINESBOT,1:6)
I ($Y+LINESBOT)<IOSL Q 0 ;not at end of page
; -- Okay, we're at end of page
I $G(PARAM)["M" W !,?($S($G(IOM):IOM,1:80)-12),"-- More --"
;
I '$$PAUSE Q 1 ;user wants out
X $G(EOPXCODE)
;
Q 0
;======================================================================
PAUSE() ;3/31/93
;END of screen... should we continue?
;I $E(IOST,1)'="C"
I '$$TOSCREEN^BPSOSU5 Q 1
K DIR
S DIR(0)="E" D ^DIR
Q Y ;Y=1 to continue, 0 to quit.
;===================================================================
ENDRPT() ;EP - end of report. Pause until user presses return (or timeout)
I '$$TOSCREEN^BPSOSU5 W:$Y @IOF Q 1
I $G(FLGSTOP) W !," <escape>"
N DIR,X,Y
S DIR(0)="E"
S DIR("A")=" -- END OF REPORT -- (Press <ENTER> to return to menu)"
D ^DIR
Q Y
;===================================================================
DEVICE(DEV,RTN,TITLE,MULTI) ;EP
;Select an output device.
;No parameters are required. DEV can be set alone, or if queuing
; set to variables needed for queuing.
; DEV - DEFAULT device, "HOME" if undefined.
; RTN - Routine name if queuing is selected.
; TITLE - Description for the task log if queuing is selected.
; MULTI - I then ask NUMBER OF COPIES, which sets the variable
; DCOPIES that the calling routine should use.
;Return 1 if successful, 0 if not. Also returns DCOPIES to number of
; copies if MULTI parameter is set.
;Examples: Q:'$$DEVICE^ABSBUU01("STANDARD")
;
; Q:'$$DEVICE^ABSBUU01("PC;132;66","EN^WSHLC","CORRECTION LIST")
; note: D ^%ZISC to close the device after printing is done.
N I,Y,%ZIS,POP,ZTRTN,ZTIO,ZTDESC,ZTSAVE,ZTQUEUED,PAGE
W !!
S ZTSAVE("PAGE")=""
I $D(RTN) S %ZIS="QM" ; Ask if queuing is allowed only if RTN is set.
S %ZIS("A")="Send report to device: " ;PROMPT
S %ZIS("B")=$S($D(DEV):DEV,1:"HOME") ;DEFAULT device
D ^%ZIS ;Input/Output variables.
I POP W " try again later" S Y=0 G DEVQ ;Device success flag
S PAGE=0
I '$D(IO("Q")) U IO S Y=1 G DEVQ ;Queuing not selected
S ZTRTN=RTN ;Routine entry point for queuing.
S ZTIO=ION ;Output device for queuing.
S ZTDESC=$G(TITLE) ;Report title if queuing is selected.
S ZTSAVE("*")="" ;All variables in memory for queuing.
D ^%ZTLOAD ;Entry point for queuing.
W !,$S($D(ZTQUEUED):"Request queued!",1:"Request cancelled!") ;flag
S Y='$D(ZTQUEUED)
D HOME^%ZIS ;S IO variables back to device = screen.
U IO ;Use the currently open IO device
DEVQ I +$G(MULTI)>0 D USE IO
. USE $P
. N Y
. S DCOPIES=0
. K DIR
. S DIR(0)="NO^0:99999",DIR("A")="NUMBER OF COPIES TO OUTPUT"
. S DIR("B")=1
. D ^DIR K DIR
. I +Y>0 S DCOPIES=Y
. I Y["^" S DCOPIES=-1
I $G(DCOPIES)<0 S Y=0
Q Y
;===================================================================
; This PROCEDURE accepts the routine name and titles and prints out a
; standard header with the run date and time,page and increments
; the page counter by 1. Page is initialized in function DEVICE.
; W @IOF if (to SCREEN) OR (to PRINTER after page 1)
; TITLE variable has special uses. I the calling routine
; send-in the TITLE-array (by setting TITLE(1)="LINE 1", TITLE(n)=
; "LINE n of title", and then D HEADER^WSHUTL("ROUTINE",.TITLE),"."),
; then the entire array of TITLE will be used (and TITLE2 will be
; ignored). You must send-in TITLE2="."
; RUNTIME has been added so that all pages of the report can
; have the same date.time. The calling report must send it in.
; NOFF (optional) - if it exists, then do NOT issue a FormFeed.
; This is necessary for reports that are controlled as a FileMan
; template... since FM issues its own FF, this routine should not.
; UL (opt) - is flag to print a 1-IOSL dashes after the header.
; DEFAULT is no-underline. S UL to 1 to print the underline.
;
; Note: PAGE is assumed to exist even though it is not passed in
N X,N
S $Y=0,PAGE=$G(PAGE)
I $E(IOST,1)="C"!($E(IOST,1)="P"&(PAGE>0)) I '$D(NOFF) W @IOF
S PAGE=PAGE+1
I $G(RUNTIME)="" D NOW^%DTC S Y=$E(%,1,12) X ^DD("DD") S RUNTIME=Y
W !,"RUN DATE: ",RUNTIME
W ?(IOM-10),"PAGE: ",$J(PAGE,3,0)
I $D(PROGRAM),PROGRAM'="" W !,"PGM: ",PROGRAM
I $G(TITLE2)'="." DO
. I $D(TITLE1) D WCENTER^BPSOSU9(TITLE1)
. I $D(TITLE2) D WCENTER^BPSOSU9(TITLE2)
I $G(TITLE2)="." DO
. S N=""
. F S N=$O(TITLE1(N)) Q:N="" D WCENTER^BPSOSU9($G(TITLE1(N)))
I $G(UL)=1 D ;print dashes across the page
. W !
. FOR I=1:1:$S($G(IOM)>0:IOM,1:80) W "-"
W !
Q
;===================================================================
FMPAGE ;at end of page
I $$TOSCREEN^BPSOSU5 D Q
. D PRESSANY^BPSOSU5()
I IOST["P-" W @IOF Q
; should we fall through to PAGE0?
Q
;===================================================================
PAGE0 ; This checks the IO device and issues a pagefeed if $Y>0
Q:'$G(IO)
;OPEN IO USE IO I $Y>0 USE IO W #
U IO I $Y>0 U IO W #
Q
;===================================================================
STANDBY ; W a message to screen to "Please Wait"
USE $P D WAIT^DICD USE +$G(IO)
Q
;===================================================================
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSOSU8 6745 printed Sep 23, 2025@19:28:27 Page 2
BPSOSU8 ;BHAM ISC/FCS/DRS/FLS - utilities ;06/01/2004
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1,5**;JUN 2004;Build 45
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;*** Collection of FSI UTILITIES ***
+4 ;
+5 ;EOPQ(LINES,PARAM,Xcode) - Return 0 to continue, 1 to quit.
+6 ;PAUSE() Return 1 to continue, 0 to stop.
+7 ;ENDRPT()
+8 ;DEVICE(DEV,RTN,TITLE,MULTI) S up a device, 1 if successful, 0 not.
+9 ;HEADER(PROGRAM,TITLE1,TITLE2,RUNTIME,NOFF,UL) Procedure call
+10 ;CENTER
+11 ;UNDERLINE
+12 ;REPLICATE
+13 ;FMPAGE() Handle the screen or printer for an FM print report.
+14 ;PAGE0
+15 ;STANDBY
+16 ;======================================================================
EOPQ(LINESBOT,PARAM,EOPXCODE) ;EP -
+1 ; IN: LINESBOT = (optional) # of LINES from bottom (IOSL) before
+2 ; determining what to do next. I this is a CRT, we
+3 ; will ask user whether to continue; for printers, just
+4 ; continue. DEFAULT=6
+5 ; PARAM = List of parameter codes (each may occur):
+6 ; "M" - Will display "-- More --" at bottom.
+7 ; EOPXCODE = xecutable code that will occur if this is the
+8 ; end of the page (like, D HEADER^ROU).
+9 ;
+10 ; OUT: 0 if not end of page, OR if we're EOP but we're continuing;
+11 ; 1 if user wants to quit.
+12 ; May call this as DO in some cases (like a little trailer on report)
+13 ;
+14 NEW X,Y,%,DIR
+15 ;
+16 ;if we don't know page length, then not at end
IF '$GET(IOSL)
QUIT 0
+17 SET LINESBOT=$SELECT($GET(LINESBOT):LINESBOT,1:6)
+18 ;not at end of page
IF ($Y+LINESBOT)<IOSL
QUIT 0
+19 ; -- Okay, we're at end of page
+20 IF $GET(PARAM)["M"
WRITE !,?($SELECT($GET(IOM):IOM,1:80)-12),"-- More --"
+21 ;
+22 ;user wants out
IF '$$PAUSE
QUIT 1
+23 XECUTE $GET(EOPXCODE)
+24 ;
+25 QUIT 0
+26 ;======================================================================
PAUSE() ;3/31/93
+1 ;END of screen... should we continue?
+2 ;I $E(IOST,1)'="C"
+3 IF '$$TOSCREEN^BPSOSU5
QUIT 1
+4 KILL DIR
+5 SET DIR(0)="E"
DO ^DIR
+6 ;Y=1 to continue, 0 to quit.
QUIT Y
+7 ;===================================================================
ENDRPT() ;EP - end of report. Pause until user presses return (or timeout)
+1 IF '$$TOSCREEN^BPSOSU5
if $Y
WRITE @IOF
QUIT 1
+2 IF $GET(FLGSTOP)
WRITE !," <escape>"
+3 NEW DIR,X,Y
+4 SET DIR(0)="E"
+5 SET DIR("A")=" -- END OF REPORT -- (Press <ENTER> to return to menu)"
+6 DO ^DIR
+7 QUIT Y
+8 ;===================================================================
DEVICE(DEV,RTN,TITLE,MULTI) ;EP
+1 ;Select an output device.
+2 ;No parameters are required. DEV can be set alone, or if queuing
+3 ; set to variables needed for queuing.
+4 ; DEV - DEFAULT device, "HOME" if undefined.
+5 ; RTN - Routine name if queuing is selected.
+6 ; TITLE - Description for the task log if queuing is selected.
+7 ; MULTI - I then ask NUMBER OF COPIES, which sets the variable
+8 ; DCOPIES that the calling routine should use.
+9 ;Return 1 if successful, 0 if not. Also returns DCOPIES to number of
+10 ; copies if MULTI parameter is set.
+11 ;Examples: Q:'$$DEVICE^ABSBUU01("STANDARD")
+12 ;
+13 ; Q:'$$DEVICE^ABSBUU01("PC;132;66","EN^WSHLC","CORRECTION LIST")
+14 ; note: D ^%ZISC to close the device after printing is done.
+15 NEW I,Y,%ZIS,POP,ZTRTN,ZTIO,ZTDESC,ZTSAVE,ZTQUEUED,PAGE
+16 WRITE !!
+17 SET ZTSAVE("PAGE")=""
+18 ; Ask if queuing is allowed only if RTN is set.
IF $DATA(RTN)
SET %ZIS="QM"
+19 ;PROMPT
SET %ZIS("A")="Send report to device: "
+20 ;DEFAULT device
SET %ZIS("B")=$SELECT($DATA(DEV):DEV,1:"HOME")
+21 ;Input/Output variables.
DO ^%ZIS
+22 ;Device success flag
IF POP
WRITE " try again later"
SET Y=0
GOTO DEVQ
+23 SET PAGE=0
+24 ;Queuing not selected
IF '$DATA(IO("Q"))
USE IO
SET Y=1
GOTO DEVQ
+25 ;Routine entry point for queuing.
SET ZTRTN=RTN
+26 ;Output device for queuing.
SET ZTIO=ION
+27 ;Report title if queuing is selected.
SET ZTDESC=$GET(TITLE)
+28 ;All variables in memory for queuing.
SET ZTSAVE("*")=""
+29 ;Entry point for queuing.
DO ^%ZTLOAD
+30 ;flag
WRITE !,$SELECT($DATA(ZTQUEUED):"Request queued!",1:"Request cancelled!")
+31 SET Y='$DATA(ZTQUEUED)
+32 ;S IO variables back to device = screen.
DO HOME^%ZIS
+33 ;Use the currently open IO device
USE IO
DEVQ IF +$GET(MULTI)>0
Begin DoDot:1
+1 USE $PRINCIPAL
+2 NEW Y
+3 SET DCOPIES=0
+4 KILL DIR
+5 SET DIR(0)="NO^0:99999"
SET DIR("A")="NUMBER OF COPIES TO OUTPUT"
+6 SET DIR("B")=1
+7 DO ^DIR
KILL DIR
+8 IF +Y>0
SET DCOPIES=Y
+9 IF Y["^"
SET DCOPIES=-1
End DoDot:1
USE IO
+10 IF $GET(DCOPIES)<0
SET Y=0
+11 QUIT Y
+12 ;===================================================================
+1 ; This PROCEDURE accepts the routine name and titles and prints out a
+2 ; standard header with the run date and time,page and increments
+3 ; the page counter by 1. Page is initialized in function DEVICE.
+4 ; W @IOF if (to SCREEN) OR (to PRINTER after page 1)
+5 ; TITLE variable has special uses. I the calling routine
+6 ; send-in the TITLE-array (by setting TITLE(1)="LINE 1", TITLE(n)=
+7 ; "LINE n of title", and then D HEADER^WSHUTL("ROUTINE",.TITLE),"."),
+8 ; then the entire array of TITLE will be used (and TITLE2 will be
+9 ; ignored). You must send-in TITLE2="."
+10 ; RUNTIME has been added so that all pages of the report can
+11 ; have the same date.time. The calling report must send it in.
+12 ; NOFF (optional) - if it exists, then do NOT issue a FormFeed.
+13 ; This is necessary for reports that are controlled as a FileMan
+14 ; template... since FM issues its own FF, this routine should not.
+15 ; UL (opt) - is flag to print a 1-IOSL dashes after the header.
+16 ; DEFAULT is no-underline. S UL to 1 to print the underline.
+17 ;
+18 ; Note: PAGE is assumed to exist even though it is not passed in
+19 NEW X,N
+20 SET $Y=0
SET PAGE=$GET(PAGE)
+21 IF $EXTRACT(IOST,1)="C"!($EXTRACT(IOST,1)="P"&(PAGE>0))
IF '$DATA(NOFF)
WRITE @IOF
+22 SET PAGE=PAGE+1
+23 IF $GET(RUNTIME)=""
DO NOW^%DTC
SET Y=$EXTRACT(%,1,12)
XECUTE ^DD("DD")
SET RUNTIME=Y
+24 WRITE !,"RUN DATE: ",RUNTIME
+25 WRITE ?(IOM-10),"PAGE: ",$JUSTIFY(PAGE,3,0)
+26 IF $DATA(PROGRAM)
IF PROGRAM'=""
WRITE !,"PGM: ",PROGRAM
+27 IF $GET(TITLE2)'="."
Begin DoDot:1
+28 IF $DATA(TITLE1)
DO WCENTER^BPSOSU9(TITLE1)
+29 IF $DATA(TITLE2)
DO WCENTER^BPSOSU9(TITLE2)
End DoDot:1
+30 IF $GET(TITLE2)="."
Begin DoDot:1
+31 SET N=""
+32 FOR
SET N=$ORDER(TITLE1(N))
if N=""
QUIT
DO WCENTER^BPSOSU9($GET(TITLE1(N)))
End DoDot:1
+33 ;print dashes across the page
IF $GET(UL)=1
Begin DoDot:1
+34 WRITE !
+35 FOR I=1:1:$SELECT($GET(IOM)>0:IOM,1:80)
WRITE "-"
End DoDot:1
+36 WRITE !
+37 QUIT
+38 ;===================================================================
FMPAGE ;at end of page
+1 IF $$TOSCREEN^BPSOSU5
Begin DoDot:1
+2 DO PRESSANY^BPSOSU5()
End DoDot:1
QUIT
+3 IF IOST["P-"
WRITE @IOF
QUIT
+4 ; should we fall through to PAGE0?
+5 QUIT
+6 ;===================================================================
PAGE0 ; This checks the IO device and issues a pagefeed if $Y>0
+1 if '$GET(IO)
QUIT
+2 ;OPEN IO USE IO I $Y>0 USE IO W #
+3 USE IO
IF $Y>0
USE IO
WRITE #
+4 QUIT
+5 ;===================================================================
STANDBY ; W a message to screen to "Please Wait"
+1 USE $PRINCIPAL
DO WAIT^DICD
USE +$GET(IO)
+2 QUIT
+3 ;===================================================================
