| [613] | 1 | PRCVRRA ;WOIFO/AS-SEND RECEIVING REPORT ADJUSTMENT TO DYNAMED ; 01/24/05
|
|---|
| 2 | ;;5.1;IFCAP;**81**;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ; PO amendment
|
|---|
| 6 | ; Input: PRCVPO (PO number)
|
|---|
| 7 | ; PRCVADJ (Adjustment number from PRCHAV)
|
|---|
| 8 | ; Called from PRCHAM
|
|---|
| 9 | ;
|
|---|
| 10 | Q
|
|---|
| 11 | ENT(PRCVPO,PRCVADJ) ;
|
|---|
| 12 | N PRCV1,PRCV,PRCVCHG,PRCVFLD,PRCVNPO,PRCVAMD,PRCVNXT,PRCVALL,PRCVEXT
|
|---|
| 13 | N PRCVP,PRCVERR
|
|---|
| 14 | ; Get partial header information to PRCVEXT
|
|---|
| 15 | S PRCV1=0
|
|---|
| 16 | D GETS^DIQ(442,PRCVPO_",",".07;7;62","IE","PRCVP")
|
|---|
| 17 | S PRCVEXT=PRCVP(442,PRCVPO_",",62,"E")
|
|---|
| 18 | I PRCVEXT']"" S PRCVEXT=PRCVP(442,PRCVPO_",",.07,"E")
|
|---|
| 19 | S $P(PRCVEXT,"^",2)=PRCVP(442,PRCVPO_",",7,"I") ; delivery date
|
|---|
| 20 | ;
|
|---|
| 21 | D HEADER
|
|---|
| 22 | F S PRCV1=$O(^PRC(442,PRCVPO,2,PRCV1)) Q:'PRCV1 D
|
|---|
| 23 | . Q:'$D(^PRC(442,PRCVPO,2,PRCV1,3,PRCVADJ,0))
|
|---|
| 24 | . D ITEM^PRCV442A(PRCVPO,PRCV1,PRCVEXT,.PRCVERR)
|
|---|
| 25 | . I 'PRCVERR D
|
|---|
| 26 | .. D RR^PRCV442A(PRCVPO,PRCV1,PRCVADJ,.PRCVERR,1)
|
|---|
| 27 | .. I $D(^TMP("PRCV442A",$J,PRCVPO,PRCV1)) S $P(^(PRCV1),"^",14)=1
|
|---|
| 28 | D SEND
|
|---|
| 29 | K ^TMP("PRCV442A",$J)
|
|---|
| 30 | Q
|
|---|
| 31 | HEADER ;
|
|---|
| 32 | ; Get PO header information
|
|---|
| 33 | D PO^PRCV442A(PRCVPO)
|
|---|
| 34 | ; Change transaction type to RR Adjustment
|
|---|
| 35 | S $P(^TMP("PRCV442A",$J,PRCVPO),"^",2)=4
|
|---|
| 36 | Q
|
|---|
| 37 | SEND ;
|
|---|
| 38 | ; Do not send if no item collected
|
|---|
| 39 | Q:'$O(^TMP("PRCV442A",$J,PRCVPO,0))
|
|---|
| 40 | ; Adjustment signed date
|
|---|
| 41 | S $P(^TMP("PRCV442A",$J,PRCVPO),"^",7)=$P($G(^PRC(442,PRCVPO,6,PRCHAM,1)),"^",3)
|
|---|
| 42 | D EN^PRCVPOSD(PRCVPO)
|
|---|
| 43 | Q
|
|---|
