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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPAGP2 2234 printed Apr 09, 2024@21:13:44 Page 2
PRCPAGP2 ;WISC/RFJ-autogen primary or whse order (build, reports) ;01 Dec 92
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 QUIT
+3 ;
+4 ;
CONT ; continue auto-generation
+1 NEW DESCNSN,GNM,ITEMDA,PRCPDATA,PRCPRIL,PRCPRILN,TOTAL,VDA,VNM,Y
+2 ;
+3 DO OPTIONAL^PRCPAGU1
+4 ;
+5 IF $ORDER(^TMP($JOB,"PRCPAG","OK",""))=""
WRITE !!,"NO ITEMS HAVE BEEN ORDERED !!"
+6 IF '$TEST
WRITE !!,"<<< Creating repetitive item list ..."
Begin DoDot:1
+7 SET PRCPRIL=$$NEWRIL^PRCPAGPR(PRCP("I"),PRCPREPN)
IF 'PRCPRIL
WRITE !?5,"ERROR: UNABLE TO CREATE REPETITIVE ITEM LIST !"
QUIT
+8 SET PRCPRILN=$PIECE(PRCPRIL,"^",2)
SET PRCPRIL=+PRCPRIL
SET TOTAL=0
WRITE " Number: ",PRCPRILN
+9 WRITE !,"<<< Locking repetitive item list ..."
+10 LOCK +^PRCS(410.3,PRCPRIL)
+11 DO ADD^PRCPULOC(410.3,PRCPRIL,0,"Autogeneration")
+12 WRITE !,"<<< Adding ",TOTITEMS," items to repetitive item list ..."
+13 SET EACHONE=$$INPERCNT^PRCPUX2(TOTITEMS,"*",PRCP("RV1"),PRCP("RV0"))
+14 SET NUMBER=0
SET VNM=""
FOR
SET VNM=$ORDER(^TMP($JOB,"PRCPAG","OK",VNM))
if VNM=""
QUIT
SET VDA=0
FOR
SET VDA=$ORDER(^TMP($JOB,"PRCPAG","OK",VNM,VDA))
if 'VDA
QUIT
Begin DoDot:2
+15 SET GNM=""
FOR
SET GNM=$ORDER(^TMP($JOB,"PRCPAG","OK",VNM,VDA,GNM))
if GNM=""
QUIT
SET DESCNSN=""
FOR
SET DESCNSN=$ORDER(^TMP($JOB,"PRCPAG","OK",VNM,VDA,GNM,DESCNSN))
if DESCNSN=""
QUIT
Begin DoDot:3
+16 SET ITEMDA=0
FOR
SET ITEMDA=$ORDER(^TMP($JOB,"PRCPAG","OK",VNM,VDA,GNM,DESCNSN,ITEMDA))
if 'ITEMDA
QUIT
SET PRCPDATA=^(ITEMDA)
Begin DoDot:4
+17 SET NUMBER=NUMBER+1
SET LASTONE=$$SHPERCNT^PRCPUX2(NUMBER,EACHONE,"*",PRCP("RV1"),PRCP("RV0"))
+18 SET Y=$$ADDITEM^PRCPAGPR(PRCPRIL,ITEMDA,$PIECE(PRCPDATA,"^",11),VDA,$PIECE(PRCPDATA,"^",14))
+19 IF 'Y
SET ^TMP($JOB,"PRCPAG","ER",DESCNSN,ITEMDA)="UNABLE to add item to RIL: "_PRCPRILN
QUIT
+20 SET TOTAL=TOTAL+($PIECE(PRCPDATA,"^",11)*$PIECE(PRCPDATA,"^",14))
End DoDot:4
End DoDot:3
+21 SET ^TMP($JOB,"PRCPAG","VO",VDA)=PRCPRILN
End DoDot:2
+22 DO QPERCNT^PRCPUX2(+$GET(LASTONE),"*",PRCP("RV1"),PRCP("RV0"))
+23 WRITE !?10,"Total number of items : ",+$PIECE($GET(^PRCS(410.3,PRCPRIL,1,0)),"^",4),!?10,"Total cost (all items): $ ",$JUSTIFY(TOTAL,0,2)
SET $PIECE(^PRCS(410.3,PRCPRIL,0),"^",2)=+$JUSTIFY(TOTAL,0,2)
+24 SET PRCSDA=PRCPRIL
DO CHECK^PRCSRIE1
KILL PRCSDA
+25 WRITE !!,"<<< Unlocking repetitive item list ..."
+26 LOCK -^PRCS(410.3,PRCPRIL)
+27 DO CLEAR^PRCPULOC(410.3,PRCPRIL,0)
End DoDot:1
+28 ;
+29 DO REPORTS^PRCPAGU1
+30 QUIT
