Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BPSOSU8

BPSOSU8.m

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