source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPUREP.m@ 1800

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

initial load of WorldVistAEHR

File size: 1.2 KB
RevLine 
[613]1PRCPUREP ;WISC/RFJ-printing report utilities ;14 Feb 92
2 ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7END ; end of report print information
8 I $D(PRCPFLAG) Q
9 I $D(DIOEND),$G(Y)="^" Q ;^ pressed in print template
10 N %,I,M S M=$S($G(IOM):IOM,1:80)-32 S %="",$P(%,"-",200)=""
11 I $D(PRCPDIOE) S I=0 F S I=$O(PRCPDIOE(I)) Q:'I W !,PRCPDIOE(I)
12 W:$X>2 ! W "[END OF REPORT]",$E(%,1,M),"[USER:",$E($$USER(DUZ),1,10)_"]"
13 I '$D(SCREEN) N SCREEN S SCREEN=$$SCRPAUSE
14 I SCREEN D R^PRCPUREP Q
15 W @IOF
16 Q
17 ;
18 ;
19SCRPAUSE() ; returns screen=1 for pause, 0 for no pause when
20 ; printing reports.
21 N Y S Y=0 I '$D(ZTQUEUED),IO=IO(0),$E(IOST)="C" S Y=1
22 Q Y
23 ;
24 ;
25USER(USERDUZ) ; return user name
26 Q $P($G(^VA(200,+USERDUZ,0)),"^")
27 ;
28 ;
29INITIALS(USERDUZ) ; returns initials
30 Q $P($G(^VA(200,+USERDUZ,0)),"^",2)
31 ;
32 ;
33KEY(KEY,USERDUZ) ; returns 1 for owner of key
34 S:KEY="" KEY=" "
35 Q $S($D(^XUSEC(KEY,+USERDUZ)):1,1:0)
36 ;
37 ;
38R ; press return to continue
39 N X U IO(0) W !,"<Press RETURN to continue>" R X:DTIME Q
40 ;
41 ;
42P ; pause
43 N X U IO(0) W !,"Press RETURN to continue, '^' to exit:" R X:DTIME S:'$T X="^" S:X["^" PRCPFLAG=1 U IO Q
Note: See TracBrowser for help on using the repository browser.