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)" N DIR,X,Y S DIR(0)="E" S DIR("A")=" -- END OF REPORT -- (Press 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 ;=================================================================== HEADER(PROGRAM,TITLE1,TITLE2,RUNTIME,NOFF,UL) ; ; 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 ;===================================================================