| [613] | 1 | PRCHRP4 ;WISC/KMB/CR-PC ORDERS READY FOR APPROVAL ;06/11/98 1:50 PM
|
|---|
| 2 | ;;5.1;IFCAP;**25**;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | START ;
|
|---|
| 5 | N APO,APO1,APO2,LN,PC1,I,LN,X,XX,PO,P,PA,F1,F2,USER,XUSER,F3,YY,Y,PDATE,VEND,RDATE,PC,USER,AMT,XXZ,EX,STATUS,ID,ZIP,AA,Z0,Z1,Z2,Z3,Z4,TIMDATE
|
|---|
| 6 | K ^TMP($J) W @IOF
|
|---|
| 7 | S PRCF("X")="S" D ^PRCFSITE Q:'$D(PRC("SITE"))
|
|---|
| 8 | Q:$G(X)="^"
|
|---|
| 9 | S %ZIS("B")="",%ZIS="MQ" D ^%ZIS Q:POP
|
|---|
| 10 | I $D(IO("Q")) S ZTRTN="DETAIL^PRCHRP4",ZTSAVE("PRC*")="" D ^%ZTLOAD,^%ZISC Q
|
|---|
| 11 | D DETAIL,^%ZISC Q
|
|---|
| 12 | ;
|
|---|
| 13 | DETAIL ;
|
|---|
| 14 | S APO=DUZ,CNT=0
|
|---|
| 15 | S XUSER="" F S XUSER=$O(^PRC(442,"MAPP",XUSER)) Q:XUSER="" D
|
|---|
| 16 | .S XX="" F S XX=$O(^PRC(442,"MAPP",XUSER,XX)) Q:XX="" D
|
|---|
| 17 | ..;Keep orders from different stations separate
|
|---|
| 18 | ..I $D(PRC("SITE")) Q:$P(^PRC(442,XX,0),"-",1)'=PRC("SITE")
|
|---|
| 19 | ..S (PC,PC1)=$P($G(^PRC(442,XX,23)),"^",8),PC=$P($G(^PRC(440.5,+PC,0)),"^") S:PC="" PC=0
|
|---|
| 20 | ..S F1=$G(^PRC(442,XX,0)),F2=$G(^PRC(442,XX,1)),F3=$G(^PRC(442,XX,2,1,1,1,0))
|
|---|
| 21 | ..;Get the approving official or alternate app. official
|
|---|
| 22 | ..S APO1=$P($G(^PRC(440.5,+PC1,0)),"^",9)
|
|---|
| 23 | ..I APO1'=DUZ S APO2=$P($G(^PRC(440.5,+PC1,0)),"^",10) Q:APO2=""
|
|---|
| 24 | ..S APO=$S(APO1=DUZ:DUZ,APO2=DUZ:DUZ,1:"")
|
|---|
| 25 | ..S:APO'="" APO=$P($G(^VA(200,APO,0)),"^")
|
|---|
| 26 | ..S USER=$P($G(^PRC(440.5,+PC1,0)),"^",8),USER=$P($G(^VA(200,+USER,0)),"^"),VEND=$P(F2,"^"),VEND=$P($G(^PRC(440,+VEND,0)),"^"),AMT=$P(F1,"^",15),VEND=$E(VEND,1,30)
|
|---|
| 27 | ..I VEND="SIMPLIFIED",$P($G(^PRC(442,XX,24)),"^",2)'="" S VEND=$P($G(^PRC(442,XX,24)),"^",2)
|
|---|
| 28 | ..Q:USER=""!(APO="")
|
|---|
| 29 | ..S PO=$P(F1,"^")
|
|---|
| 30 | ..S Y=$P(^PRC(442,XX,23),"^",19) D DD^%DT S RDATE=Y
|
|---|
| 31 | ..S (YY,Y)=$P(F2,"^",15) D DD^%DT S PDATE=Y
|
|---|
| 32 | ..S ^TMP($J,USER,-YY,APO,PC,PO)=PDATE_"^"_RDATE_"^"_PO_"^"_AMT_"^"_VEND
|
|---|
| 33 | ..S ^TMP($J,USER,-YY,APO,PC,PO,1)=$E(F3,1,45),CNT=$G(CNT)+1
|
|---|
| 34 | ;
|
|---|
| 35 | WRITE ;
|
|---|
| 36 | U IO S U="^"
|
|---|
| 37 | S X=DT D NOW^%DTC,YX^%DTC S TIMDATE=Y
|
|---|
| 38 | I '$D(^TMP($J)) S P=1,Z0="" D HEADER W !!!!,?10,"*** NO RECORDS TO PRINT ***" Q
|
|---|
| 39 | S (P,EX)=1,Z0=0 F S Z0=$O(^TMP($J,Z0)) Q:EX[U Q:Z0="" D
|
|---|
| 40 | .D HEADER
|
|---|
| 41 | .S Z1="" F S Z1=$O(^TMP($J,Z0,Z1)) Q:Z1="" Q:EX[U D
|
|---|
| 42 | ..S Z2="" F S Z2=$O(^TMP($J,Z0,Z1,Z2)) Q:Z2="" Q:EX[U D
|
|---|
| 43 | ...S Z3="" F S Z3=$O(^TMP($J,Z0,Z1,Z2,Z3)) Q:Z3="" Q:EX[U D
|
|---|
| 44 | ....S Z4="" F S Z4=$O(^TMP($J,Z0,Z1,Z2,Z3,Z4)) Q:Z4="" Q:EX[U D
|
|---|
| 45 | .....I (IOSL-$Y)<6 D HOLD Q:EX[U
|
|---|
| 46 | .....W ! S LN=^TMP($J,Z0,Z1,Z2,Z3,Z4)
|
|---|
| 47 | .....W !,$P(LN,"^"),?20,$P(LN,"^",2),?37,$P(LN,"^",3),?55,$J($P(LN,"^",4),0,2)
|
|---|
| 48 | .....W !,$P(LN,"^",5),?35,^TMP($J,Z0,Z1,Z2,Z3,Z4,1)
|
|---|
| 49 | .I $E(IOST)'="P",EX'["^" W !,"Press return to continue, '^' to exit: " R XXZ:DTIME S:XXZ["^" EX="^" S:'$T EX=U
|
|---|
| 50 | W !!,?10,"Total number of orders found: ",CNT
|
|---|
| 51 | K ^TMP($J),CNT
|
|---|
| 52 | QUIT
|
|---|
| 53 | ;
|
|---|
| 54 | HOLD G HEADER:$E(IOST)="P"!(IO'=IO(0)) W !,"Press return to continue, '^' to exit: " R XXZ:DTIME S:XXZ["^" EX="^" S:'$T EX=U D:EX'=U HEADER Q
|
|---|
| 55 | ;
|
|---|
| 56 | HEADER ;
|
|---|
| 57 | W @IOF
|
|---|
| 58 | W !,"PURCHASE CARD ORDERS READY FOR APPROVAL",?45,TIMDATE,?70,"PAGE ",P
|
|---|
| 59 | W !,"PO DATE",?20,"DATE RECONCILED",?37,"PO NUMBER",?55,"$AMT",!,?8,"VENDOR",?35,"DESCRIPTION"
|
|---|
| 60 | W ! F I=1:1:8 W "----------"
|
|---|
| 61 | W !,?20,"BUYER: ",Z0
|
|---|
| 62 | S P=P+1
|
|---|
| 63 | QUIT
|
|---|
