43 lines
1.9 KiB
Mathematica
43 lines
1.9 KiB
Mathematica
PRCHHI10 ;WISC/TGH-IFCAP SEGMENT DL - ('RC1' Partial's) ;6/19/92 11:25 AM
|
|
V ;;5.1;IFCAP;;Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
;;
|
|
DL(VAR1,PRCHPAR,NUM) ;Prism delivery Order Line
|
|
Q:'$D(^PRC(442,VAR1,2,"AB",PRCHPAR))
|
|
N A2,A3,DAT,DESCLN,NSN,PART,SKU,X,Y,I0,I2,I4,ITEM,BLANKS,LP,PRCHLINO,PRCHLIFI,PRCHLITM,PRCHDESC,PRCHDESP,PRCHDELE
|
|
S (ITEM,ITEMCNT,PART)=0,TOTAL=$P($G(^PRC(442,VAR1,2,0)),U,4)+7
|
|
S A2=2,A3="DE"
|
|
F S ITEM=$O(^PRC(442,VAR1,2,"AB",PRCHPAR,ITEM)) Q:ITEM="" D
|
|
.F S PART=$O(^PRC(442,VAR1,2,"AB",PRCHPAR,ITEM,PART)) Q:PART="" D
|
|
..S I0=$G(^PRC(442,VAR1,2,ITEM,0))
|
|
..S I2=$G(^PRC(442,VAR1,2,ITEM,2))
|
|
..S I4=$G(^PRC(442,VAR1,2,ITEM,3,PART,0))
|
|
..S X=$P($P(I4,U),".") D JD^PRCFDLN S DAT=$E(X,1,3)+1700_$E(Y,1,3)
|
|
..S PRCHTP1(0,20)="|DL"
|
|
..S PRCHTP(1,18)=DAT ;DATE RECEIVED
|
|
..S PRCHTP(0,8)=$P(I4,U,2) ;QTY RECEIVED
|
|
..S PRCHTP1(0,2)=$P(I0,U,13) ;NSN
|
|
..S PRCHTP1(0,1)=$P(I0,U) ;ITEM LINE NO.
|
|
..S PRCHTP1(1,8)=$P(I2,U,2) ;CONTRACT #
|
|
..S PRCHTP1(1,10)=0
|
|
..D
|
|
...N I,J S (I,J)=""
|
|
...;S $P(^PRCF(423,PRCFA("CSDA"),52,0),U,3,4)=$P(^PRC(442,VAR1,2,0),U,3,4)
|
|
...F S I=$O(PRCHTP1(I)) Q:I="" F S J=$O(PRCHTP1(I,J)) Q:J="" D
|
|
....;S $P(^PRCF(423,PRCFA("CSDA"),52,ITEM,I),U,J)=PRCHTP1(I,J)
|
|
....Q
|
|
...S NUM=NUM+1
|
|
...S NSN=$P(I0,U,13),NSN=$TR(NSN,"-")
|
|
...;AFTER DASHES ARE REMOVED FR NSN, PAD UPTO 20 SPACES W BLANKS
|
|
...I $L(NSN)<20 S NSN=NSN_" ",NSN=$E(NSN,1,20)
|
|
...;
|
|
...;LINE ITEM NUMBER'S FORMAT W LEADING ZEROS UPTO 3 DIGITS
|
|
...S PRCHLITM=$P(I0,U),PRCHLINO="00"_PRCHLITM
|
|
...S PRCHLINO=$E(PRCHLINO,$L(PRCHLINO)-2,99)
|
|
...;
|
|
...;#DE SEGMENT (DESCR LINE COUNT) FORMAT UPTO 3 CHARS. W LEADING ZEROS
|
|
...S PRCHDESC=$P(I2,U,4),PRCHDELE="00"_PRCHDESC
|
|
...I $D(PRCHDESC) S PRCHDESP=$E(PRCHDELE,$L(PRCHDELE)-2,99)
|
|
...;
|
|
...S ^TMP($J,"STRING",NUM)="DL"_"^"_DAT_"^"_$P(I4,U,2)_"^"_NSN_"^"_PRCHLINO_"^"_$P(I2,U,2)_"^^^^^^^^^^"_"STATUS^PRCHDESP^|"
|