PRCFFUA4 ;WISC/SJG-ROUTINE TO PROCESS OBLIGATIONS ;4/27/94  11:30
V ;;5.1;IFCAP;;Oct 20, 2000
 ;Per VHA Directive 10-93-142, this routine should not be modified.
 ;
 QUIT
 ;
ARRAY ; Determine items that changed on the amendment
 N LOOP,LINEITEM,FANDF,TYPE,N63
 K ITRAY S LOOP=0
 D GETBOC
ARR1 I FILE=442 F  S LOOP=$O(^PRC(442,+PO,6,PRCFAA,3,LOOP)) Q:LOOP=""!(LOOP'>0)  D
 .S N63=^PRC(442,+PO,6,PRCFAA,3,LOOP,0),TYPE=$P(N63,U,2),FANDF=$P(N63,U,3),LINEITEM=$P(^PRC(442,+PO,6,PRCFAA,3,LOOP,0),U,4)
 .I $P(FANDF,":",2)=40,("^21^23^"[("^"_TYPE_"^")) S ITRAY(LINEITEM)="" Q
 .I TYPE=22 S ITRAY("CANCEL",LINEITEM)="" Q
 .I ("^29^35^"[("^"_TYPE_"^")) S ITRAY("ESH")="" Q
 .Q
 I FILE=442&('$D(ITRAY)) S ITRAY("NOITEMS")=""
ARR2 I FILE=443.6 F  S LOOP=$O(^PRC(443.6,+PO,6,PRCFAA,3,LOOP)) Q:LOOP=""!(LOOP'>0)  D
 .S N63=^PRC(443.6,+PO,6,PRCFAA,3,LOOP,0),TYPE=$P(N63,U,2),FANDF=$P(N63,U,3),LINEITEM=$P(^PRC(443.6,+PO,6,PRCFAA,3,LOOP,0),U,4)
 .I $P(FANDF,":",2)=40,("^21^23^"[("^"_TYPE_"^")) S ITRAY(LINEITEM)="" Q
 .I TYPE=22 S ITRAY("CANCEL",LINEITEM)="" Q
 .I ("^29^35^"[("^"_TYPE_"^")) S ITRAY("ESH")="" Q
 .Q
 D CHKBOC
 I FILE=443.6&('$D(ITRAY)) S ITRAY("NOITEMS")=""
 Q
GETBOC ; Get ESHBOCs from original and amendment
 N FILEL
 F FILEL=442,443.6 D GENDIQ^PRCFFU7(FILEL,+PO,"13;13.05","IEN","")
 S OESHBOC=$G(PRCTMP(442,+PO,13.05,"I")),AESHBOC=$G(PRCTMP(443.6,+PO,13.05,"I"))
 Q 
CHKBOC ; Check BOCs
 I $G(PRCFA("RETRAN"))=0 D  Q
 .I OESHBOC]""&(AESHBOC]"") I OESHBOC'=AESHBOC D MSG11^PRCFFUA3 S FATAL=1 Q
 .I OESHBOC]""&(AESHBOC]"") I OESHBOC=AESHBOC K ITRAY("ESH") S FATAL=2
 .I OESHBOC=""&(AESHBOC]"") I FILE=443.6 S ITRAY("ESH")="",FATAL=2
 I $G(PRCFA("RETRAN"))=1 D
 .I $D(^PRC(443.6,+PO)) S FATAL=1 W ! D EN^DDIOL("An amendment exists for this Purchase Order - cannot rebuild and transmit!") W ! H 3 Q
 .I OESHBOC]""&(AESHBOC="") I $D(ITRAY("ESH")) S FATAL=2
 Q