| [613] | 1 | PRCOPHA1 ;WISC/DJM-IFCAP EDI PHA RE-TRANSMIT ROUTINE ; [8/11/98 9:42am]
|
|---|
| 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) S PRCOPODA=VAR1
|
|---|
| 5 | N A,A1,A12,CSDA,MO,PRC,PRCFA,PRCFASYS,PTSW,RECORD,REQUEST,SERVICE,TEST,TOTAL,VEN,V1,V2,V3,V4,V5,YR,XMZ
|
|---|
| 6 | S A=$G(^PRC(442,VAR1,0)) S:A="" VAR2="NPO0" Q:A="" S PRC("SITE")=$P($P(A,U),"-"),YR=$E(DT,2,3),MO=$E(DT,4,5)
|
|---|
| 7 | S PRC("FY")=$E(100+$S(+MO>9:YR+1,1:YR),2,3)
|
|---|
| 8 | 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
|
|---|
| 9 | S A1=$G(^PRC(442,VAR1,1)) S:A1="" VAR2="NPO1" Q:A1="" Q:$P(A1,U,7)=1
|
|---|
| 10 | K ^TMP($J,"STRING") S VAR2="",A12=$G(^PRC(442,VAR1,12)) I A12]"" G:$P(A12,U,10)>0 EXIT
|
|---|
| 11 | S $P(A12,U,10)=999999999,^PRC(442,VAR1,12)=A12
|
|---|
| 12 | D HE^PRCOE3(VAR1,.VAR2) G:VAR2]"" EXIT
|
|---|
| 13 | D BI^PRCOE1(A,VAR1,.VAR2) G:VAR2]"" EXIT
|
|---|
| 14 | D VE^PRCOE1(A1,.VAR2) G:VAR2]"" EXIT
|
|---|
| 15 | D ST^PRCOE1(A,A1,VAR1,.VAR2) G:VAR2]"" EXIT
|
|---|
| 16 | D MI^PRCOE3(VAR1,.VAR2) G:VAR2]"" EXIT
|
|---|
| 17 | D AC^PRCOE4(A,A1,VAR1,.VAR2) G:VAR2]"" EXIT
|
|---|
| 18 | S TOTAL="" D IT^PRCOE2(VAR1,.VAR2,.TOTAL) G:VAR2]"" EXIT
|
|---|
| 19 | D CO^PRCOE3(VAR1,.VAR2,.TOTAL) G:VAR2]"" EXIT
|
|---|
| 20 | S IEN=$S($P($G(^PRC(442,VAR1,23)),U,7):$P(^(23),U,7),1:PRC("SITE"))
|
|---|
| 21 | S PTSW=$P($G(^PRC(411,IEN,9)),U,4)
|
|---|
| 22 | S V1=PRC("SITE"),V2="PHA",V3=$P($P(A,U),"-")_$P($P(A,U),"-",2),V4=$S(PTSW="T":"EDT",1:"EDP"),V5=200
|
|---|
| 23 | D TRANSMIT^PRCPSMCS(V1,V2,V3,V4,V5,1) S XMZ=$O(PRCPXMZ(0)) I XMZ>0 S $P(^PRC(442,VAR1,12),U,10)=PRCPXMZ(XMZ)
|
|---|
| 24 | S VAR2="OK ^ MAIL MESSAGE NO. = "_PRCPXMZ(XMZ)
|
|---|
| 25 | ;
|
|---|
| 26 | ; NOW LETS UPDATE THE ENTRY IN FILE 443.75.
|
|---|
| 27 | ;
|
|---|
| 28 | S V1=$P(A,U)
|
|---|
| 29 | S V2="PHA"
|
|---|
| 30 | S V3=PRCPXMZ(XMZ)
|
|---|
| 31 | S V4=$P($G(^PRC(440,$P(A1,U),3)),U,3)
|
|---|
| 32 | S V5=$P(A1,U,10)
|
|---|
| 33 | S V6=VAR1
|
|---|
| 34 | D ENTER^PRCOEDI(V1,V2,V3,V4,V5,V6)
|
|---|
| 35 | ;
|
|---|
| 36 | EXIT K ^TMP($J,"STRING") Q
|
|---|
