source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFFU7.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.8 KB
Line 
1PRCFFU7 ;WISC/SJG-OBLIGATION PROCESSING UTILITIES, CON'T ;7/24/00 23:10
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5LIST(POIEN,AMIEN) ;
6 ; POIEN - Internal Entry Number of Purchase Order
7 ; AMIEN - Internal Entry Number of Amendment
8VAR ; 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 ;
32GENDIQ(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
39TOTAL ; 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
Note: See TracBrowser for help on using the repository browser.