| [613] | 1 | PRCPDAP2 ;WISC/RFJ-drug accountability/prime vendor (check items) ;15 Mar 94
|
|---|
| 2 | ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | PRINT ; print items on invoice
|
|---|
| 8 | ; prcpferr=1 for errors, do not create repetitive item lists
|
|---|
| 9 | N X
|
|---|
| 10 | K X S X(1)="Enter the device which will be used to print the items on the invoice, any errors with the items, and the repetitive item list number if created." D DISPLAY^PRCPUX2(5,60,.X)
|
|---|
| 11 | S %ZIS="Q" D ^%ZIS Q:POP I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK Q
|
|---|
| 12 | . S ZTDESC="Prime Vendor Invoice Upload Report",ZTRTN="DQ^PRCPDAP2"
|
|---|
| 13 | . S ZTSAVE("PRC*")="",ZTSAVE("^TMP($J,")="",ZTSAVE("ZTREQ")="@"
|
|---|
| 14 | W !!,"<*> please wait <*>"
|
|---|
| 15 | DQ ; queue starts here
|
|---|
| 16 | N %,%H,%I,DA,DATA,INVDATA,ITEMDA,LINEITEM,NOW,PAGE,PRCPFLAG,QTY,SCREEN,STCTRL,TOTAL,TOTCOST,UNITCOST,VENDA,VENDATA,WHODATA,X,Y
|
|---|
| 17 | D NOW^%DTC S Y=% D DD^%DT S NOW=Y,PAGE=1,SCREEN=$$SCRPAUSE^PRCPUREP U IO
|
|---|
| 18 | S STCTRL="" F S STCTRL=$O(^TMP($J,"PRCPDAPV SET",STCTRL)) Q:STCTRL=""!($G(PRCPFLAG)) D
|
|---|
| 19 | . D H^PRCPDAP3
|
|---|
| 20 | . I $G(^TMP($J,"PRCPDAPV SET",STCTRL,"E")) K X S X(1)="THERE ARE ERRORS WITH THIS INVOICE WHICH NEED CORRECTING BEFORE THE REPETITVE ITEM LIST CAN BE CREATED." D DISPLAY^PRCPUX2(1,80,.X)
|
|---|
| 21 | . S INVDATA=$G(^TMP($J,"PRCPDAPV SET",STCTRL,"IN"))
|
|---|
| 22 | . W !!,"INVOICE : ",$P(INVDATA,"^",2),?40,"DATE: ",$$DATE($P(INVDATA,"^"))
|
|---|
| 23 | . W !,"PURCHASE ORDER: ",$P(INVDATA,"^",4),?40,"DATE: ",$$DATE($P(INVDATA,"^",3))
|
|---|
| 24 | . W !?5,"PRIME VENDOR: ",$P($G(^PRC(440,PRCPVEND,0)),"^")
|
|---|
| 25 | . W !?5,"TERMS DISCOUNT PERCENT: ",$P(INVDATA,"^",6),?40,"DUE DATE: ",$$DATE($P(INVDATA,"^",7)),?60,"DAYS DUE: ",$P(INVDATA,"^",8)
|
|---|
| 26 | . W !?5,"TERMS DISCOUNT AMOUNT : ",$J($P(INVDATA,"^",11),0,2),?40,"DUE DATE: ",$$DATE($P(INVDATA,"^",9)),?60,"NET DAYS: ",$P(INVDATA,"^",10),!
|
|---|
| 27 | . W !?5,"DELIVERY DATE REQUESTED: ",$$DATE($P(INVDATA,"^",12))
|
|---|
| 28 | . W !?5,"DELIVERED ON DATE : ",$$DATE($P(INVDATA,"^",13))
|
|---|
| 29 | . I $Y>(IOSL-8) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG) D H^PRCPDAP3
|
|---|
| 30 | . W !!?5,"BUYER INFORMATION: "
|
|---|
| 31 | . S WHODATA=$G(^TMP($J,"PRCPDAPV SET",STCTRL,"BY")) I WHODATA="" W "(SAME AS SHIPPING INFORMATION)"
|
|---|
| 32 | . E D WHO(WHODATA)
|
|---|
| 33 | . I $Y>(IOSL-8) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG) D H^PRCPDAP3
|
|---|
| 34 | . W !!?5,"SHIPPING INFORMATION: "
|
|---|
| 35 | . S WHODATA=$G(^TMP($J,"PRCPDAPV SET",STCTRL,"ST")) I WHODATA="" W "(SAME AS BUYER INFORMATION)"
|
|---|
| 36 | . E D WHO(WHODATA)
|
|---|
| 37 | . I $Y>(IOSL-8) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG) D H^PRCPDAP3
|
|---|
| 38 | . W !!?5,"DISTRIBUTER INFORMATION: "
|
|---|
| 39 | . S WHODATA=$G(^TMP($J,"PRCPDAPV SET",STCTRL,"DS")) D WHO(WHODATA)
|
|---|
| 40 | . I $Y>(IOSL-8) D:SCREEN P^PRCPUREP Q:$G(PRCPFLAG) D H^PRCPDAP3
|
|---|
| 41 | . D LINEITEM^PRCPDAP3
|
|---|
| 42 | Q
|
|---|
| 43 | ;
|
|---|
| 44 | ;
|
|---|
| 45 | DATE(DATE) ; convert date
|
|---|
| 46 | S %=$E(DATE,3,4)_"/"_$E(DATE,5,6)_"/"_$E(DATE,1,2)
|
|---|
| 47 | I $TR(%,"/")="" S %=""
|
|---|
| 48 | Q %
|
|---|
| 49 | ;
|
|---|
| 50 | ;
|
|---|
| 51 | WHO(WHODATA) ; show buyer, shipping, seller address information
|
|---|
| 52 | W !?8,"NAME: ",$P(WHODATA,"^"),?62,"ID: ",$P(WHODATA,"^",2)
|
|---|
| 53 | W !?8,"ADDR: ",$P(WHODATA,"^",3)
|
|---|
| 54 | W !?8,"CITY: ",$P(WHODATA,"^",4),?40,"STATE: ",$P(WHODATA,"^",5),?62,"ZIPCODE: ",$P(WHODATA,"^",6)
|
|---|
| 55 | Q
|
|---|
