| [613] | 1 | PRCFDA4 ;(Wash ISC)/LKG-PROCESS INVOICE FOR PAYMENT ;26 SEP 95
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | AUTOACCR ;Check if AutoAccrue field answered
|
|---|
| 5 | N PRCFBBY,PRCFW,PRCFY,PRCFZ,MOP,DA,DR,DIE
|
|---|
| 6 | S PRCFY=$G(^PRC(442,PRCF("PODA"),10,1,0)),PRCFZ=$P($P(PRCFY,U),".")
|
|---|
| 7 | S MOP=$P($G(^PRC(442,PRCF("PODA"),0)),U,2)
|
|---|
| 8 | S PRCFZ=$S(PRCFZ?2U:PRCFZ,MOP=2:"SO",MOP=21:"SO",1:"MO")
|
|---|
| 9 | Q:PRCFZ'="SO"
|
|---|
| 10 | I $P($G(^PRC(442,PRCF("PODA"),23)),U,6)]"" Q
|
|---|
| 11 | S PRCFBBY=1700+$E($P($G(^PRC(442,PRCF("PODA"),23)),U,2),1,3)
|
|---|
| 12 | I PRCFBBY<$$CVNFY^PRCFD8L("IFCAP",5.0) S PRCFW="NO" G AUTOASK
|
|---|
| 13 | S PRCFW="YES"
|
|---|
| 14 | I $P(PRCFY,".")=921,";10;60;"[(";"_$P(PRCFY,".",2)_";") D
|
|---|
| 15 | . I $P(PRCFY,".",2)=60 S PRCFW="YES" Q
|
|---|
| 16 | . S PRCFY=$P(PRCFY,U,4),PRCFY=$S(PRCFY?1.N:$P($G(^PRCF(423,PRCFY,1)),U,3),1:"")
|
|---|
| 17 | . S PRCFW=$S(PRCFY=6:"YES",PRCFY=7:"YES",1:"NO")
|
|---|
| 18 | AUTOASK W !,"As the Service Order associated with this Invoice lacks a value for the",!," Auto-Accrue Flag, you will now be asked."
|
|---|
| 19 | S DIE=442,DR="30//^S X=PRCFW",DA=PRCF("PODA") D ^DIE
|
|---|
| 20 | Q
|
|---|
