| 1 | PRCFFUA4 ;WISC/SJG-ROUTINE TO PROCESS OBLIGATIONS ;4/27/94 11:30
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | QUIT
|
|---|
| 6 | ;
|
|---|
| 7 | ARRAY ; Determine items that changed on the amendment
|
|---|
| 8 | N LOOP,LINEITEM,FANDF,TYPE,N63
|
|---|
| 9 | K ITRAY S LOOP=0
|
|---|
| 10 | D GETBOC
|
|---|
| 11 | ARR1 I FILE=442 F S LOOP=$O(^PRC(442,+PO,6,PRCFAA,3,LOOP)) Q:LOOP=""!(LOOP'>0) D
|
|---|
| 12 | .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)
|
|---|
| 13 | .I $P(FANDF,":",2)=40,("^21^23^"[("^"_TYPE_"^")) S ITRAY(LINEITEM)="" Q
|
|---|
| 14 | .I TYPE=22 S ITRAY("CANCEL",LINEITEM)="" Q
|
|---|
| 15 | .I ("^29^35^"[("^"_TYPE_"^")) S ITRAY("ESH")="" Q
|
|---|
| 16 | .Q
|
|---|
| 17 | I FILE=442&('$D(ITRAY)) S ITRAY("NOITEMS")=""
|
|---|
| 18 | ARR2 I FILE=443.6 F S LOOP=$O(^PRC(443.6,+PO,6,PRCFAA,3,LOOP)) Q:LOOP=""!(LOOP'>0) D
|
|---|
| 19 | .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)
|
|---|
| 20 | .I $P(FANDF,":",2)=40,("^21^23^"[("^"_TYPE_"^")) S ITRAY(LINEITEM)="" Q
|
|---|
| 21 | .I TYPE=22 S ITRAY("CANCEL",LINEITEM)="" Q
|
|---|
| 22 | .I ("^29^35^"[("^"_TYPE_"^")) S ITRAY("ESH")="" Q
|
|---|
| 23 | .Q
|
|---|
| 24 | D CHKBOC
|
|---|
| 25 | I FILE=443.6&('$D(ITRAY)) S ITRAY("NOITEMS")=""
|
|---|
| 26 | Q
|
|---|
| 27 | GETBOC ; Get ESHBOCs from original and amendment
|
|---|
| 28 | N FILEL
|
|---|
| 29 | F FILEL=442,443.6 D GENDIQ^PRCFFU7(FILEL,+PO,"13;13.05","IEN","")
|
|---|
| 30 | S OESHBOC=$G(PRCTMP(442,+PO,13.05,"I")),AESHBOC=$G(PRCTMP(443.6,+PO,13.05,"I"))
|
|---|
| 31 | Q
|
|---|
| 32 | CHKBOC ; Check BOCs
|
|---|
| 33 | I $G(PRCFA("RETRAN"))=0 D Q
|
|---|
| 34 | .I OESHBOC]""&(AESHBOC]"") I OESHBOC'=AESHBOC D MSG11^PRCFFUA3 S FATAL=1 Q
|
|---|
| 35 | .I OESHBOC]""&(AESHBOC]"") I OESHBOC=AESHBOC K ITRAY("ESH") S FATAL=2
|
|---|
| 36 | .I OESHBOC=""&(AESHBOC]"") I FILE=443.6 S ITRAY("ESH")="",FATAL=2
|
|---|
| 37 | I $G(PRCFA("RETRAN"))=1 D
|
|---|
| 38 | .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
|
|---|
| 39 | .I OESHBOC]""&(AESHBOC="") I $D(ITRAY("ESH")) S FATAL=2
|
|---|
| 40 | Q
|
|---|
