PRCSP1A1.m

PRCSP1A1 ;WISC/SAW-CONTROL POINT ACTIVITY PRINT OPTIONS CON'T ;7-16-91/12:32

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

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

DEV K IO("Q") S IOP="HOME" D ^%ZIS Q

DEV1 K IO("Q") S %ZIS("B")="HOME",%ZIS="MQ" D ^%ZIS Q

W1 W !!,"Would you like to run another running balances report" S %=2 D YN^DICN G W1:%=0 Q

W2 W !!,"You are not an authorized control point user.",!,"Contact your control point official." R X:5 G EXIT

W4 W !!,"Enter information for another report or an uparrow to return to the menu.",! Q

W I (IO=IO(0))&('$D(ZTQUEUED)) W !!,"Press return to continue:  " R X:DTIME

 I (IO'=IO(0))!($D(ZTQUEUED)) D ^%ZISC U IO

EXIT K %,%IS,%DT,BY,C0,C2,C3,D,D0,DA,DHD,DIC,DIE,P,PRCS,FLDS,FR,I,L,N,PRCZZ,T,TO,X,X1,Y,Z,Z1,ZTRTN,ZTSAVE Q

OAR ;OUTSTANDING REQUESTS REPORTS

 D EN6^PRCSUT G W2:'$D(PRC("SITE")),EXIT:Y<0

 N C1 S C1=$P(PRC("CP")," "),BY="@15,.01,@1,@48,44",FR=C1_" ,"_PRC("SITE")_"-"_"-,O,@",TO=C1_" ZZ,"_PRC("SITE")_"-"_PRC("FY")_"z,O,@,"_DT,FLDS="[PRCSOAR]"

 S L=0,DIC="^PRCS(410," D EN1^DIP W !,"End of report",! Q

SUBTOT ;BOC Detail Totals Report

 W !,"This report displays item costs from 2237 orders, sorted",!,"by budget object code.",!!

 D EN1^PRCSUT G W2:'$D(PRC("SITE")),EXIT:Y<0

 N PRCX S PRCX=PRC("SITE")_"-"_PRC("FY")_"-"_PRC("QTR")_"-"_$P(PRC("CP")," ")

 S DIS(0)="I $P($G(^PRCS(410,D0,0)),""-"",1,4)=PRCX"

 S L=0,DIC="^PRCS(410,",BY="[PRCSASRT]",FR=PRCX_"-0001,@",TO=PRCX_"-9999",FLDS="[PRCSSA]"

 D EN1^DIP

 N REPORT2 S REPORT2=1 D T2^PRCSAPP1 W !,"End of report",! Q

CPT ;STATUS OF OBLIGATION TRANSACTIONS

 D EN^PRCSUT G W2:'$D(PRC("SITE")),EXIT:Y<0 S PRCSZZ=PRC("SITE")_"-"_PRC("FY")_"-"_PRC("QTR")_"-"_$P(PRC("CP")," ")

 S FLDS="[PRCSCPT]",DHD="STATUS OF OBLIGATION TRANSACTIONS   CP: "_PRC("CP")_" FY: "_PRC("FY"),BY="@.01,@1",FR=PRCSZZ_"-0001,O",TO=PRCSZZ_"-9999,OZ" D S K PRC("CP"),PRCSZZ G CPT

S S L=0,DIC="^PRCS(410," D EN1^DIP Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCSP1A1   1935     printed  Apr 09, 2024@21:19:25                                                                                                                                                                                                    Page 2

PRCSP1A1  ;WISC/SAW-CONTROL POINT ACTIVITY PRINT OPTIONS CON'T ;7-16-91/12:32

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

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

DEV        KILL IO("Q")

           SET IOP="HOME"

           DO ^%ZIS

           QUIT 

DEV1       KILL IO("Q")

           SET %ZIS("B")="HOME"

           SET %ZIS="MQ"

           DO ^%ZIS

           QUIT 

W1         WRITE !!,"Would you like to run another running balances report"

           SET %=2

           DO YN^DICN

           if %=0

               GOTO W1

           QUIT 

W2         WRITE !!,"You are not an authorized control point user.",!,"Contact your control point official."

           READ X:5

           GOTO EXIT

W4         WRITE !!,"Enter information for another report or an uparrow to return to the menu.",!

           QUIT 

W          IF (IO=IO(0))&('$DATA(ZTQUEUED))

               WRITE !!,"Press return to continue:  "

               READ X:DTIME

 +1        IF (IO'=IO(0))!($DATA(ZTQUEUED))

               DO ^%ZISC

               USE IO

EXIT       KILL %,%IS,%DT,BY,C0,C2,C3,D,D0,DA,DHD,DIC,DIE,P,PRCS,FLDS,FR,I,L,N,PRCZZ,T,TO,X,X1,Y,Z,Z1,ZTRTN,ZTSAVE

           QUIT 

OAR       ;OUTSTANDING REQUESTS REPORTS

 +1        DO EN6^PRCSUT

           if '$DATA(PRC("SITE"))

               GOTO W2

           if Y<0

   Press return to continue:            GOTO EXIT

 +2        NEW C1

           SET C1=$PIECE(PRC("CP")," ")

           SET BY="@15,.01,@1,@48,44"

           SET FR=C1_" ,"_PRC("SITE")_"-"_"-,O,@"

           SET TO=C1_" ZZ,"_PRC("SITE")_"-"_PRC("FY")_"z,O,@,"_DT

           SET FLDS="[PRCSOAR]"

 +3        SET L=0

           SET DIC="^PRCS(410,"

           DO EN1^DIP

           WRITE !,"End of report",!

           QUIT 

SUBTOT    ;BOC Detail Totals Report

 +1        WRITE !,"This report displays item costs from 2237 orders, sorted",!,"by budget object code.",!!

 +2        DO EN1^PRCSUT

           if '$DATA(PRC("SITE"))

               GOTO W2

           if Y<0

               GOTO EXIT

 +3        NEW PRCX

           SET PRCX=PRC("SITE")_"-"_PRC("FY")_"-"_PRC("QTR")_"-"_$PIECE(PRC("CP")," ")

 +4        SET DIS(0)="I $P($G(^PRCS(410,D0,0)),""-"",1,4)=PRCX"

 +5        SET L=0

           SET DIC="^PRCS(410,"

           SET BY="[PRCSASRT]"

           SET FR=PRCX_"-0001,@"

           SET TO=PRCX_"-9999"

           SET FLDS="[PRCSSA]"

 +6        DO EN1^DIP

 +7        NEW REPORT2

           SET REPORT2=1

           DO T2^PRCSAPP1

           WRITE !,"End of report",!

           QUIT 

CPT       ;STATUS OF OBLIGATION TRANSACTIONS

 +1        DO EN^PRCSUT

           if '$DATA(PRC("SITE"))

               GOTO W2

           if Y<0

               GOTO EXIT

           SET PRCSZZ=PRC("SITE")_"-"_PRC("FY")_"-"_PRC("QTR")_"-"_$PIECE(PRC("CP")," ")

 +2        SET FLDS="[PRCSCPT]"

           SET DHD="STATUS OF OBLIGATION TRANSACTIONS   CP: "_PRC("CP")_" FY: "_PRC("FY")

           SET BY="@.01,@1"

           SET FR=PRCSZZ_"-0001,O"

           SET TO=PRCSZZ_"-9999,OZ"

           DO S

           KILL PRC("CP"),PRCSZZ

           GOTO CPT

S          SET L=0

           SET DIC="^PRCS(410,"

           DO EN1^DIP

           QUIT