PRCPDAPB ;WISC/RFJ-drug accountability/prime vendor (build RILs)    ;15 Mar 94
 ;;5.1;IFCAP;;Oct 20, 2000
 ;Per VHA Directive 10-93-142, this routine should not be modified.
 Q
 ;
 ;
BUILDRIL ;  build repetitive item lists
 N %,DA,DATA,ITEMDA,LINEITEM,QTY,STCTRL,TOTAL,UNITCOST,X
 S STCTRL="" F  S STCTRL=$O(^TMP($J,"PRCPDAPV SET",STCTRL)) Q:STCTRL=""!($G(PRCPFLAG))  D
 .   S DA=+$$NEWRIL^PRCPAGPR(0,PRCPREPN) I 'DA K X S X(1)="SYSTEM ERROR - UNABLE TO ADD A NEW REPETITIVE ITEM LIST" D DISPLAY^PRCPUX2(1,80,.X) S PRCPFLAG=1 Q
 .   L +^PRCS(410.3,DA)
 .   S (LINEITEM,TOTAL)=0 F  S LINEITEM=$O(^TMP($J,"PRCPDAPV SET",STCTRL,"IT",LINEITEM)) Q:'LINEITEM  S DATA=^(LINEITEM) D
 .   .   S ITEMDA=+$P(DATA,"^",6),QTY=+$P(DATA,"^"),UNITCOST=+$P(DATA,"^",3),TOTAL=TOTAL+$J(QTY*UNITCOST,0,2)
 .   .   S %=$$ADDITEM^PRCPAGPR(DA,ITEMDA,QTY,PRCPVEND,UNITCOST)
 .   S $P(^PRCS(410.3,DA,0),"^",2)=TOTAL
 .   L -^PRCS(410.3,DA)
 .   W !,"* * * * *   R E P E T I T I V E   I T E M   L I S T : ",$P(^PRCS(410.3,DA,0),"^")
 .   S ^TMP($J,"PRCPDAPV SET",STCTRL,"RIL")=$P(^PRCS(410.3,DA,0),"^")
 Q