PRCBP1.m

PRCBP1 ;WISC/CTB-PRINT OPTIONS FOR RD 2-285 REPORTS ;5/3/93  9:39 AM

V ;;5.1;IFCAP;;Oct 20, 2000

 ;Per VHA Directive 10-93-142, this routine should not be modified.

OUT K %,%X,DP,IOX,IOY,PRCF Q

EN1 ;FIRST QUARTER

 S FLDS="[PRCB 285 1ST QTR]" D ALL,OUT Q

 ;

EN2 ;SECOND QUARTER

 S FLDS="[PRCB 285 2ND QTR]" D ALL,OUT Q

EN3 ;THIRD QUARTER

 S FLDS="[PRCB 285 3RD QTR]" D ALL,OUT Q

EN4 ;FOURTH QUARTER

 S FLDS="[PRCB 285 4TH QTR]" D ALL,OUT Q

EN5 ;OCTOBER - DECEMBER

 S FLDS="[PRCB 285 OCT-MAR]" D ALL,OUT Q

EN6 ;APRIL - SEPTEMBER

 S FLDS="[PRCB 285 APR-SEP]" D ALL,OUT Q

EN7 ;COMPLETE FISCAL YEAR

 S FLDS="[PRCB 285 FISCAL YEAR]" D ALL,OUT Q

ALL S PRCF("X")="ABFS" D ^PRCFSITE Q:'%

 D WAIT S FR=$O(^PRCF(421,"AJ",PRCF("SIFY"),0)) I FR="" W !,"NO TRANSACTIONS IN FY ",PRC("FY") Q

 S BY="[PRCB SORT BY SIFY/TDA]",FR=PRCF("SIFY"),TO=PRCF("SIFY"),DIC="^PRCF(421," D EN1^DIP Q

 Q

WAIT ;

 W !,"..."

 W $P("Whoops^Hmmm^Excuse me^Sorry","^",$R(4)+1),", "

 W $P($T(LIST+$R(6)),";",3)_"..."

LIST ;;This may take a few moments

 ;;Let me put you on 'HOLD' for a second

 ;;Hold on

 ;;Just a moment, please

 ;;I'm working as fast as I can

 ;;Let me think about this for a moment

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCBP1   1199     printed  Apr 09, 2024@21:03:35                                                                                                                                                                                                      Page 2

PRCBP1    ;WISC/CTB-PRINT OPTIONS FOR RD 2-285 REPORTS ;5/3/93  9:39 AM

V         ;;5.1;IFCAP;;Oct 20, 2000

 +1       ;Per VHA Directive 10-93-142, this routine should not be modified.

OUT        KILL %,%X,DP,IOX,IOY,PRCF

           QUIT 

EN1       ;FIRST QUARTER

 +1        SET FLDS="[PRCB 285 1ST QTR]"

           DO ALL

           DO OUT

           QUIT 

 +2       ;

EN2       ;SECOND QUARTER

 +1        SET FLDS="[PRCB 285 2ND QTR]"

           DO ALL

           DO OUT

           QUIT 

EN3       ;THIRD QUARTER

 +1        SET FLDS="[PRCB 285 3RD QTR]"

           DO ALL

           DO OUT

           QUIT 

EN4       ;FOURTH QUARTER

 +1        SET FLDS="[PRCB 285 4TH QTR]"

           DO ALL

           DO OUT

           QUIT 

EN5       ;OCTOBER - DECEMBER

 +1        SET FLDS="[PRCB 285 OCT-MAR]"

           DO ALL

           DO OUT

           QUIT 

EN6       ;APRIL - SEPTEMBER

 +1        SET FLDS="[PRCB 285 APR-SEP]"

           DO ALL

           DO OUT

           QUIT 

EN7       ;COMPLETE FISCAL YEAR

 +1        SET FLDS="[PRCB 285 FISCAL YEAR]"

           DO ALL

           DO OUT

           QUIT 

ALL        SET PRCF("X")="ABFS"

           DO ^PRCFSITE

           if '%

               QUIT 

 +1        DO WAIT

           SET FR=$ORDER(^PRCF(421,"AJ",PRCF("SIFY"),0))

           IF FR=""

               WRITE !,"NO TRANSACTIONS IN FY ",PRC("FY")

               QUIT 

 +2        SET BY="[PRCB SORT BY SIFY/TDA]"

           SET FR=PRCF("SIFY")

           SET TO=PRCF("SIFY")

           SET DIC="^PRCF(421,"

           DO EN1^DIP

           QUIT 

 +3        QUIT 

WAIT      ;

 +1        WRITE !,"..."

 +2        WRITE $PIECE("Whoops^Hmmm^Excuse me^Sorry","^",$RANDOM(4)+1),", "

 +3        WRITE $PIECE($TEXT(LIST+$RANDOM(6)),";",3)_"..."

LIST      ;;This may take a few moments

 +1       ;;Let me put you on 'HOLD' for a second

 +2       ;;Hold on

 +3       ;;Just a moment, please

 +4       ;;I'm working as fast as I can

 +5       ;;Let me think about this for a moment

 +6       ;