source: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHHI10.m@ 1251

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

initial load of FOIAVistA 6/30/08 version

File size: 1.9 KB
Line 
1PRCHHI10 ;WISC/TGH-IFCAP SEGMENT DL - ('RC1' Partial's) ;6/19/92 11:25 AM
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;;
5DL(VAR1,PRCHPAR,NUM) ;Prism delivery Order Line
6 Q:'$D(^PRC(442,VAR1,2,"AB",PRCHPAR))
7 N A2,A3,DAT,DESCLN,NSN,PART,SKU,X,Y,I0,I2,I4,ITEM,BLANKS,LP,PRCHLINO,PRCHLIFI,PRCHLITM,PRCHDESC,PRCHDESP,PRCHDELE
8 S (ITEM,ITEMCNT,PART)=0,TOTAL=$P($G(^PRC(442,VAR1,2,0)),U,4)+7
9 S A2=2,A3="DE"
10 F S ITEM=$O(^PRC(442,VAR1,2,"AB",PRCHPAR,ITEM)) Q:ITEM="" D
11 .F S PART=$O(^PRC(442,VAR1,2,"AB",PRCHPAR,ITEM,PART)) Q:PART="" D
12 ..S I0=$G(^PRC(442,VAR1,2,ITEM,0))
13 ..S I2=$G(^PRC(442,VAR1,2,ITEM,2))
14 ..S I4=$G(^PRC(442,VAR1,2,ITEM,3,PART,0))
15 ..S X=$P($P(I4,U),".") D JD^PRCFDLN S DAT=$E(X,1,3)+1700_$E(Y,1,3)
16 ..S PRCHTP1(0,20)="|DL"
17 ..S PRCHTP(1,18)=DAT ;DATE RECEIVED
18 ..S PRCHTP(0,8)=$P(I4,U,2) ;QTY RECEIVED
19 ..S PRCHTP1(0,2)=$P(I0,U,13) ;NSN
20 ..S PRCHTP1(0,1)=$P(I0,U) ;ITEM LINE NO.
21 ..S PRCHTP1(1,8)=$P(I2,U,2) ;CONTRACT #
22 ..S PRCHTP1(1,10)=0
23 ..D
24 ...N I,J S (I,J)=""
25 ...;S $P(^PRCF(423,PRCFA("CSDA"),52,0),U,3,4)=$P(^PRC(442,VAR1,2,0),U,3,4)
26 ...F S I=$O(PRCHTP1(I)) Q:I="" F S J=$O(PRCHTP1(I,J)) Q:J="" D
27 ....;S $P(^PRCF(423,PRCFA("CSDA"),52,ITEM,I),U,J)=PRCHTP1(I,J)
28 ....Q
29 ...S NUM=NUM+1
30 ...S NSN=$P(I0,U,13),NSN=$TR(NSN,"-")
31 ...;AFTER DASHES ARE REMOVED FR NSN, PAD UPTO 20 SPACES W BLANKS
32 ...I $L(NSN)<20 S NSN=NSN_" ",NSN=$E(NSN,1,20)
33 ...;
34 ...;LINE ITEM NUMBER'S FORMAT W LEADING ZEROS UPTO 3 DIGITS
35 ...S PRCHLITM=$P(I0,U),PRCHLINO="00"_PRCHLITM
36 ...S PRCHLINO=$E(PRCHLINO,$L(PRCHLINO)-2,99)
37 ...;
38 ...;#DE SEGMENT (DESCR LINE COUNT) FORMAT UPTO 3 CHARS. W LEADING ZEROS
39 ...S PRCHDESC=$P(I2,U,4),PRCHDELE="00"_PRCHDESC
40 ...I $D(PRCHDESC) S PRCHDESP=$E(PRCHDELE,$L(PRCHDELE)-2,99)
41 ...;
42 ...S ^TMP($J,"STRING",NUM)="DL"_"^"_DAT_"^"_$P(I4,U,2)_"^"_NSN_"^"_PRCHLINO_"^"_$P(I2,U,2)_"^^^^^^^^^^"_"STATUS^PRCHDESP^|"
Note: See TracBrowser for help on using the repository browser.