| 1 | PRCHHI6 ;WISC/TGH-IFCAP SEGMENT IT ;6/19/92 11:20 AM
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;;
|
|---|
| 5 | ;;THIS ROUTINE AT THE 'IT' ENTRY POINT CREATES ONE ITEM SEGMENT FOR
|
|---|
| 6 | ;;EACH ITEM IN THE P.O. TRANSACTION.
|
|---|
| 7 | IT(VAR1,NUM) ;ITEMS INFORMATION SEGMENT
|
|---|
| 8 | N B,DC,DIS,I,I0,I2,I4,ITEM,LI,LIN,MPN,N,N1,N1L,N2,N2L,N3,N3L
|
|---|
| 9 | N NDC,NL,NSN,PDA,RP,TD,UP,UPN
|
|---|
| 10 | S (ITEM,ITEMCNT)=0,TOTAL=$P($G(^PRC(442,VAR1,2,0)),U,4)+7
|
|---|
| 11 | F S ITEM=$O(^PRC(442,VAR1,2,ITEM)) Q:ITEM'>0 D
|
|---|
| 12 | .K PRCHTP1
|
|---|
| 13 | .S I0=$G(^PRC(442,VAR1,2,ITEM,0))
|
|---|
| 14 | .S I2=$G(^PRC(442,VAR1,2,ITEM,2))
|
|---|
| 15 | .S I4=$G(^PRC(442,VAR1,2,ITEM,4))
|
|---|
| 16 | .S PRCHTP1(0,20)="|IT"
|
|---|
| 17 | .S PRCHTP1(0,1)=$P(I0,U)
|
|---|
| 18 | .S PRCHTP1(0,2)=$P(I0,U,13)
|
|---|
| 19 | .S PRCHTP1(1,5)=$P(I0,U,4)
|
|---|
| 20 | .S RP=$P(I0,U,5)
|
|---|
| 21 | .S NSN=$P(I0,U,13),NSN=$TR(NSN,"-")
|
|---|
| 22 | .S MPN="" S:RP'="" MPN=$G(^PRC(441,RP,3))
|
|---|
| 23 | .S PRCHTP1(1,13)=$P(MPN,U,5)
|
|---|
| 24 | .S N=$P(I0,U,15) I N]"" S N1=$P(N,"-"),N2=$P(N,"-",2),N3=$P(N,"-",3),N1="000000"_N1,N1L=$L(N1),N1=$E(N1,N1L-5,N1L),N2="0000"_N2,N2L=$L(N2),N2=$E(N2,N2L-3,N2L),N3="00"_N3,N3L=$L(N3),N3=$E(N3,N3L-1,N3L),N=N1_N2_N3
|
|---|
| 25 | .S PRCHTP1(1,14)=N,NDC=N
|
|---|
| 26 | .S PRCHTP1(1,1)=$P(I0,U,2)\1
|
|---|
| 27 | .S UP=$P(I0,U,3),UPN="" S:UP'="" UPN=$G(^PRCD(420.5,UP,0))
|
|---|
| 28 | .S UNIT=$P(UPN,U)
|
|---|
| 29 | .S PRCHTP1(1,2)=UNIT
|
|---|
| 30 | .S LIN=$P(I0,U),(DIS,TD)=0 F S DIS=$O(^PRC(442,VAR1,3,DIS)) G:DIS'>0 IT3 S DC=$G(^PRC(442,VAR1,3,DIS,0)),LI=$P(DC,U,6) Q:LIN=LI
|
|---|
| 31 | .S PDA=$P(DC,U,2) I $E(PDA,1)'="$" S TD=1,N=$P(PDA,"."),N1=$P(PDA,".",2),N="00"_N,NL=$L(N),N=$E(N,NL-1,NL),N1=N1_"00",N1=$E(N1,1,2),N=N_N1,B=B_N_"^^" G IT3
|
|---|
| 32 | .S TD=1,PDA=$E(PDA,2,99),N=$P(PDA,"."),N1=$P(PDA,".",2),N="0000000"_N,NL=$L(N),N=$E(N,NL-6,NL),N1=N1_"00",N1=$E(N1,1,2),N=N_N1,B=B_"^"_N_"^"
|
|---|
| 33 | IT3 .S PRCHTP1(0,3)=$P(MPN,U,8)
|
|---|
| 34 | .S PRCHTP1(1,6)=$S($P(I4,U,15)]"":$P(I4,U,15),1:"N")
|
|---|
| 35 | .S PRCHTP1(1,7)=$S($P(I4,U,16)]"":$P(I4,U,16),1:"N")
|
|---|
| 36 | .S PRCHTP1(1,20)=0
|
|---|
| 37 | .D
|
|---|
| 38 | ..N I,J S (I,J)=""
|
|---|
| 39 | ..;S $P(^PRCF(423,PRCFA("CSDA"),52,0),U,3,4)=$P(^PRC(442,VAR1,2,0),U,3,4)
|
|---|
| 40 | ..F S I=$O(PRCHTP1(I)) Q:I="" F S J=$O(PRCHTP1(I,J)) Q:J="" D
|
|---|
| 41 | ...;S $P(^PRCF(423,PRCFA("CSDA"),52,ITEM,I),U,J)=PRCHTP1(I,J) Q
|
|---|
| 42 | ..S NUM=NUM+1
|
|---|
| 43 | ..S ^TMP($J,"STRING",NUM)="IT"_"^"_$P(I0,U)_"^"_NSN_"^^^"_$P(MPN,U,5)_"^"_NDC_"^"_$P(I0,U,2)_"^"_UNIT_"^^^^^"_$P(MPN,U,8)_"^^"_$P(I0,U,4)_"^Y^N^^^0^|"
|
|---|
