source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFFUA4.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.8 KB
RevLine 
[613]1PRCFFUA4 ;WISC/SJG-ROUTINE TO PROCESS OBLIGATIONS ;4/27/94 11:30
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 QUIT
6 ;
7ARRAY ; Determine items that changed on the amendment
8 N LOOP,LINEITEM,FANDF,TYPE,N63
9 K ITRAY S LOOP=0
10 D GETBOC
11ARR1 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")=""
18ARR2 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
27GETBOC ; 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
32CHKBOC ; 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
Note: See TracBrowser for help on using the repository browser.