| 1 | PRCSOUT ;WISC/KMB-OUTSTANDING APPROVED REQUESTS REPORT ;1-24-94 13:06
|
|---|
| 2 | ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | START ;
|
|---|
| 5 | N PAGE,XDA,I,J,LL,OUT,OUT1,LOOP,LOOP1,LOOP2,TODAY,TODAY1 S (OUT,OUT1,I)=1,(LOOP1,LOOP2,PAGE)=0
|
|---|
| 6 | S (OUT,OUT1,I)=1,(LOOP1,LOOP2,PAGE)=0
|
|---|
| 7 | W @IOF D EN1^PRCSUT G W1:'$D(PRC("SITE")),EXIT:Y<0
|
|---|
| 8 | PROCESS ;
|
|---|
| 9 | W @IOF D NOW^%DTC S TODAY=$P(%,"."),Y=% D DD^%DT S TODAY1=Y
|
|---|
| 10 | W !,"Processing entries...",!
|
|---|
| 11 | S LOOP=PRC("SITE")_"-"_PRC("FY")_"-"_PRC("QTR")_"-"_$P(PRC("CP")," "),LOOP1=LOOP_"-0000"
|
|---|
| 12 | F I=0:1 S LOOP1=$O(^PRCS(410,"B",LOOP1)) Q:$P(LOOP1,"-",1,4)'=LOOP D
|
|---|
| 13 | .S LOOP2=0 F S LOOP2=$O(^PRCS(410,"B",LOOP1,LOOP2)) Q:LOOP2="" S XDA=LOOP2 D
|
|---|
| 14 | ..N ZEROTH,FIRST,SECOND,THIRD,FOURTH,FIFTH,SIXTH
|
|---|
| 15 | ..S FIFTH=$P($G(^PRCS(410,XDA,1)),"^",4) Q:FIFTH>TODAY
|
|---|
| 16 | ..S FIRST=$P($G(^PRCS(410,XDA,7)),"^",5) Q:FIRST=""
|
|---|
| 17 | ..Q:$P($G(^PRCS(410,XDA,0)),"^",2)'["O"
|
|---|
| 18 | ..S ZEROTH=$P($G(^PRCS(410,XDA,0)),"^"),SECOND=$P($G(^PRCS(410,XDA,9)),"^",2),THIRD=$P($G(^PRCS(410,XDA,2)),"^",1),FOURTH=$P($G(^PRCS(410,XDA,4)),"^",4)
|
|---|
| 19 | ..S SIXTH=$P($G(^PRCS(410,XDA,4)),"^",5)
|
|---|
| 20 | ..S ^TMP($J,I)=FIRST_"*"_SECOND_"*"_THIRD_"*"_FOURTH_"*"_FIFTH_"*"_SIXTH_"*"_ZEROTH_"*"_XDA
|
|---|
| 21 | I '$D(^TMP($J)) U IO(0) W !,"No outstanding transactions found for this quarter.",! G START
|
|---|
| 22 | WRITE ;
|
|---|
| 23 | S %ZIS("B")="HOME",%ZIS="MQ" D ^%ZIS G EXIT:POP
|
|---|
| 24 | S ZTSAVE("PRC*")="",ZTSAVE("OUT")="",ZTSAVE("I")="",ZTSAVE("TODAY1")="",ZTSAVE("PAGE")=""
|
|---|
| 25 | I IO'=IO(0) S OUT1=0
|
|---|
| 26 | I $D(IO("Q")) S ZTDESC="REQUEST REPORT",ZTRTN="WRITE1^PRCSOUT",ZTSAVE("OUT1")="",ZTSAVE("DA")="",ZTSAVE("^TMP($J,")="",ZTSAVE("D0")="" D ^%ZTLOAD D ^%ZISC,EXIT,WRITE2 G START
|
|---|
| 27 | D WRITE1 D ^%ZISC,EXIT,WRITE2 G START
|
|---|
| 28 | WRITE1 ;
|
|---|
| 29 | U IO D HEADER F K=1:1:I-1 I $G(^TMP($J,K))'="" D
|
|---|
| 30 | .Q:OUT=U D:IOSL-($Y#IOSL)<6 HOLD Q:OUT=U
|
|---|
| 31 | .W !,?2,$P(^TMP($J,K),"*",7)
|
|---|
| 32 | .S D0=$P(^TMP($J,K),"*",8) D:D0'="" STATUS^PRCSES W ?22,$E(X,1,25)
|
|---|
| 33 | .W ?50,$E($P(^TMP($J,K),"*",3),1,30)
|
|---|
| 34 | .W ! S Y=$P(^TMP($J,K),"*") D DD^%DT W Y
|
|---|
| 35 | .S Y=$P(^TMP($J,K),"*",2) D DD^%DT W ?15,Y
|
|---|
| 36 | .W ?35,$P(^TMP($J,K),"*",6)
|
|---|
| 37 | .S Y=$P(^TMP($J,K),"*",4) D DD^%DT W ?50,Y
|
|---|
| 38 | .S Y=$P(^TMP($J,K),"*",5) D DD^%DT W ?65,Y
|
|---|
| 39 | I $D(ZTSK) D KILL^%ZTLOAD K ZTSK
|
|---|
| 40 | Q
|
|---|
| 41 | WRITE2 ;
|
|---|
| 42 | U IO(0) W !!,"------------------",!,"End of processing",! H 2 Q
|
|---|
| 43 | W1 W !!,"You are not an authorized control point user.",!,"Please contact your control point official." R I:5 G EXIT
|
|---|
| 44 | HEADER ;
|
|---|
| 45 | S PAGE=PAGE+1
|
|---|
| 46 | I PAGE'=1 W @IOF
|
|---|
| 47 | W !,"OUTSTANDING APPROVED REQUEST REPORT - CP ",$P(PRC("CP")," "),?49,TODAY1,?72,"PAGE ",PAGE
|
|---|
| 48 | W !!,"TRANSACTION NUMBER",?22,"TRANSACTION STATUS",?50,"VENDOR"
|
|---|
| 49 | W !,"DATE SIGNED",?15,"EST. DEL. DATE",?35,"PO #",?50,"DATE OBL.",?65,"DATE REQ."
|
|---|
| 50 | S LL="",$P(LL,"-",IOM)="-" W !,LL S LL="" Q
|
|---|
| 51 | HOLD ;
|
|---|
| 52 | G HEADER:IO'=IO(0),HEADER:$D(ZTQUEUED) W !,"Press return to continue, uparrow (^) to exit: " R OUT:100 S:'$T OUT=U D:OUT'=U HEADER Q
|
|---|
| 53 | EXIT K ^TMP($J),PRCS Q
|
|---|
