| [613] | 1 | PRCHCS6 ;WISC/RHD-BUILD LOG CODE SHEET DATA ;12/1/93 09:52
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | EN ;ISSUE REQUEST
|
|---|
| 5 | S PRCHTP(1,1)="57;5.2",PRCHTP(1,2)="59;305",PRCHTP(1,3)="58;333",PRCHTP(1,4)="S X=PRCHDPT;330",PRCHTP(1,5)="S X="_PRC("SITE")_";1"
|
|---|
| 6 | S PRCHTP(1,6)="S X="_PRCFA("TT")_";3"
|
|---|
| 7 | D CC S PRCHTP(1,7)="S X="_PRCHCC_";315",PRCHTP(1,8)="S X="""_PRCHCP_""";314"
|
|---|
| 8 | S PRCHTP(2,1)="2;302",PRCHTP(2,2)="S PRCHNSN=$P(PRCHI0,U,5),X=$P(PRCHNSN,""-"",2)_$P(PRCHNSN,""-"",3)_$P(PRCHNSN,""-"",4),X=X_$S($L(X)=9:"" "",1:"""");308",PRCHTP(2,3)="S X=$P(PRCH0,U,1);300"
|
|---|
| 9 | S PRCHTP(2,4)="3;303",PRCHTP(2,5)="S Y=$E($P(PRCHI0,U,2),1,21),PRCFLN=21 D RBF^PRCFU S X=Y;309",PRCHTP(2,6)="D DNSUB^PRCHCS6;331",PRCHTP(2,7)="D DNBO^PRCHCS6;332"
|
|---|
| 10 | Q
|
|---|
| 11 | CC S PRCHCC="""000000""" I PRCFA("TT")'=669,$D(^PRCS(410,PRCHR,3)),$P(^(3),U,3) S PRCHCC=+$P(^(3),U,3),PRCHCC=$S($D(^PRCD(420.1,PRCHCC,0)):PRCHCC,1:"""000000""")
|
|---|
| 12 | Q
|
|---|
| 13 | DNSUB S X=$P($G(^PRCP(445,+$P(^PRCS(410,PRCHR,0),U,6),1,+$P(^PRCS(410,PRCHR,"IT",PRCHLI,0),U,5),0)),U,18)
|
|---|
| 14 | Q
|
|---|
| 15 | DNBO S X=$P($G(^PRCP(445,+$P(^PRCS(410,PRCHR,0),U,6),1,+$P(^PRCS(410,PRCHR,"IT",PRCHLI,0),U,5),0)),U,13)
|
|---|
| 16 | Q
|
|---|
