| [613] | 1 | PRCOEDC ;WISC/DJM-IFCAP EDI ENTRY ROUTINE ;1/26/98 1330
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | NEW(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
|
|---|
