| [613] | 1 | PRCPAGP2 ;WISC/RFJ-autogen primary or whse order (build, reports) ;01 Dec 92
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | CONT ; continue auto-generation
|
|---|
| 8 | N DESCNSN,GNM,ITEMDA,PRCPDATA,PRCPRIL,PRCPRILN,TOTAL,VDA,VNM,Y
|
|---|
| 9 | ;
|
|---|
| 10 | D OPTIONAL^PRCPAGU1
|
|---|
| 11 | ;
|
|---|
| 12 | I $O(^TMP($J,"PRCPAG","OK",""))="" W !!,"NO ITEMS HAVE BEEN ORDERED !!"
|
|---|
| 13 | E W !!,"<<< Creating repetitive item list ..." D
|
|---|
| 14 | . S PRCPRIL=$$NEWRIL^PRCPAGPR(PRCP("I"),PRCPREPN) I 'PRCPRIL W !?5,"ERROR: UNABLE TO CREATE REPETITIVE ITEM LIST !" Q
|
|---|
| 15 | . S PRCPRILN=$P(PRCPRIL,"^",2),PRCPRIL=+PRCPRIL,TOTAL=0 W " Number: ",PRCPRILN
|
|---|
| 16 | . W !,"<<< Locking repetitive item list ..."
|
|---|
| 17 | . L +^PRCS(410.3,PRCPRIL)
|
|---|
| 18 | . D ADD^PRCPULOC(410.3,PRCPRIL,0,"Autogeneration")
|
|---|
| 19 | . W !,"<<< Adding ",TOTITEMS," items to repetitive item list ..."
|
|---|
| 20 | . S EACHONE=$$INPERCNT^PRCPUX2(TOTITEMS,"*",PRCP("RV1"),PRCP("RV0"))
|
|---|
| 21 | . S NUMBER=0,VNM="" F S VNM=$O(^TMP($J,"PRCPAG","OK",VNM)) Q:VNM="" S VDA=0 F S VDA=$O(^TMP($J,"PRCPAG","OK",VNM,VDA)) Q:'VDA D
|
|---|
| 22 | . . S GNM="" F S GNM=$O(^TMP($J,"PRCPAG","OK",VNM,VDA,GNM)) Q:GNM="" S DESCNSN="" F S DESCNSN=$O(^TMP($J,"PRCPAG","OK",VNM,VDA,GNM,DESCNSN)) Q:DESCNSN="" D
|
|---|
| 23 | . . . S ITEMDA=0 F S ITEMDA=$O(^TMP($J,"PRCPAG","OK",VNM,VDA,GNM,DESCNSN,ITEMDA)) Q:'ITEMDA S PRCPDATA=^(ITEMDA) D
|
|---|
| 24 | . . . . S NUMBER=NUMBER+1,LASTONE=$$SHPERCNT^PRCPUX2(NUMBER,EACHONE,"*",PRCP("RV1"),PRCP("RV0"))
|
|---|
| 25 | . . . . S Y=$$ADDITEM^PRCPAGPR(PRCPRIL,ITEMDA,$P(PRCPDATA,"^",11),VDA,$P(PRCPDATA,"^",14))
|
|---|
| 26 | . . . . I 'Y S ^TMP($J,"PRCPAG","ER",DESCNSN,ITEMDA)="UNABLE to add item to RIL: "_PRCPRILN Q
|
|---|
| 27 | . . . . S TOTAL=TOTAL+($P(PRCPDATA,"^",11)*$P(PRCPDATA,"^",14))
|
|---|
| 28 | . . S ^TMP($J,"PRCPAG","VO",VDA)=PRCPRILN
|
|---|
| 29 | . D QPERCNT^PRCPUX2(+$G(LASTONE),"*",PRCP("RV1"),PRCP("RV0"))
|
|---|
| 30 | . W !?10,"Total number of items : ",+$P($G(^PRCS(410.3,PRCPRIL,1,0)),"^",4),!?10,"Total cost (all items): $ ",$J(TOTAL,0,2) S $P(^PRCS(410.3,PRCPRIL,0),"^",2)=+$J(TOTAL,0,2)
|
|---|
| 31 | . S PRCSDA=PRCPRIL D CHECK^PRCSRIE1 K PRCSDA
|
|---|
| 32 | . W !!,"<<< Unlocking repetitive item list ..."
|
|---|
| 33 | . L -^PRCS(410.3,PRCPRIL)
|
|---|
| 34 | . D CLEAR^PRCPULOC(410.3,PRCPRIL,0)
|
|---|
| 35 | ;
|
|---|
| 36 | D REPORTS^PRCPAGU1
|
|---|
| 37 | Q
|
|---|
