| [613] | 1 | PRCFFU7 ;WISC/SJG-OBLIGATION PROCESSING UTILITIES, CON'T ;7/24/00 23:10
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | LIST(POIEN,AMIEN) ;
|
|---|
| 6 | ; POIEN - Internal Entry Number of Purchase Order
|
|---|
| 7 | ; AMIEN - Internal Entry Number of Amendment
|
|---|
| 8 | VAR ; Initialize some variables
|
|---|
| 9 | K PRCFCHG("BOC")
|
|---|
| 10 | S (AMT,TOTAMT)=0
|
|---|
| 11 | S PRCFA("MOMREQ")=0,PRCFA("MOMNOTREQ")=0
|
|---|
| 12 | F LOOP1="AUTHE","BOC","DEL","DELSCH","FCP","FOB","PO","PPT","VEND" S PRCFA(LOOP1)=""
|
|---|
| 13 | S LOOP=0 F S LOOP=$O(^PRC(442,POIEN,6,AMIEN,3,LOOP)) Q:LOOP'>0 D
|
|---|
| 14 | .S STRING=^PRC(442,POIEN,6,AMIEN,3,LOOP,0)
|
|---|
| 15 | .S CHG=+$P(STRING,U,2)
|
|---|
| 16 | .Q:CHG=99 Q:PRCFA("FCP") Q:PRCFA("VEND")
|
|---|
| 17 | .S OLD(LOOP)=STRING
|
|---|
| 18 | .S OLDVAL=^PRC(442,POIEN,6,AMIEN,3,LOOP,1,1,0)
|
|---|
| 19 | .S OLD(LOOP,1)=OLDVAL
|
|---|
| 20 | .S TAG="TAG"_CHG_"^PRCFFU9" D @TAG
|
|---|
| 21 | .Q
|
|---|
| 22 | N SUBINFO,AMDSTAT,AUTH S SUBINFO="442.07^3;9^"_AMIEN
|
|---|
| 23 | D GENDIQ(442,POIEN,50,"IEN",SUBINFO)
|
|---|
| 24 | S AMDSTAT=+$G(PRCTMP(442.07,AMIEN,9,"I"))
|
|---|
| 25 | S AUTH=$G(PRCTMP(442.07,AMIEN,3,"E"))
|
|---|
| 26 | I (AMDSTAT=45)&(AUTH="E") D TAGE^PRCFFU9
|
|---|
| 27 | I $D(PRCFCHG("BOC"))\10 D TOTAL S:TOTAMT<0 TOTAMT=-TOTAMT
|
|---|
| 28 | I '$D(PRCFCHG("BOC")),'$D(PRCFA("CANCEL")) S PRCFA("MOMNOTREQ")=1,PRCFA("MOMREQ")=0,PRCFA("ZERO")="NO CHARGE AMENDMENT"
|
|---|
| 29 | KILL AMT,CHG,LOOP,LOOP1,LOOP2,LOOP3,LOOP4,OLD,OLDVAL,STRING,TAG
|
|---|
| 30 | QUIT
|
|---|
| 31 | ;
|
|---|
| 32 | GENDIQ(DIC,DA,DR,PARAM,PARAM1) ; Generic call to DIQ1 utility
|
|---|
| 33 | N DIQ,SUBFILE,SUBFLD,SUBREC S DIQ="PRCTMP(",DIQ(0)=PARAM
|
|---|
| 34 | I PARAM1]"" D
|
|---|
| 35 | .S SUBFILE=$P(PARAM1,U),SUBFLD=$P(PARAM1,U,2),SUBREC=$P(PARAM1,U,3)
|
|---|
| 36 | .S DR(SUBFILE)=SUBFLD,DA(SUBFILE)=SUBREC
|
|---|
| 37 | D EN^DIQ1
|
|---|
| 38 | Q
|
|---|
| 39 | TOTAL ; Calculate total for changes
|
|---|
| 40 | S LOOP3="" F S LOOP3=$O(PRCFCHG("BOC",LOOP3)) Q:LOOP3="" D
|
|---|
| 41 | .S LOOP4="" F S LOOP4=$O(PRCFCHG("BOC",LOOP3,LOOP4)) Q:LOOP4="" D
|
|---|
| 42 | ..S AMT=$P(PRCFCHG("BOC",LOOP3,LOOP4),U,2)
|
|---|
| 43 | ..S TOTAMT=TOTAMT+AMT
|
|---|
| 44 | ..I AMT<0 S AMT=-AMT,$P(PRCFCHG("BOC",LOOP3,LOOP4),U,2)=AMT
|
|---|
| 45 | Q
|
|---|
