source: FOIAVistA/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFFU7.m@ 897

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