| 1 | BPSOSU8 ;BHAM ISC/FCS/DRS/FLS - utilities ;06/01/2004 | 
|---|
| 2 | ;;1.0;E CLAIMS MGMT ENGINE;**1,5**;JUN 2004;Build 45 | 
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified. | 
|---|
| 4 | ;*** Collection of FSI UTILITIES *** | 
|---|
| 5 | ; | 
|---|
| 6 | ;EOPQ(LINES,PARAM,Xcode) - Return 0 to continue, 1 to quit. | 
|---|
| 7 | ;PAUSE() Return 1 to continue, 0 to stop. | 
|---|
| 8 | ;ENDRPT() | 
|---|
| 9 | ;DEVICE(DEV,RTN,TITLE,MULTI) S up a device, 1 if successful, 0 not. | 
|---|
| 10 | ;HEADER(PROGRAM,TITLE1,TITLE2,RUNTIME,NOFF,UL) Procedure call | 
|---|
| 11 | ;CENTER | 
|---|
| 12 | ;UNDERLINE | 
|---|
| 13 | ;REPLICATE | 
|---|
| 14 | ;FMPAGE() Handle the screen or printer for an FM print report. | 
|---|
| 15 | ;PAGE0 | 
|---|
| 16 | ;STANDBY | 
|---|
| 17 | ;====================================================================== | 
|---|
| 18 | EOPQ(LINESBOT,PARAM,EOPXCODE) ;EP - | 
|---|
| 19 | ; IN: LINESBOT = (optional) # of LINES from bottom (IOSL) before | 
|---|
| 20 | ;               determining what to do next.  I this is a CRT, we | 
|---|
| 21 | ;               will ask user whether to continue; for printers, just | 
|---|
| 22 | ;               continue.  DEFAULT=6 | 
|---|
| 23 | ;     PARAM    = List of parameter codes (each may occur): | 
|---|
| 24 | ;                "M" - Will display "-- More --" at bottom. | 
|---|
| 25 | ;     EOPXCODE = xecutable code that will occur if this is the | 
|---|
| 26 | ;                end of the page (like, D HEADER^ROU). | 
|---|
| 27 | ; | 
|---|
| 28 | ; OUT: 0 if not end of page, OR if we're EOP but we're continuing; | 
|---|
| 29 | ;      1 if user wants to quit. | 
|---|
| 30 | ; May call this as DO in some cases (like a little trailer on report) | 
|---|
| 31 | ; | 
|---|
| 32 | N X,Y,%,DIR | 
|---|
| 33 | ; | 
|---|
| 34 | I '$G(IOSL) Q 0  ;if we don't know page length, then not at end | 
|---|
| 35 | S LINESBOT=$S($G(LINESBOT):LINESBOT,1:6) | 
|---|
| 36 | I ($Y+LINESBOT)<IOSL Q 0  ;not at end of page | 
|---|
| 37 | ; -- Okay, we're at end of page | 
|---|
| 38 | I $G(PARAM)["M" W !,?($S($G(IOM):IOM,1:80)-12),"-- More --" | 
|---|
| 39 | ; | 
|---|
| 40 | I '$$PAUSE Q 1  ;user wants out | 
|---|
| 41 | X $G(EOPXCODE) | 
|---|
| 42 | ; | 
|---|
| 43 | Q 0 | 
|---|
| 44 | ;====================================================================== | 
|---|
| 45 | PAUSE() ;3/31/93 | 
|---|
| 46 | ;END of screen... should we continue? | 
|---|
| 47 | ;I $E(IOST,1)'="C" | 
|---|
| 48 | I '$$TOSCREEN^BPSOSU5 Q 1 | 
|---|
| 49 | K DIR | 
|---|
| 50 | S DIR(0)="E" D ^DIR | 
|---|
| 51 | Q Y  ;Y=1 to continue, 0 to quit. | 
|---|
| 52 | ;=================================================================== | 
|---|
| 53 | ENDRPT() ;EP - end of report.  Pause until user presses return (or timeout) | 
|---|
| 54 | I '$$TOSCREEN^BPSOSU5 W:$Y @IOF Q 1 | 
|---|
| 55 | I $G(FLGSTOP) W !," <escape>" | 
|---|
| 56 | N DIR,X,Y | 
|---|
| 57 | S DIR(0)="E" | 
|---|
| 58 | S DIR("A")="  -- END OF REPORT --  (Press <ENTER> to return to menu)" | 
|---|
| 59 | D ^DIR | 
|---|
| 60 | Q Y | 
|---|
| 61 | ;=================================================================== | 
|---|
| 62 | DEVICE(DEV,RTN,TITLE,MULTI) ;EP | 
|---|
| 63 | ;Select an output device. | 
|---|
| 64 | ;No parameters are required.  DEV can be set alone, or if queuing | 
|---|
| 65 | ;  set to variables needed for queuing. | 
|---|
| 66 | ;   DEV   - DEFAULT device, "HOME" if undefined. | 
|---|
| 67 | ;   RTN   - Routine name if queuing is selected. | 
|---|
| 68 | ;   TITLE - Description for the task log if queuing is selected. | 
|---|
| 69 | ;   MULTI - I then ask NUMBER OF COPIES, which sets the variable | 
|---|
| 70 | ;           DCOPIES that the calling routine should use. | 
|---|
| 71 | ;Return 1 if successful, 0 if not.  Also returns DCOPIES to number of | 
|---|
| 72 | ;  copies if MULTI parameter is set. | 
|---|
| 73 | ;Examples: Q:'$$DEVICE^ABSBUU01("STANDARD") | 
|---|
| 74 | ; | 
|---|
| 75 | ;       Q:'$$DEVICE^ABSBUU01("PC;132;66","EN^WSHLC","CORRECTION LIST") | 
|---|
| 76 | ;       note: D ^%ZISC to close the device after printing is done. | 
|---|
| 77 | N I,Y,%ZIS,POP,ZTRTN,ZTIO,ZTDESC,ZTSAVE,ZTQUEUED,PAGE | 
|---|
| 78 | W !! | 
|---|
| 79 | S ZTSAVE("PAGE")="" | 
|---|
| 80 | I $D(RTN) S %ZIS="QM" ; Ask if queuing is allowed only if RTN is set. | 
|---|
| 81 | S %ZIS("A")="Send report to device: " ;PROMPT | 
|---|
| 82 | S %ZIS("B")=$S($D(DEV):DEV,1:"HOME") ;DEFAULT device | 
|---|
| 83 | D ^%ZIS ;Input/Output variables. | 
|---|
| 84 | I POP W "   try again later" S Y=0 G DEVQ  ;Device success flag | 
|---|
| 85 | S PAGE=0 | 
|---|
| 86 | I '$D(IO("Q")) U IO S Y=1 G DEVQ ;Queuing not selected | 
|---|
| 87 | S ZTRTN=RTN ;Routine entry point for queuing. | 
|---|
| 88 | S ZTIO=ION ;Output device for queuing. | 
|---|
| 89 | S ZTDESC=$G(TITLE) ;Report title if queuing is selected. | 
|---|
| 90 | S ZTSAVE("*")="" ;All variables in memory for queuing. | 
|---|
| 91 | D ^%ZTLOAD ;Entry point for queuing. | 
|---|
| 92 | W !,$S($D(ZTQUEUED):"Request queued!",1:"Request cancelled!") ;flag | 
|---|
| 93 | S Y='$D(ZTQUEUED) | 
|---|
| 94 | D HOME^%ZIS ;S IO variables back to device = screen. | 
|---|
| 95 | U IO ;Use the currently open IO device | 
|---|
| 96 | DEVQ I +$G(MULTI)>0 D  USE IO | 
|---|
| 97 | . USE $P | 
|---|
| 98 | . N Y | 
|---|
| 99 | . S DCOPIES=0 | 
|---|
| 100 | . K DIR | 
|---|
| 101 | . S DIR(0)="NO^0:99999",DIR("A")="NUMBER OF COPIES TO OUTPUT" | 
|---|
| 102 | . S DIR("B")=1 | 
|---|
| 103 | . D ^DIR K DIR | 
|---|
| 104 | . I +Y>0 S DCOPIES=Y | 
|---|
| 105 | . I Y["^" S DCOPIES=-1 | 
|---|
| 106 | I $G(DCOPIES)<0 S Y=0 | 
|---|
| 107 | Q Y | 
|---|
| 108 | ;=================================================================== | 
|---|
| 109 | HEADER(PROGRAM,TITLE1,TITLE2,RUNTIME,NOFF,UL) ; | 
|---|
| 110 | ; This PROCEDURE accepts the routine name and titles and prints out a | 
|---|
| 111 | ; standard header with the run date and time,page and increments | 
|---|
| 112 | ; the page counter by 1.  Page is initialized in function DEVICE. | 
|---|
| 113 | ; W @IOF if (to SCREEN) OR (to PRINTER after page 1) | 
|---|
| 114 | ;    TITLE variable has special uses.  I the calling routine | 
|---|
| 115 | ; send-in the TITLE-array (by setting TITLE(1)="LINE 1", TITLE(n)= | 
|---|
| 116 | ; "LINE n of title", and then D HEADER^WSHUTL("ROUTINE",.TITLE),"."), | 
|---|
| 117 | ; then the entire array of TITLE will be used (and TITLE2 will be | 
|---|
| 118 | ; ignored).  You must send-in TITLE2="." | 
|---|
| 119 | ;    RUNTIME has been added so that all pages of the report can | 
|---|
| 120 | ; have the same date.time.  The calling report must send it in. | 
|---|
| 121 | ;    NOFF (optional) - if it exists, then do NOT issue a FormFeed. | 
|---|
| 122 | ; This is necessary for reports that are controlled as a FileMan | 
|---|
| 123 | ; template... since FM issues its own FF, this routine should not. | 
|---|
| 124 | ;    UL (opt) - is flag to print a 1-IOSL dashes after the header. | 
|---|
| 125 | ; DEFAULT is no-underline.  S UL to 1 to print the underline. | 
|---|
| 126 | ; | 
|---|
| 127 | ; Note: PAGE is assumed to exist even though it is not passed in | 
|---|
| 128 | N X,N | 
|---|
| 129 | S $Y=0,PAGE=$G(PAGE) | 
|---|
| 130 | I $E(IOST,1)="C"!($E(IOST,1)="P"&(PAGE>0)) I '$D(NOFF) W @IOF | 
|---|
| 131 | S PAGE=PAGE+1 | 
|---|
| 132 | I $G(RUNTIME)="" D NOW^%DTC S Y=$E(%,1,12) X ^DD("DD") S RUNTIME=Y | 
|---|
| 133 | W !,"RUN DATE: ",RUNTIME | 
|---|
| 134 | W ?(IOM-10),"PAGE: ",$J(PAGE,3,0) | 
|---|
| 135 | I $D(PROGRAM),PROGRAM'="" W !,"PGM:  ",PROGRAM | 
|---|
| 136 | I $G(TITLE2)'="." DO | 
|---|
| 137 | . I $D(TITLE1) D WCENTER^BPSOSU9(TITLE1) | 
|---|
| 138 | . I $D(TITLE2) D WCENTER^BPSOSU9(TITLE2) | 
|---|
| 139 | I $G(TITLE2)="." DO | 
|---|
| 140 | . S N="" | 
|---|
| 141 | . F  S N=$O(TITLE1(N)) Q:N=""  D WCENTER^BPSOSU9($G(TITLE1(N))) | 
|---|
| 142 | I $G(UL)=1 D  ;print dashes across the page | 
|---|
| 143 | . W ! | 
|---|
| 144 | . FOR I=1:1:$S($G(IOM)>0:IOM,1:80) W "-" | 
|---|
| 145 | W ! | 
|---|
| 146 | Q | 
|---|
| 147 | ;=================================================================== | 
|---|
| 148 | FMPAGE ;at end of page | 
|---|
| 149 | I $$TOSCREEN^BPSOSU5 D  Q | 
|---|
| 150 | . D PRESSANY^BPSOSU5() | 
|---|
| 151 | I IOST["P-" W @IOF Q | 
|---|
| 152 | ; should we fall through to PAGE0? | 
|---|
| 153 | Q | 
|---|
| 154 | ;=================================================================== | 
|---|
| 155 | PAGE0 ; This checks the IO device and issues a pagefeed if $Y>0 | 
|---|
| 156 | Q:'$G(IO) | 
|---|
| 157 | ;OPEN IO USE IO I $Y>0 USE IO W # | 
|---|
| 158 | U IO I $Y>0 U IO W # | 
|---|
| 159 | Q | 
|---|
| 160 | ;=================================================================== | 
|---|
| 161 | STANDBY ;  W a message to screen to "Please Wait" | 
|---|
| 162 | USE $P D WAIT^DICD USE +$G(IO) | 
|---|
| 163 | Q | 
|---|
| 164 | ;=================================================================== | 
|---|