source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHDP8.m@ 629

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

initial load of WorldVistAEHR
File size: 4.2 KB
RevLine 
[613]1PRCHDP8 ;WISC/DJM-PRINT AMENDMENT,ROUTINE #4 ;6/23/94 8:44 AM ;5/13/94 10:37 AM
2V ;;5.1;IFCAP;**74**;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5E24 ;SOURCE CODE Edit PRINT
6 N CHANGE,OLD,NEW,LCNT,DATA
7 D LCNT^PRCHDP9(.LCNT)
8 S CHANGE=$O(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",24,8,0)) Q:CHANGE'>0
9 S OLD=^PRC(442,PRCHPO,6,PRCHAM,3,CHANGE,1,1,0),OLD=$P(^PRCD(420.8,OLD,0),U)
10 S NEW=$P(^PRC(442,PRCHPO,1),U,7),NEW=$P(^PRCD(420.8,NEW,0),U)
11 D LINE^PRCHDP9(.LCNT,2) S DATA="Source Code was changed from "_OLD_" to "_NEW D DATA^PRCHDP9(.LCNT,DATA),LCNT1^PRCHDP9(LCNT)
12 Q
13 ;
14E30 ;F.C.P. Edit PRINT
15 N CHANGE,OLD,FCP,LCNT,DATA
16 S CHANGE=0 D LCNT^PRCHDP9(.LCNT)
17 F S CHANGE=$O(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",AMEND,1,CHANGE)) Q:CHANGE'>0 D
18 .S OLD=^PRC(442,PRCHPO,6,PRCHAM,3,CHANGE,1,1,0)
19 .S FCP=$P(^PRC(442,PRCHPO,0),U,3)
20 .D LINE^PRCHDP9(.LCNT,2) S DATA="The FUND CONTROL POINT of "_OLD D DATA^PRCHDP9(.LCNT,DATA)
21 .S DATA="has been changed to "_FCP
22 .D DATA^PRCHDP9(.LCNT,DATA),LCNT1^PRCHDP9(LCNT)
23 Q
24 ;
25E31 ;Change VENDOR PRINT
26 N CHANGE,OLD,VEN,LCNT,DATA,CNT,CNT1,CNT2,AA
27 S CHANGE=0,CNT=0,CNT2=0 D LCNT^PRCHDP9(.LCNT)
28 ;
29 ;Check for multiple vendor changes
30 F S CNT=$O(^PRC(442,PRCHPO,6,CNT)) Q:'CNT D
31 . S CNT1=0
32 . F S CNT1=$O(^PRC(442,PRCHPO,6,CNT,3,CNT1)) Q:'CNT1 D
33 . . S TYPE=$G(^PRC(442,PRCHPO,6,CNT,3,CNT1,0))
34 . . S TYPE=$P(TYPE,U,2) I TYPE'=31 Q
35 . . S VEN=$G(^PRC(442,PRCHPO,6,CNT,3,CNT1,1,1,0))
36 . . Q:VEN=""
37 . . S CNT2=CNT2+1,AA(CNT)=VEN ;Count/track vendor changes
38 ;
39 F S CHANGE=$O(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",AMEND,5,CHANGE)) Q:CHANGE'>0 D
40 .;Print vendor amendments.
41 .I CNT2>1 D E31A Q
42 .S OLD=^PRC(442,PRCHPO,6,PRCHAM,3,CHANGE,1,1,0),OLD=$P(^PRC(440,OLD,0),U)
43 .S VEN=$P(^PRC(442,PRCHPO,1),U),VEN=$P(^PRC(440,VEN,0),U)
44 .D LINE^PRCHDP9(.LCNT,2) S DATA="Vendor "_OLD_" has been changed to "_VEN
45 .D DATA^PRCHDP9(.LCNT,DATA),LCNT1^PRCHDP9(LCNT)
46 Q
47 ;
48E31A ;Print multiple vendor changes.
49 S OLD=$P(^PRC(440,AA(PRCHAM),0),U)
50 S VEN=$O(AA(PRCHAM))
51 I VEN="" S VEN=$P(^PRC(442,PRCHPO,1),U)
52 E S VEN=AA(VEN)
53 S VEN=$P(^PRC(440,VEN,0),U)
54 ;
55 D LINE^PRCHDP9(.LCNT,2)
56 S DATA="Vendor "_OLD_" has been changed to "_VEN
57 D DATA^PRCHDP9(.LCNT,DATA),LCNT1^PRCHDP9(LCNT)
58 Q
59 ;
60E32 ;REPLACE P.O. NUMBER PRINT
61 N CHANGE,NPO,OPO,LCNT,DATA
62 S CHANGE=0 D LCNT^PRCHDP9(.LCNT)
63 F S CHANGE=$O(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",AMEND,28,CHANGE)) Q:CHANGE'>0 D
64 .S NPO=$P(^PRC(442,PRCHPO,23),U,4),NPO=$P(^PRC(442,NPO,0),U)
65 .S OPO=$P(^PRC(442,PRCHPO,0),U)
66 .D LINE^PRCHDP9(.LCNT,2) S DATA="Purchase Order number "_OPO_" has been changed to "_NPO
67 .D DATA^PRCHDP9(.LCNT,DATA),LCNT1^PRCHDP9(LCNT)
68 Q
69 ;
70E33 ;PROMPT PAYMENT Edit PRINT
71 ;N CHANGE,CHANGES,FIELD,OLD,PAY,LCNT,DATA,PCT,PCT1,PCT2,DAYS,DAYS1,DAYS2,TERMS,NPCT,NDAYS1
72 S FIELD=0 K PAY D LCNT^PRCHDP9(.LCNT)
73 F S FIELD=$O(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",AMEND,FIELD)) Q:FIELD'>0 D
74 .S CHANGE=0 F S CHANGE=$O(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",AMEND,FIELD,CHANGE)) Q:CHANGE'>0 D
75 ..S CHANGES=^PRC(442,PRCHPO,6,PRCHAM,3,CHANGE,0),OLD=^PRC(442,PRCHPO,6,PRCHAM,3,CHANGE,1,1,0)
76 ..S:FIELD=.01 PCT2=OLD S:FIELD=1 DAYS2=OLD
77 ..S PAY=$P(CHANGES,U,4) Q:$D(PAY(PAY)) S PAY(PAY)=1
78 ..I FIELD'=1 S DAYS=0 F S DAYS=$O(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",33,1,DAYS)) Q:DAYS'>0 S DAYS1=$P(^PRC(442,PRCHPO,6,PRCHAM,3,DAYS,0),U,4) I DAYS1=PAY D Q
79 ...S DAYS2=^PRC(442,PRCHPO,6,PRCHAM,3,DAYS,1,1,0) Q
80 ..I FIELD'=.01 S PCT=0 F S PCT=$O(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",33,.01,PCT)) Q:PCT'>0 S PCT1=$P(^PRC(442,PRCHPO,6,PRCHAM,3,PCT,0),U,4) I PCT1=PAY D Q
81 ...S PCT2=^PRC(442,PRCHPO,6,PRCHAM,3,PCT,1,1,0) Q
82 ..S TERMS=^PRC(442,PRCHPO,5,PAY,0),NPCT=$P(TERMS,U),NDAYS1=$P(TERMS,U,2)
83 ..D LINE^PRCHDP9(.LCNT,2)
84 ..S DAYS2=$G(DAYS2),PCT2=$G(PCT2)
85 ..I DAYS2'=0,PCT2'=0 S DATA="Prompt Payment "_PCT2_$S(PCT2=+PCT2:"%",1:"")_"/"_DAYS2_$S(DAYS2=+DAYS2:" days",1:"") D
86 ...S DATA=DATA_" has been changed to "_NPCT_$S(NPCT=+NPCT:"%",1:"")_"/"_NDAYS1_$S(NDAYS1=+NDAYS1:" days",1:"")
87 ...D DATA^PRCHDP9(.LCNT,DATA) Q
88 ..I DAYS2=0,PCT2=0 S DATA=" *ADDED THROUGH AMENDMENT*" D DATA^PRCHDP9(.LCNT,DATA) D
89 ...S DATA="Prompt Payment "_NPCT_$S(NPCT=+NPCT:"%",1:"")_"/"_NDAYS1_$S(NDAYS1=+NDAYS1:" days",1:"")_" has been added"
90 ...D DATA^PRCHDP9(.LCNT,DATA) Q
91 ..Q
92 .Q
93 D LCNT1^PRCHDP9(LCNT)
94 Q
Note: See TracBrowser for help on using the repository browser.