PRCPUREP ;WISC/RFJ-printing report utilities ;14 Feb 92
;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
END ; end of report print information
I $D(PRCPFLAG) Q
I $D(DIOEND),$G(Y)="^" Q ;^ pressed in print template
N %,I,M S M=$S($G(IOM):IOM,1:80)-32 S %="",$P(%,"-",200)=""
I $D(PRCPDIOE) S I=0 F S I=$O(PRCPDIOE(I)) Q:'I W !,PRCPDIOE(I)
W:$X>2 ! W "[END OF REPORT]",$E(%,1,M),"[USER:",$E($$USER(DUZ),1,10)_"]"
I '$D(SCREEN) N SCREEN S SCREEN=$$SCRPAUSE
I SCREEN D R^PRCPUREP Q
W @IOF
Q
;
;
SCRPAUSE() ; returns screen=1 for pause, 0 for no pause when
; printing reports.
N Y S Y=0 I '$D(ZTQUEUED),IO=IO(0),$E(IOST)="C" S Y=1
Q Y
;
;
USER(USERDUZ) ; return user name
Q $P($G(^VA(200,+USERDUZ,0)),"^")
;
;
INITIALS(USERDUZ) ; returns initials
Q $P($G(^VA(200,+USERDUZ,0)),"^",2)
;
;
KEY(KEY,USERDUZ) ; returns 1 for owner of key
S:KEY="" KEY=" "
Q $S($D(^XUSEC(KEY,+USERDUZ)):1,1:0)
;
;
R ; press return to continue
N X U IO(0) W !,"<Press RETURN to continue>" R X:DTIME Q
;
;
P ; pause
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPUREP 1253 printed Sep 23, 2025@19:52:21 Page 2
PRCPUREP ;WISC/RFJ-printing report utilities ;14 Feb 92
+1 ;;5.1;IFCAP;;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
END ; end of report print information
+1 IF $DATA(PRCPFLAG)
QUIT
+2 ;^ pressed in print template
IF $DATA(DIOEND)
IF $GET(Y)="^"
QUIT
+3 NEW %,I,M
SET M=$SELECT($GET(IOM):IOM,1:80)-32
SET %=""
SET $PIECE(%,"-",200)=""
+4 IF $DATA(PRCPDIOE)
SET I=0
FOR
SET I=$ORDER(PRCPDIOE(I))
if 'I
QUIT
WRITE !,PRCPDIOE(I)
+5 if $X>2
WRITE !
WRITE "[END OF REPORT]",$EXTRACT(%,1,M),"[USER:",$EXTRACT($$USER(DUZ),1,10)_"]"
+6 IF '$DATA(SCREEN)
NEW SCREEN
SET SCREEN=$$SCRPAUSE
+7 IF SCREEN
DO R^PRCPUREP
QUIT
+8 WRITE @IOF
+9 QUIT
+10 ;
+11 ;
SCRPAUSE() ; returns screen=1 for pause, 0 for no pause when
+1 ; printing reports.
+2 NEW Y
SET Y=0
IF '$DATA(ZTQUEUED)
IF IO=IO(0)
IF $EXTRACT(IOST)="C"
SET Y=1
+3 QUIT Y
+4 ;
+5 ;
USER(USERDUZ) ; return user name
+1 QUIT $PIECE($GET(^VA(200,+USERDUZ,0)),"^")
+2 ;
+3 ;
INITIALS(USERDUZ) ; returns initials
+1 QUIT $PIECE($GET(^VA(200,+USERDUZ,0)),"^",2)
+2 ;
+3 ;
KEY(KEY,USERDUZ) ; returns 1 for owner of key
+1 if KEY=""
SET KEY=" "
+2 QUIT $SELECT($DATA(^XUSEC(KEY,+USERDUZ)):1,1:0)
+3 ;
+4 ;
R ; press return to continue
+1 NEW X
USE IO(0)
WRITE !,"<Press RETURN to continue>"
READ X:DTIME
QUIT
+2 ;
+3 ;
P ; pause
+1 NEW X
USE IO(0)
WRITE !,"Press RETURN to continue, '^' to exit:"
READ X:DTIME
if '$TEST
SET X="^"
if X["^"
SET PRCPFLAG=1
USE IO
QUIT
