| 1 | PRCPSMPI ;WISC/RFJ-issue code sheets to isms ;29 May 92
|
|---|
| 2 | ;;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(TRANNO,TRANID) ; create/trans issue code sheet to isms
|
|---|
| 8 | ; tranno=issue transaction number (full 5 pieces of '-')
|
|---|
| 9 | ; tranid=transaction register id
|
|---|
| 10 | N COUNT,DATA,ISSUCOST,ITEMDA,NSN,QTY,TRANREG,UI,VALUSOLD,VOUCHER
|
|---|
| 11 | ;
|
|---|
| 12 | ; start gathering items posted
|
|---|
| 13 | S COUNT=1 K ^TMP($J,"STRING")
|
|---|
| 14 | S TRANREG=0 F S TRANREG=$O(^PRCP(445.2,"C",TRANNO,TRANREG)) Q:'TRANREG S DATA=$G(^PRCP(445.2,TRANREG,0)) I DATA'="",$P(DATA,"^",2)=TRANID D
|
|---|
| 15 | . I '$D(VOUCHER) S VOUCHER=$P(DATA,"^",15)
|
|---|
| 16 | . S ITEMDA=+$P(DATA,"^",5),NSN=$TR($$NSN^PRCPUX1(ITEMDA),"-"),UI=$P($P(DATA,"^",6),"/",2)
|
|---|
| 17 | . S QTY=-$P(DATA,"^",7) I 'QTY Q
|
|---|
| 18 | . S VALUSOLD=-$TR($J($P(DATA,"^",22),0,2),"."),ISSUCOST=-$TR($J($P(DATA,"^",23),0,4),".")
|
|---|
| 19 | . S ^TMP($J,"STRING",COUNT)="IS^"_NSN_"^"_UI_"^"_QTY_"00^"_VALUSOLD_"^0^"_ISSUCOST_"^|",COUNT=COUNT+1
|
|---|
| 20 | I COUNT=1 Q
|
|---|
| 21 | ;
|
|---|
| 22 | ; prcpwait used in routine prcpsmsi when retransmitting
|
|---|
| 23 | ; isms code sheets
|
|---|
| 24 | I '$G(PRCPWAIT) D CODESHT^PRCPSMGO(PRC("SITE"),"ISS",VOUCHER)
|
|---|
| 25 | Q
|
|---|
