- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCFFU7 1870 printed Jan 18, 2025@03:05:04 Page 2
- PRCFFU7 ;WISC/SJG-OBLIGATION PROCESSING UTILITIES, CON'T ;7/24/00 23:10
- V ;;5.1;IFCAP;;Oct 20, 2000
- +1 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +2 ;
- LIST(POIEN,AMIEN) ;
- +1 ; POIEN - Internal Entry Number of Purchase Order
- +2 ; AMIEN - Internal Entry Number of Amendment
- VAR ; Initialize some variables
- +1 KILL PRCFCHG("BOC")
- +2 SET (AMT,TOTAMT)=0
- +3 SET PRCFA("MOMREQ")=0
- SET PRCFA("MOMNOTREQ")=0
- +4 FOR LOOP1="AUTHE","BOC","DEL","DELSCH","FCP","FOB","PO","PPT","VEND"
- SET PRCFA(LOOP1)=""
- +5 SET LOOP=0
- FOR
- SET LOOP=$ORDER(^PRC(442,POIEN,6,AMIEN,3,LOOP))
- if LOOP'>0
- QUIT
- Begin DoDot:1
- +6 SET STRING=^PRC(442,POIEN,6,AMIEN,3,LOOP,0)
- +7 SET CHG=+$PIECE(STRING,U,2)
- +8 if CHG=99
- QUIT
- if PRCFA("FCP")
- QUIT
- if PRCFA("VEND")
- QUIT
- +9 SET OLD(LOOP)=STRING
- +10 SET OLDVAL=^PRC(442,POIEN,6,AMIEN,3,LOOP,1,1,0)
- +11 SET OLD(LOOP,1)=OLDVAL
- +12 SET TAG="TAG"_CHG_"^PRCFFU9"
- DO @TAG
- +13 QUIT
- End DoDot:1
- +14 NEW SUBINFO,AMDSTAT,AUTH
- SET SUBINFO="442.07^3;9^"_AMIEN
- +15 DO GENDIQ(442,POIEN,50,"IEN",SUBINFO)
- +16 SET AMDSTAT=+$GET(PRCTMP(442.07,AMIEN,9,"I"))
- +17 SET AUTH=$GET(PRCTMP(442.07,AMIEN,3,"E"))
- +18 IF (AMDSTAT=45)&(AUTH="E")
- DO TAGE^PRCFFU9
- +19 IF $DATA(PRCFCHG("BOC"))\10
- DO TOTAL
- if TOTAMT<0
- SET TOTAMT=-TOTAMT
- +20 IF '$DATA(PRCFCHG("BOC"))
- IF '$DATA(PRCFA("CANCEL"))
- SET PRCFA("MOMNOTREQ")=1
- SET PRCFA("MOMREQ")=0
- SET PRCFA("ZERO")="NO CHARGE AMENDMENT"
- +21 KILL AMT,CHG,LOOP,LOOP1,LOOP2,LOOP3,LOOP4,OLD,OLDVAL,STRING,TAG
- +22 QUIT
- +23 ;
- GENDIQ(DIC,DA,DR,PARAM,PARAM1) ; Generic call to DIQ1 utility
- +1 NEW DIQ,SUBFILE,SUBFLD,SUBREC
- SET DIQ="PRCTMP("
- SET DIQ(0)=PARAM
- +2 IF PARAM1]""
- Begin DoDot:1
- +3 SET SUBFILE=$PIECE(PARAM1,U)
- SET SUBFLD=$PIECE(PARAM1,U,2)
- SET SUBREC=$PIECE(PARAM1,U,3)
- +4 SET DR(SUBFILE)=SUBFLD
- SET DA(SUBFILE)=SUBREC
- End DoDot:1
- +5 DO EN^DIQ1
- +6 QUIT
- TOTAL ; Calculate total for changes
- +1 SET LOOP3=""
- FOR
- SET LOOP3=$ORDER(PRCFCHG("BOC",LOOP3))
- if LOOP3=""
- QUIT
- Begin DoDot:1
- +2 SET LOOP4=""
- FOR
- SET LOOP4=$ORDER(PRCFCHG("BOC",LOOP3,LOOP4))
- if LOOP4=""
- QUIT
- Begin DoDot:2
- +3 SET AMT=$PIECE(PRCFCHG("BOC",LOOP3,LOOP4),U,2)
- +4 SET TOTAMT=TOTAMT+AMT
- +5 IF AMT<0
- SET AMT=-AMT
- SET $PIECE(PRCFCHG("BOC",LOOP3,LOOP4),U,2)=AMT
- End DoDot:2
- End DoDot:1
- +6 QUIT