38 lines
2.1 KiB
Mathematica
38 lines
2.1 KiB
Mathematica
PRCPAGP2 ;WISC/RFJ-autogen primary or whse order (build, reports) ;01 Dec 92
|
|
V ;;5.1;IFCAP;;Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
Q
|
|
;
|
|
;
|
|
CONT ; continue auto-generation
|
|
N DESCNSN,GNM,ITEMDA,PRCPDATA,PRCPRIL,PRCPRILN,TOTAL,VDA,VNM,Y
|
|
;
|
|
D OPTIONAL^PRCPAGU1
|
|
;
|
|
I $O(^TMP($J,"PRCPAG","OK",""))="" W !!,"NO ITEMS HAVE BEEN ORDERED !!"
|
|
E W !!,"<<< Creating repetitive item list ..." D
|
|
. S PRCPRIL=$$NEWRIL^PRCPAGPR(PRCP("I"),PRCPREPN) I 'PRCPRIL W !?5,"ERROR: UNABLE TO CREATE REPETITIVE ITEM LIST !" Q
|
|
. S PRCPRILN=$P(PRCPRIL,"^",2),PRCPRIL=+PRCPRIL,TOTAL=0 W " Number: ",PRCPRILN
|
|
. W !,"<<< Locking repetitive item list ..."
|
|
. L +^PRCS(410.3,PRCPRIL)
|
|
. D ADD^PRCPULOC(410.3,PRCPRIL,0,"Autogeneration")
|
|
. W !,"<<< Adding ",TOTITEMS," items to repetitive item list ..."
|
|
. S EACHONE=$$INPERCNT^PRCPUX2(TOTITEMS,"*",PRCP("RV1"),PRCP("RV0"))
|
|
. 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
|
|
. . 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
|
|
. . . S ITEMDA=0 F S ITEMDA=$O(^TMP($J,"PRCPAG","OK",VNM,VDA,GNM,DESCNSN,ITEMDA)) Q:'ITEMDA S PRCPDATA=^(ITEMDA) D
|
|
. . . . S NUMBER=NUMBER+1,LASTONE=$$SHPERCNT^PRCPUX2(NUMBER,EACHONE,"*",PRCP("RV1"),PRCP("RV0"))
|
|
. . . . S Y=$$ADDITEM^PRCPAGPR(PRCPRIL,ITEMDA,$P(PRCPDATA,"^",11),VDA,$P(PRCPDATA,"^",14))
|
|
. . . . I 'Y S ^TMP($J,"PRCPAG","ER",DESCNSN,ITEMDA)="UNABLE to add item to RIL: "_PRCPRILN Q
|
|
. . . . S TOTAL=TOTAL+($P(PRCPDATA,"^",11)*$P(PRCPDATA,"^",14))
|
|
. . S ^TMP($J,"PRCPAG","VO",VDA)=PRCPRILN
|
|
. D QPERCNT^PRCPUX2(+$G(LASTONE),"*",PRCP("RV1"),PRCP("RV0"))
|
|
. 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)
|
|
. S PRCSDA=PRCPRIL D CHECK^PRCSRIE1 K PRCSDA
|
|
. W !!,"<<< Unlocking repetitive item list ..."
|
|
. L -^PRCS(410.3,PRCPRIL)
|
|
. D CLEAR^PRCPULOC(410.3,PRCPRIL,0)
|
|
;
|
|
D REPORTS^PRCPAGU1
|
|
Q
|