| 1 | PRCPAGS2 ;WISC/RFJ-autogen secondary order (build, reports) ;01 Dec 92
|
|---|
| 2 | ;;5.1;IFCAP;**1**;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 D,DESCNSN,DISTDA,GNM,ITEMDA,PRCPERR,PRCPNOT,PRCPNOV,PRCPORD,VDA,VNM,X
|
|---|
| 9 | ;
|
|---|
| 10 | D OPTIONAL^PRCPAGU1
|
|---|
| 11 | ;
|
|---|
| 12 | I $O(^TMP($J,"PRCPAG","OK",""))="" D
|
|---|
| 13 | . W:'$D(PRCPSCHE) !!,"NO ITEMS HAVE BEEN ORDERED !!"
|
|---|
| 14 | . S:$D(PRCPSCHE) $P(PRCPSCHE,"^",2)=3
|
|---|
| 15 | E W !!,"<<< Building distribution orders ..." D
|
|---|
| 16 | . S 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
|
|---|
| 17 | . . W !?5,VNM
|
|---|
| 18 | . . D NEWORDER^PRCPOPUS(VDA) I '$G(X) D Q
|
|---|
| 19 | . . . W ?25,"Order NOT built, could not get next order number"
|
|---|
| 20 | . . . S:$D(PRCPSCHE) $P(PRCPSCHE,"^",2)=1
|
|---|
| 21 | . . S DISTDA=+$$ADDNEW^PRCPOPUS(X,VDA,PRCP("I"))
|
|---|
| 22 | . . S PRCPORD=$G(^PRCP(445.3,DISTDA,0)) I PRCPORD="" D Q
|
|---|
| 23 | . . . W ?25,"Order NOT built, could not add a new order"
|
|---|
| 24 | . . . S:$D(PRCPSCHE) $P(PRCPSCHE,"^",2)=2
|
|---|
| 25 | . . W ?25,"Order number: ",+PRCPORD
|
|---|
| 26 | . . S ^TMP($J,"PRCPAG","VO",VDA)=+PRCPORD I $G(PRCPFBAR) S ^TMP($J,"PRCPBAL3",DISTDA)=""
|
|---|
| 27 | . . 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
|
|---|
| 28 | . . . S X="",ITEMDA=0 F %=0:1 S ITEMDA=$O(^TMP($J,"PRCPAG","OK",VNM,VDA,GNM,DESCNSN,ITEMDA)) Q:'ITEMDA S X=ITEMDA,D=^(ITEMDA) D
|
|---|
| 29 | . . . . S ^PRCP(445.3,DISTDA,1,ITEMDA,0)=ITEMDA_"^"_$P(D,"^",11)_"^"_$P(D,"^",14)
|
|---|
| 30 | . . . . S ^PRCP(445.3,DISTDA,1,"B",ITEMDA,ITEMDA)=""
|
|---|
| 31 | . . . S ^PRCP(445.3,DISTDA,1,0)="^445.37PIA^"_X_"^"_%
|
|---|
| 32 | ;
|
|---|
| 33 | ; prcpfbar is set by the barcode upload programs to prevent printing
|
|---|
| 34 | ; the reports
|
|---|
| 35 | I '$G(PRCPFBAR),'$D(PRCPSCHE) D REPORTS^PRCPAGU1 K ^TMP($J,"PRCPBAL3")
|
|---|
| 36 | Q
|
|---|
