source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPSMPI.m@ 1226

Last change on this file since 1226 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.1 KB
RevLine 
[613]1PRCPSMPI ;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 ;
7DQ(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
Note: See TracBrowser for help on using the repository browser.