PRCHHI6 ;WISC/TGH-IFCAP SEGMENT IT ;6/19/92  11:20 AM
V ;;5.1;IFCAP;;Oct 20, 2000
 ;Per VHA Directive 10-93-142, this routine should not be modified.
 ;;
 ;;THIS ROUTINE AT THE 'IT' ENTRY POINT CREATES ONE ITEM SEGMENT FOR
 ;;EACH ITEM IN THE P.O. TRANSACTION.
IT(VAR1,NUM) ;ITEMS INFORMATION SEGMENT
 N B,DC,DIS,I,I0,I2,I4,ITEM,LI,LIN,MPN,N,N1,N1L,N2,N2L,N3,N3L
 N NDC,NL,NSN,PDA,RP,TD,UP,UPN
 S (ITEM,ITEMCNT)=0,TOTAL=$P($G(^PRC(442,VAR1,2,0)),U,4)+7
 F  S ITEM=$O(^PRC(442,VAR1,2,ITEM)) Q:ITEM'>0  D
  .K PRCHTP1
  .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,4))
  .S PRCHTP1(0,20)="|IT"
  .S PRCHTP1(0,1)=$P(I0,U)
  .S PRCHTP1(0,2)=$P(I0,U,13)
  .S PRCHTP1(1,5)=$P(I0,U,4)
  .S RP=$P(I0,U,5)
  .S NSN=$P(I0,U,13),NSN=$TR(NSN,"-")
  .S MPN="" S:RP'="" MPN=$G(^PRC(441,RP,3))
  .S PRCHTP1(1,13)=$P(MPN,U,5)
  .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
  .S PRCHTP1(1,14)=N,NDC=N
  .S PRCHTP1(1,1)=$P(I0,U,2)\1
  .S UP=$P(I0,U,3),UPN="" S:UP'="" UPN=$G(^PRCD(420.5,UP,0))
  .S UNIT=$P(UPN,U)
  .S PRCHTP1(1,2)=UNIT
  .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
  .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
  .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_"^"
IT3  .S PRCHTP1(0,3)=$P(MPN,U,8)
  .S PRCHTP1(1,6)=$S($P(I4,U,15)]"":$P(I4,U,15),1:"N")
  .S PRCHTP1(1,7)=$S($P(I4,U,16)]"":$P(I4,U,16),1:"N")
  .S PRCHTP1(1,20)=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 ^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^|"