41 lines
1.8 KiB
Mathematica
41 lines
1.8 KiB
Mathematica
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
|