source: WorldVistAEHR/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSOSU8.m@ 841

Last change on this file since 841 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 6.4 KB
Line 
1BPSOSU8 ;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 ;======================================================================
18EOPQ(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 ;======================================================================
45PAUSE() ;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 ;===================================================================
53ENDRPT() ;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 ;===================================================================
62DEVICE(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
96DEVQ 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 ;===================================================================
109HEADER(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 ;===================================================================
148FMPAGE ;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 ;===================================================================
155PAGE0 ; 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 ;===================================================================
161STANDBY ; W a message to screen to "Please Wait"
162 USE $P D WAIT^DICD USE +$G(IO)
163 Q
164 ;===================================================================
Note: See TracBrowser for help on using the repository browser.