source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHPAM6.m@ 1078

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

initial load of WorldVistAEHR

File size: 3.1 KB
Line 
1PRCHPAM6 ;WISC/DJM-PRINT AMENDMENT,ROUTINE #5 ;6/29/00 12:21
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5E33 ;PROMPT PAYMENT Edit PRINT
6 ;
7 ;N CHANGE,CHANGES,FIELD,OLD,PAY,LCNT,DATA,PCT,PCT1,PCT2,DAYS,DAYS1,DAYS2,TERMS,NPCT,NDAYS1
8 S FIELD=0 K PAY D LCNT^PRCHPAM5(.LCNT)
9 F S FIELD=$O(^PRC(443.6,PRCHPO,6,PRCHAM,3,"AC",AMEND,FIELD)) Q:FIELD'>0 D
10 .S CHANGE=0 F S CHANGE=$O(^PRC(443.6,PRCHPO,6,PRCHAM,3,"AC",AMEND,FIELD,CHANGE)) Q:CHANGE'>0 D
11 ..S CHANGES=^PRC(443.6,PRCHPO,6,PRCHAM,3,CHANGE,0),OLD=$G(^PRC(443.6,PRCHPO,6,PRCHAM,3,CHANGE,1,1,0))
12 ..S:FIELD=.01 PCT2=OLD S:FIELD=1 DAYS2=OLD
13 ..S PAY=$P(CHANGES,U,4) Q:$D(PAY(PAY)) S PAY(PAY)=1
14 ..I FIELD'=1 S DAYS=0 F S DAYS=$O(^PRC(443.6,PRCHPO,6,PRCHAM,3,"AC",33,1,DAYS)) Q:DAYS'>0 S DAYS1=$P(^PRC(443.6,PRCHPO,6,PRCHAM,3,DAYS,0),U,4) I DAYS1=PAY D Q
15 ...S DAYS2=^PRC(443.6,PRCHPO,6,PRCHAM,3,DAYS,1,1,0) Q
16 ..I FIELD'=.01 S PCT=0 F S PCT=$O(^PRC(443.6,PRCHPO,6,PRCHAM,3,"AC",33,.01,PCT)) Q:PCT'>0 S PCT1=$P(^PRC(443.6,PRCHPO,6,PRCHAM,3,PCT,0),U,4) I PCT1=PAY D Q
17 ...S PCT2=^PRC(443.6,PRCHPO,6,PRCHAM,3,PCT,1,1,0) Q
18 ..S TERMS=$G(^PRC(443.6,PRCHPO,5,PAY,0)) Q:TERMS=""
19 ..S NPCT=$P(TERMS,U),NDAYS1=$P(TERMS,U,2)
20 ..D LINE^PRCHPAM5(.LCNT,2)
21 ..S DAYS2=$G(DAYS2),PCT2=$G(PCT2)
22 ..I DAYS2'=0,PCT2'=0 S DATA="Prompt Payment "_PCT2_$S(PCT2=+PCT2:"%",1:"")_"/"_DAYS2_$S(DAYS2=+DAYS2:" days",1:"") D
23 ...S DATA=DATA_" has been changed to "_NPCT_$S(NPCT=+NPCT:"%",1:"")_"/"_NDAYS1_$S(NDAYS1=+NDAYS1:" days",1:"")
24 ...D DATA^PRCHPAM5(.LCNT,DATA) Q
25 ..I DAYS2=0,PCT2=0 S DATA=" *ADDED THROUGH AMENDMENT*" D DATA^PRCHPAM5(.LCNT,DATA) D
26 ...S DATA="Prompt Payment "_NPCT_$S(NPCT=+NPCT:"%",1:"")_"/"_NDAYS1_$S(NDAYS1=+NDAYS1:" days",1:"")_" has been added"
27 ...D DATA^PRCHPAM5(.LCNT,DATA) Q
28 ..Q
29 .Q
30 D LCNT1^PRCHPAM5(LCNT)
31 Q
32 ;
33E34 ;AUTHORITY Edit PRINT
34 ;N CHANGE,OLD,NEW,LCNT,DATA,DT2,I
35 S CHANGE=0 D LCNT^PRCHPAM5(.LCNT)
36 F S CHANGE=$O(^PRC(443.6,PRCHPO,6,PRCHAM,3,"AC",AMEND,3,CHANGE)) Q:CHANGE'>0 D
37 .S CHANGES=^PRC(443.6,PRCHPO,6,PRCHAM,3,CHANGE,0),OLD=^PRC(443.6,PRCHPO,6,PRCHAM,3,CHANGE,1,1,0)
38 .S NEW=$P(^PRC(443.6,PRCHPO,6,PRCHAM,0),U,4)
39 .D LINE^PRCHPAM5(.LCNT,2)
40 .I OLD=0 S DATA=" *ADDED THROUGH AMENDMENT*" D DATA^PRCHPAM5(.LCNT,DATA) D
41 ..S DATA="Authority Edit is",DT2=$P(^PRCD(442.2,NEW,0),U,2) D D DATA^PRCHPAM5(.LCNT,DATA)
42 ...I $L(DATA)+$L(DT2)>239 S DATA=DATA_":" D DATA^PRCHPAM5(.LCNT,DATA) S DATA=DT2 Q
43 ...S DATA=DATA_" "_DT2
44 .I OLD>0 S DATA="Authority Edit " D D DATA^PRCHPAM5(.LCNT,DATA)
45 ..F I=1:1:3 S DT2=$S(I=1:$P(^PRCD(442.2,OLD,0),U,2),I=2:" has been changed to ",I=3:$P(^PRCD(442.2,NEW,0),U,2)) D CHK(.DATA,DT2)
46 .D LCNT1^PRCHPAM5(LCNT)
47 .Q
48 Q
49CHK(DATA,DT2) ;
50 I $L(DATA)+$L(DT2)<241 S DATA=DATA_DT2 Q
51 D DATA^PRCHPAM5(.LCNT,DATA) S DATA=DT2
52 Q
53E35 ;F.O.B. Point PRINT
54 Q
55 ;N CHANGE,OLD,NEW
56 S CHANGE=0 D LCNT^PRCHPAM5(.LCNT)
57 F S CHANGE=$O(^PRC(443.6,PRCHPO,6,PRCHAM,3,"AC",AMEND,6.4,CHANGE)) Q:CHANGE'>0 D
58 .S OLD=^PRC(443.6,PRCHPO,6,PRCHAM,3,CHANGE,1,1,0),NEW=$P($G(^PRC(443.6,PRCHPO,1)),U,6)
59 .D LINE^PRCHPAM5(.LCNT,2)
60 .S DATA="F.O.B. Point "_OLD_" has been changed to "_NEW D DATA^PRCHPAM5(.LCNT,DATA)
61 .D LCNT1^PRCHPAM5(LCNT)
62 .Q
63 Q
Note: See TracBrowser for help on using the repository browser.