| [613] | 1 | PRCPRDI1 ;WISC/RFJ/DGL-update/print due-ins from 410,442 (build tmp) ; 5/3/00 12:43pm
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | DQ ; queue comes here
|
|---|
| 8 | N %,CONV,D,PRCPDAT0,PRCPDAT1,PRCPDAT3,PRCPDAT4,PRCPDAT7,PRCPDAT9,DUEIN,ITEMDA,L,L1,PARENT,PRCPCP,PRCPNO,PRCPPO,TRANDA,TRANNO,TRANSTRT,UPKG,UREC,VENDOR
|
|---|
| 9 | ;
|
|---|
| 10 | ; tmp($j,"prcprdi1-di",itemda,tranda)=tranno^qtyduein^u/r^pkg^conv
|
|---|
| 11 | ; tmp($j,"prcprdi1-ck",tranda)="" <- to mark transactions checked
|
|---|
| 12 | ; prcprdi1-no <- used temporary
|
|---|
| 13 | K ^TMP($J,"PRCPRDI1-DI"),^TMP($J,"PRCPRDI1-CK"),^TMP($J,"PRCPRDI1-NO")
|
|---|
| 14 | ;
|
|---|
| 15 | S TRANSTRT=PRC("SITE")_"-"_$E(PRCPDATE,2,3)_"-"_$P("2^2^2^3^3^3^4^4^4^1^1^1","^",+$E(PRCPDATE,4,5))
|
|---|
| 16 | S PRCPCP=0 F S PRCPCP=$O(^PRC(420,"AE",PRC("SITE"),PRCP("I"),PRCPCP)) Q:'PRCPCP S TRANNO=TRANSTRT_"-"_PRCPCP F S TRANNO=$O(^PRCS(410,"B",TRANNO)) Q:'TRANNO S TRANDA=+$O(^(TRANNO,0)) I TRANDA D
|
|---|
| 17 | . I $G(PRCPFUPD) L +^PRCS(410,TRANDA)
|
|---|
| 18 | . S ^TMP($J,"PRCPRDI1-CK",TRANDA)=""
|
|---|
| 19 | . S PRCPDAT0=$G(^PRCS(410,TRANDA,0)),PRCPDAT1=$G(^(1))
|
|---|
| 20 | . I PRCPDAT0=""!($P(PRCPDAT1,"^")'>PRCPDATE) L -^PRCS(410,TRANDA) Q
|
|---|
| 21 | . S PRCPDAT3=$G(^PRCS(410,TRANDA,3)),PRCPDAT4=$G(^(4)),PRCPDAT7=$G(^(7)),PRCPDAT9=$G(^(9))
|
|---|
| 22 | . I $P(PRCPDAT0,"^",6)=PRCP("I"),$P(PRCPDAT0,"^",2)="O",$P(PRCPDAT0,"^",4)>2,$P(PRCPDAT7,"^",6)]"",$S('$D(^PRC(443,TRANDA,0)):1,$P(^(0),"^",3)]"":1,1:0)
|
|---|
| 23 | . I '$T L -^PRCS(410,TRANDA) Q
|
|---|
| 24 | . ;
|
|---|
| 25 | . ; issue book (9;3 = date recd)
|
|---|
| 26 | . I $P(PRCPDAT0,"^",4)=5,$P(PRCPDAT9,"^",3) L -^PRCS(410,TRANDA) Q
|
|---|
| 27 | . I $P(PRCPDAT0,"^",4)=5,PRCP("DPTYPE")'="W",+PRCPWHSE'=0 D L -^PRCS(410,TRANDA) Q
|
|---|
| 28 | . . S L=0 F S L=$O(^PRCS(410,TRANDA,"IT",L)) Q:'L S D=$G(^(L,0)) I D'="" S ITEMDA=+$P(D,"^",5) I $D(^PRCP(445,PRCP("I"),1,ITEMDA,0)) D
|
|---|
| 29 | . . . S %=$$GETVEN^PRCPUVEN(PRCP("I"),ITEMDA,PRCPWHSE,1),UREC=$P(%,"^",2),UPKG=$P(%,"^",3),CONV=+$P(%,"^",4)
|
|---|
| 30 | . . . S DUEIN=$P(D,"^",2)-$P(D,"^",13) S:$P(D,"^",14)'="" DUEIN=0 S DUEIN=DUEIN*CONV
|
|---|
| 31 | . . . I DUEIN>0 S %=$P($G(^TMP($J,"PRCPRDI1-DI",ITEMDA,TRANDA)),"^",2),^TMP($J,"PRCPRDI1-DI",ITEMDA,TRANDA)=TRANNO_"^"_(%+DUEIN)_"^"_UREC_"^"_UPKG_"^"_CONV
|
|---|
| 32 | . ;
|
|---|
| 33 | . ; purchase order
|
|---|
| 34 | . S PRCPNO=$P(PRCPDAT4,"^",5) S:PRCPNO'="" PRCPNO=$O(^PRC(442,"C",PRCPNO,0)) S PARENT=$P($G(^PRCS(410,TRANDA,10)),"^",2) S:PARENT'="" PARENT=$O(^PRCS(410,"B",PARENT,0))
|
|---|
| 35 | . S L=0 F S L=$O(^PRCS(410,TRANDA,"IT",L)) Q:'L S D=$G(^(L,0)) I D'="" S ITEMDA=+$P(D,"^",5) I $D(^PRCP(445,PRCP("I"),1,ITEMDA,0)),'$D(^TMP($J,"PRCPRDI1-DI",ITEMDA,TRANDA)) D
|
|---|
| 36 | . . I PARENT K:$D(^TMP($J,"PRCPRDI1-DI",ITEMDA,PARENT)) ^(PARENT) S ^TMP($J,"PRCPRDI1-NO",ITEMDA,PARENT)="" ;split request, kill old
|
|---|
| 37 | . . I $D(^TMP($J,"PRCPRDI1-NO",ITEMDA,TRANDA)) Q ;split request
|
|---|
| 38 | . . ;
|
|---|
| 39 | . . ; purchase order
|
|---|
| 40 | . . I PRCPNO!($G(^PRC(442,+$P(D,"^",10),0))) S PRCPPO=$S(PRCPNO:PRCPNO,1:+$P(D,"^",10)) Q:+$G(^PRC(442,PRCPPO,7))=45 D Q
|
|---|
| 41 | . . . L:$G(PRCPFUPD) +^PRC(442,PRCPPO)
|
|---|
| 42 | . . . S %=$$GETVEN^PRCPUVEN(PRCP("I"),ITEMDA,+$P($G(^PRC(442,PRCPPO,1)),"^")_";PRC(440,",1),UREC=$P(%,"^",2),UPKG=$P(%,"^",3),CONV=+$P(%,"^",4)
|
|---|
| 43 | . . . S (L1,DUEIN)=0 F S L1=$O(^PRC(442,PRCPPO,2,"AE",ITEMDA,L1)) Q:L1="" I $D(^PRC(442,PRCPPO,2,L1,0)) S DUEIN=DUEIN+$P(^(0),"^",2)-$$RECD(PRCPPO,L1)
|
|---|
| 44 | . . . S DUEIN=DUEIN*CONV\1
|
|---|
| 45 | . . . I DUEIN>0 S ^TMP($J,"PRCPRDI1-DI",ITEMDA,TRANDA)=TRANNO_"^"_DUEIN_"^"_UREC_"^"_UPKG_"^"_CONV_"^"_PRCPPO
|
|---|
| 46 | . . . L -^PRC(442,PRCPPO)
|
|---|
| 47 | . . ;
|
|---|
| 48 | . . ; transaction 2237
|
|---|
| 49 | . . S %=$$GETVEN^PRCPUVEN(PRCP("I"),ITEMDA,+$P(PRCPDAT3,"^",4)_";PRC(440,",1),UREC=$P(%,"^",2),UPKG=$P(%,"^",3),CONV=+$P(%,"^",4)
|
|---|
| 50 | . . S DUEIN=$P(D,"^",2)*CONV\1,%=$P($G(^TMP($J,"PRCPRDI1-DI",ITEMDA,TRANDA)),"^",2),^TMP($J,"PRCPRDI1-DI",ITEMDA,TRANDA)=TRANNO_"^"_(%+DUEIN)_"^"_UREC_"^"_UPKG_"^"_CONV
|
|---|
| 51 | . L -^PRCS(410,TRANDA)
|
|---|
| 52 | K ^TMP($J,"PRCPRDI1-NO")
|
|---|
| 53 | ;
|
|---|
| 54 | D PRINT^PRCPRDI2
|
|---|
| 55 | K ^TMP($J,"PRCPRDI1-DI"),^TMP($J,"PRCPRDI1-CK")
|
|---|
| 56 | Q
|
|---|
| 57 | ;
|
|---|
| 58 | ;
|
|---|
| 59 | RECD(PODA,LINEITEM) ; return qty received for poda and lineitem
|
|---|
| 60 | N %,D,PARTDATA,RECD
|
|---|
| 61 | S (%,RECD)=0 F S %=$O(^PRC(442,PODA,2,LINEITEM,3,%)) Q:'% S D=$G(^(%,0)),PARTDATA=$G(^PRC(442,PODA,11,+$P(D,"^",4),0)) I $P(PARTDATA,"^",17)'="" S RECD=RECD+$P(D,"^",2)
|
|---|
| 62 | Q $S(RECD<0:0,1:RECD)
|
|---|
