Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCFFU7

PRCFFU7.m

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