| 1 | PRCS0B ;WISC/PLT-UTILITY FOR PRCS-ROUTINE ; 12/19/94 1:53 PM
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | QUIT ;invalid entry
|
|---|
| 5 | ;
|
|---|
| 6 | ;PRCA data ^1=buyer station #, ^2=seller station #
|
|---|
| 7 | ;PRCB data ^1=buyer fcp #, ^2=seller fcp #
|
|---|
| 8 | ;PRCC= file 410 ri of buyer's issue book request
|
|---|
| 9 | ;PRCD data ^1=buyer's price, ^2=seller's price
|
|---|
| 10 | IB(PRCA,PRCB,PRCC,PRCD) ;post buyer's issue book request
|
|---|
| 11 | N PRC,PRCRI,PRCE,PRCF,PRCG,PRCH,PRCIS
|
|---|
| 12 | N A,B,C
|
|---|
| 13 | QUIT:$D(^PRCS(410,PRCC,0))#10=0 S PRCE=^(0),PRCRI("410A")=$P($G(^(445)),"^",4)
|
|---|
| 14 | S PRCRI(410)=PRCC,A=$P(PRCE,"^"),PRCG=A
|
|---|
| 15 | S PRC("SITE")=$P(A,"-"),PRC("FY")=$P(A,"-",2),PRC("QTR")=$P(A,"-",3),PRC("CP")=$P(A,"-",4)
|
|---|
| 16 | D ICLOCK^PRC0B("^PRCS(410,"_PRCRI(410)_",")
|
|---|
| 17 | S PRCE=$G(^PRCS(410,PRCRI(410),4)),PRCIS=$P($G(^(445)),"^")
|
|---|
| 18 | I $P(PRCE,"^",5)="" D EDIT^PRC0B(.X,"410;^PRCS(410,;"_PRCRI(410),"24////"_PRCIS)
|
|---|
| 19 | D:$P(PRCE,"^")'=$P(PRCD,"^")
|
|---|
| 20 | . D EDIT^PRC0B(.X,"410;^PRCS(410,;"_PRCRI(410),"27////"_$P(PRCD,"^"))
|
|---|
| 21 | . QUIT
|
|---|
| 22 | D:$P(PRCE,"^",3)'=$P(PRCD,"^")!($P(PRCE,"^",10)="")
|
|---|
| 23 | . D EDIT^PRC0B(.X,"410;^PRCS(410,;"_PRCRI(410),"22////"_$P(PRCD,"^"))
|
|---|
| 24 | . D ENCODE^PRCSC2(PRCRI(410),DUZ)
|
|---|
| 25 | . D ERS410^PRC0G(PRCRI(410)_"^O")
|
|---|
| 26 | . QUIT
|
|---|
| 27 | I PRCRI("410A"),$D(^PRCS(410,PRCRI("410A"),0))#10=0 S PRCRI("410A")=""
|
|---|
| 28 | I 'PRCRI("410A") D G:'PRCRI("410A") EXIT
|
|---|
| 29 | . S PRC("SITE")=$P(^PRC(420,+$P(PRCA,"^",2),0),"^")
|
|---|
| 30 | . S PRC("CP")=$P(^PRC(420,+PRC("SITE"),1,+$P(PRCB,"^",2),0)," ")
|
|---|
| 31 | . S Z=PRC("SITE")_"-"_PRC("FY")_"-"_PRC("QTR")_"-"_PRC("CP")
|
|---|
| 32 | . S X=$P(Z,"-",1,2)_"-"_$P(Z,"-",4)
|
|---|
| 33 | . D EN1^PRCSUT3 QUIT:X="" S PRCH=X
|
|---|
| 34 | . S PRC("BBFY")=$$BBFY^PRCSUT(PRC("SITE"),PRC("FY"),PRC("CP"),1)
|
|---|
| 35 | . S X=PRCH D EN2^PRCSUT3 QUIT:Y<1
|
|---|
| 36 | . S PRCRI("410A")=+Y
|
|---|
| 37 | . D EDIT^PRC0B(.X,"410;^PRCS(410,;"_PRCRI("410A"),"1////A;3////5;40////^S X=DUZ;26///^S X=""T"";447////"_PRCC_";28.5///^S X="_PRC("BBFY"))
|
|---|
| 38 | . S PRCF="410;^PRCS(410,;"_PRCRI("410A")_";60"
|
|---|
| 39 | . S PRCF=PRCF_"~410.05;^PRCS(410,"_PRCRI("410A")_",""CO"","
|
|---|
| 40 | . S X="Seller's adjustment for issue book request "_PRCG
|
|---|
| 41 | . D ADD^PRC0B1(.X,.Y,PRCF)
|
|---|
| 42 | . D EDIT^PRC0B(.X,"410;^PRCS(410,;"_PRCRI(410),"447////"_PRCRI("410A"))
|
|---|
| 43 | . QUIT
|
|---|
| 44 | D DCLOCK^PRC0B("^PRCS(410,"_PRCRI(410)_",")
|
|---|
| 45 | ;edit seller adjustment entry inf file 410
|
|---|
| 46 | S PRCRI(410)=PRCRI("410A")
|
|---|
| 47 | S PRCE=^PRCS(410,PRCRI(410),0),A=$P(PRCE,"^",1),PRC("BBFY")=$P($G(^(3)),"^",11)
|
|---|
| 48 | S PRC("SITE")=$P(A,"-"),PRC("FY")=$P(A,"-",2),PRC("QTR")=$P(A,"-",3),PRC("CP")=$P(A,"-",4)
|
|---|
| 49 | D ICLOCK^PRC0B("^PRCS(410,"_PRCRI(410)_",")
|
|---|
| 50 | S PRCE=$G(^PRCS(410,PRCRI(410),4))
|
|---|
| 51 | I $P(PRCE,"^",5)="" D EDIT^PRC0B(.X,"410;^PRCS(410,;"_PRCRI(410),"23///^S X=""T"";24////"_PRCIS),ERS410^PRC0G(PRCRI(410)_"^O")
|
|---|
| 52 | D:$P(PRCE,"^",6)'=$P(PRCD,"^",2)
|
|---|
| 53 | . D EDIT^PRC0B(.X,"410;^PRCS(410,;"_PRCRI(410),"25////"_(-$P(PRCD,"^",2)))
|
|---|
| 54 | . S $P(^PRCS(410,PRCRI(410),4),"^",8)=$P(PRCD,"^",2)
|
|---|
| 55 | D:$P(PRCE,"^",3)'=$P(PRCD,"^",2)
|
|---|
| 56 | . D EDIT^PRC0B(.X,"410;^PRCS(410,;"_PRCRI(410),"22////"_(-$P(PRCD,"^",2)))
|
|---|
| 57 | D DCLOCK^PRC0B("^PRCS(410,"_PRCRI(410)_",")
|
|---|
| 58 | EXIT QUIT
|
|---|
| 59 | ;
|
|---|
