source: FOIAVistA/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCOEDC.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 863 bytes
Line 
1PRCOEDC ;WISC/DJM-IFCAP EDI ENTRY ROUTINE ;1/26/98 1330
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4NEW(VAR1,VAR2) N A,A1,MO,RECORD,REQUEST,SERVICE,YR
5 S A=$G(^PRC(442,VAR1,0)) S:A="" VAR2="ERROR" W:A="" !,"NPO0 Zero node of record missing. Unable to check further." Q:A=""
6 S SERVICE=$P(A,U,12) I SERVICE>0 S RECORD=$G(^PRC(442,VAR1,13,SERVICE,0)) I RECORD]"" S REQUEST=$P(RECORD,U,9) Q:REQUEST=3
7 S PRC("SITE")=$P($P(A,U),"-"),YR=$E(DT,2,3),MO=$E(DT,4,5)
8 S PRC("FY")=$E(100+$S(+MO>9:YR+1,1:YR),2,3)
9 S A1=$G(^PRC(442,VAR1,1)) S:A1="" VAR2="ERROR" W:A1="" !,"NPO1 Node 1 missing in record." Q:A1="" Q:$P(A1,U,7)=1
10 D HE^PRCOEC3(VAR1,.VAR2)
11 D BI^PRCOEC1(A,VAR1,.VAR2)
12 D VE^PRCOEC1(A1,.VAR2)
13 D ST^PRCOEC1(A,A1,VAR1,.VAR2)
14 D MI^PRCOEC3(VAR1,.VAR2)
15 D AC^PRCOEC1(A1,VAR1,.VAR2)
16 D IT^PRCOEC2(VAR1,.VAR2)
17 Q
Note: See TracBrowser for help on using the repository browser.