Routine: PRCPUREP

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.

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

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  Apr 09, 2024@21:11:32                                                                                                                                                                                                    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

PRCPUREP.m