source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHCS6.m@ 619

Last change on this file since 619 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.1 KB
Line 
1PRCHCS6 ;WISC/RHD-BUILD LOG CODE SHEET DATA ;12/1/93 09:52
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4EN ;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
11CC 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
13DNSUB 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
15DNBO 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
Note: See TracBrowser for help on using the repository browser.