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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCFFUA4 1901 printed Sep 23, 2025@19:40:03 Page 2
PRCFFUA4 ;WISC/SJG-ROUTINE TO PROCESS OBLIGATIONS ;4/27/94 11:30
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 ;
+3 QUIT
+4 ;
ARRAY ; Determine items that changed on the amendment
+1 NEW LOOP,LINEITEM,FANDF,TYPE,N63
+2 KILL ITRAY
SET LOOP=0
+3 DO GETBOC
ARR1 IF FILE=442
FOR
SET LOOP=$ORDER(^PRC(442,+PO,6,PRCFAA,3,LOOP))
if LOOP=""!(LOOP'>0)
QUIT
Begin DoDot:1
+1 SET N63=^PRC(442,+PO,6,PRCFAA,3,LOOP,0)
SET TYPE=$PIECE(N63,U,2)
SET FANDF=$PIECE(N63,U,3)
SET LINEITEM=$PIECE(^PRC(442,+PO,6,PRCFAA,3,LOOP,0),U,4)
+2 IF $PIECE(FANDF,":",2)=40
IF ("^21^23^"[("^"_TYPE_"^"))
SET ITRAY(LINEITEM)=""
QUIT
+3 IF TYPE=22
SET ITRAY("CANCEL",LINEITEM)=""
QUIT
+4 IF ("^29^35^"[("^"_TYPE_"^"))
SET ITRAY("ESH")=""
QUIT
+5 QUIT
End DoDot:1
+6 IF FILE=442&('$DATA(ITRAY))
SET ITRAY("NOITEMS")=""
ARR2 IF FILE=443.6
FOR
SET LOOP=$ORDER(^PRC(443.6,+PO,6,PRCFAA,3,LOOP))
if LOOP=""!(LOOP'>0)
QUIT
Begin DoDot:1
+1 SET N63=^PRC(443.6,+PO,6,PRCFAA,3,LOOP,0)
SET TYPE=$PIECE(N63,U,2)
SET FANDF=$PIECE(N63,U,3)
SET LINEITEM=$PIECE(^PRC(443.6,+PO,6,PRCFAA,3,LOOP,0),U,4)
+2 IF $PIECE(FANDF,":",2)=40
IF ("^21^23^"[("^"_TYPE_"^"))
SET ITRAY(LINEITEM)=""
QUIT
+3 IF TYPE=22
SET ITRAY("CANCEL",LINEITEM)=""
QUIT
+4 IF ("^29^35^"[("^"_TYPE_"^"))
SET ITRAY("ESH")=""
QUIT
+5 QUIT
End DoDot:1
+6 DO CHKBOC
+7 IF FILE=443.6&('$DATA(ITRAY))
SET ITRAY("NOITEMS")=""
+8 QUIT
GETBOC ; Get ESHBOCs from original and amendment
+1 NEW FILEL
+2 FOR FILEL=442,443.6
DO GENDIQ^PRCFFU7(FILEL,+PO,"13;13.05","IEN","")
+3 SET OESHBOC=$GET(PRCTMP(442,+PO,13.05,"I"))
SET AESHBOC=$GET(PRCTMP(443.6,+PO,13.05,"I"))
+4 QUIT
CHKBOC ; Check BOCs
+1 IF $GET(PRCFA("RETRAN"))=0
Begin DoDot:1
+2 IF OESHBOC]""&(AESHBOC]"")
IF OESHBOC'=AESHBOC
DO MSG11^PRCFFUA3
SET FATAL=1
QUIT
+3 IF OESHBOC]""&(AESHBOC]"")
IF OESHBOC=AESHBOC
KILL ITRAY("ESH")
SET FATAL=2
+4 IF OESHBOC=""&(AESHBOC]"")
IF FILE=443.6
SET ITRAY("ESH")=""
SET FATAL=2
End DoDot:1
QUIT
+5 IF $GET(PRCFA("RETRAN"))=1
Begin DoDot:1
+6 IF $DATA(^PRC(443.6,+PO))
SET FATAL=1
WRITE !
DO EN^DDIOL("An amendment exists for this Purchase Order - cannot rebuild and transmit!")
WRITE !
HANG 3
QUIT
+7 IF OESHBOC]""&(AESHBOC="")
IF $DATA(ITRAY("ESH"))
SET FATAL=2
End DoDot:1
+8 QUIT
