| 1 | PRCHHI2 ;WISC/TGH-IFCAP SEGMENT BI ;10/2/92 4:15 PM
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | BI(A,A2,VAR1,CNTR,NUM) ;BILL TO INFORMATION SEGMENT
|
|---|
| 5 | N IA,STRNG,ZIP
|
|---|
| 6 | S PRCHSITE=+$P(A,U),A12=$G(^PRC(442,VAR1,12))
|
|---|
| 7 | S IA=+$P(A12,U,6)
|
|---|
| 8 | S PRCHINV=$G(^PRC(411,PRCHSITE,4,IA,0))
|
|---|
| 9 | S PRCHTP(1,CNTR+1)="S X=""|BI"";513"
|
|---|
| 10 | S PRCHTP(1,CNTR+2)="S X=PRCHSITE;513.1"
|
|---|
| 11 | S PRCHTP(1,CNTR+3)="S X=$P(PRCHINV,U);513.2"
|
|---|
| 12 | S PRCHTP(1,CNTR+4)="S X=$P(PRCHINV,U,2);513.3"
|
|---|
| 13 | S PRCHTP(1,CNTR+5)="S X=$P(PRCHINV,U,3);513.4"
|
|---|
| 14 | S PRCHTP(1,CNTR+6)="S X=$P(PRCHINV,U,4);513.5"
|
|---|
| 15 | S PRCHTP(1,CNTR+7)="S X=$P(PRCHINV,U,5);513.7"
|
|---|
| 16 | S PRCHST=$G(^DIC(5,+$P(PRCHINV,U,6),0))
|
|---|
| 17 | S ZIP=$P(PRCHINV,U,7)
|
|---|
| 18 | I ZIP]"",ZIP'?.N N B,I S B="" D S ZIP=B
|
|---|
| 19 | .F I=1:1:$L(ZIP) S:$E(ZIP,I)?1N B=B_$E(ZIP,I)
|
|---|
| 20 | .Q
|
|---|
| 21 | S PRCHTP(1,CNTR+8)="S X=$P(PRCHST,U,2);513.8"
|
|---|
| 22 | S PRCHTP(1,CNTR+9)="S X=$P(PRCHINV,U,7);513.9"
|
|---|
| 23 | S STRNG="BI"_"^"_$P(PRCHINV,U,8)_"^"_$P(PRCHINV,U,1,4)_"^^^^^"_$P(PRCHINV,U,5)_"^"_$P(PRCHST,U,2)_"^"_ZIP_"^|"
|
|---|
| 24 | S NUM=NUM+1,^TMP($J,"STRING",NUM)=STRNG
|
|---|
| 25 | S CNTR=CNTR+9
|
|---|
| 26 | Q
|
|---|
