source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHFPD1.m@ 1078

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

initial load of WorldVistAEHR

File size: 804 bytes
Line 
1PRCHFPD1 ;SF-ISC/KSS-FPDS REPORT FROM TEMPLATE W/0 FPDS DATA ;12-8-88/9:30 AM
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 K ^TMP("CN",$J) S (PRCHJ,PRCHT,PRCHCT)=0
5 F PRCHI=0:0 S PRCHJ=$O(^PRC(442,D0,9,PRCHJ)) Q:PRCHJ'>0 I $D(^(PRCHJ,0)) D S1
6 S PRCHCN=0 F PRCHI=0:0 S PRCHCN=$O(^TMP("CN",$J,PRCHCN)) Q:PRCHCN="" S PRCHCT=PRCHCT+1 W ?58,$S(PRCHCN="ZZZZ":"",1:PRCHCN),?73,$J(^TMP("CN",$J,PRCHCN),11,2),!
7 W:PRCHCT>1 ?73,"-----------",!,?73,$J(PRCHT,11,2)
8 K ^TMP("CN",$J),PRCHI,PRCHJ,PRCHCN,PRCHCT,PRCHAM,PRCHT,PRCHX
9 Q
10S1 S PRCHX=^PRC(442,D0,9,PRCHJ,0),PRCHAM=$P(PRCHX,U,1),PRCHCN=$S($P(PRCHX,U,3)'="":$P(PRCHX,U,3),1:"ZZZZ") S:'$D(^TMP("CN",$J,PRCHCN)) ^TMP("CN",$J,PRCHCN)=0 S ^TMP("CN",$J,PRCHCN)=^TMP("CN",$J,PRCHCN)+PRCHAM,PRCHT=PRCHT+PRCHAM
11 Q
Note: See TracBrowser for help on using the repository browser.