source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHPAM5.m@ 975

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

initial load of WorldVistAEHR
File size: 3.0 KB
RevLine 
[613]1PRCHPAM5 ;WISC/DJM-PRINT AMENDMENT,ROUTINE #4 ;11/14/94 3:52 PM
2V ;;5.1;IFCAP;;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^PRCHPAM5(.LCNT)
8 S CHANGE=$O(^PRC(443.6,PRCHPO,6,PRCHAM,3,"AC",24,8,0)) Q:CHANGE'>0
9 S OLD=^PRC(443.6,PRCHPO,6,PRCHAM,3,CHANGE,1,1,0),OLD=$P(^PRCD(420.8,OLD,0),U)
10 S NEW=$P(^PRC(443.6,PRCHPO,1),U,7),NEW=$P(^PRCD(420.8,NEW,0),U)
11 D LINE^PRCHPAM5(.LCNT,2) S DATA="Source Code was changed from "_OLD_" to "_NEW D DATA^PRCHPAM5(.LCNT,DATA),LCNT1^PRCHPAM5(LCNT)
12 Q
13 ;
14E30 ;F.C.P. Edit PRINT
15 N CHANGE,OLD,FCP,LCNT,DATA
16 S CHANGE=0 D LCNT^PRCHPAM5(.LCNT)
17 F S CHANGE=$O(^PRC(443.6,PRCHPO,6,PRCHAM,3,"AC",AMEND,1,CHANGE)) Q:CHANGE'>0 D
18 .S OLD=^PRC(443.6,PRCHPO,6,PRCHAM,3,CHANGE,1,1,0)
19 .S FCP=$P(^PRC(443.6,PRCHPO,0),U,3)
20 .D LINE^PRCHPAM5(.LCNT,2) S DATA="The FUND CONTROL POINT of "_OLD D DATA^PRCHPAM5(.LCNT,DATA)
21 .S DATA="has been changed to "_FCP
22 .D DATA^PRCHPAM5(.LCNT,DATA),LCNT1^PRCHPAM5(LCNT)
23 Q
24 ;
25E31 ;Change VENDOR PRINT
26 N CHANGE,OLD,VEN,LCNT,DATA
27 S CHANGE=0 D LCNT^PRCHPAM5(.LCNT)
28 F S CHANGE=$O(^PRC(443.6,PRCHPO,6,PRCHAM,3,"AC",AMEND,5,CHANGE)) Q:CHANGE'>0 D
29 .S OLD=^PRC(443.6,PRCHPO,6,PRCHAM,3,CHANGE,1,1,0),OLD=$P(^PRC(440,OLD,0),U)
30 .S VEN=$P(^PRC(443.6,PRCHPO,1),U),VEN=$P(^PRC(440,VEN,0),U)
31 .D LINE^PRCHPAM5(.LCNT,2) S DATA="Vendor "_OLD_" has been changed to "_VEN
32 .D DATA^PRCHPAM5(.LCNT,DATA),LCNT1^PRCHPAM5(LCNT)
33 Q
34 ;
35E32 ;REPLACE P.O. NUMBER PRINT
36 N CHANGE,NPO,OPO,LCNT,DATA
37 S CHANGE=0 D LCNT^PRCHPAM5(.LCNT)
38 F S CHANGE=$O(^PRC(443.6,PRCHPO,6,PRCHAM,3,"AC",AMEND,28,CHANGE)) Q:CHANGE'>0 D
39 .S NPO=$P(^PRC(443.6,PRCHPO,23),U,4) Q:NPO'>0 S NPO=$P(^PRC(443.6,NPO,0),U)
40 .S OPO=$P(^PRC(443.6,PRCHPO,0),U)
41 .D LINE^PRCHPAM5(.LCNT,2) S DATA="Purchase Order number "_OPO_" has been changed to "_NPO
42 .D DATA^PRCHPAM5(.LCNT,DATA),LCNT1^PRCHPAM5(LCNT)
43 Q
44 ;
45LCNT(LCNT) ;FETCH THE CURRENT LINE COUNT FROM "AMD" ARRAY
46 S LCNT=+$G(^TMP($J,"AMD",1))
47 Q
48 ;
49LINE(LCNT,LINES) ;ADDS A NUMBER OF BLANK "LINES" INTO "AMD" ARRAY
50 N I
51 F I=1:1:LINES S LCNT=LCNT+1,^TMP($J,"AMD",1,LCNT,0)=" "
52 Q
53 ;
54DATA(LCNT,DATA) ;PLACES THE AMENDMENT LINE OF TEXT INTO THE "AMD" ARRAY
55 S LCNT=LCNT+1,^TMP($J,"AMD",1,LCNT,0)=DATA
56 Q
57 ;
58LCNT1(LCNT) ;PUT BACK LCNT INTO "AMD" ARRAY
59 S ^TMP($J,"AMD",1)=LCNT
60 Q
61OLD ;GET ALL THE OLD DESCRIPTION FROM 'CHANGES' MULTIPLE AND SET INTO
62 ;THE DESPLAY '^TMP($J,"AMD"' ARRAY.
63 N LINE,DATA
64 S LINE=1
65 F D:DES]"" Q:DES=""
66 .S DATA=$E(DES,1,75) D DATA(.LCNT,DATA)
67 .S DES=$E(DES,76,255) Q:$L(DES)'<75 Q:LINE'>0
68 .S LINE=$O(^PRC(443.6,PRCHPO,6,PRCHAM,3,PRCHLN,1,LINE)) Q:LINE'>0
69 .S DES=DES_$G(^PRC(443.6,PRCHPO,6,PRCHAM,3,PRCHLN,1,LINE,0))
70 .Q
71 Q
72 ;
73NEW ;GET ALL THE NEW DESCRIPTION FROM THE LINE ITEM MULTIPLE AND SET
74 ;INTO THE DISPLAY '^TMP($J,"AMD"' ARRAY.
75 N LINE,DATA
76 S LINE=1
77 F D:ITEM1]"" Q:ITEM1=""
78 .S DATA=$E(ITEM1,1,75) D DATA(.LCNT,DATA)
79 .S ITEM1=$E(ITEM1,76,255) Q:$L(ITEM1)'<75 Q:LINE'>0
80 .S LINE=$O(^PRC(443.6,PRCHPO,2,ITEM,1,LINE)) Q:LINE'>0
81 .S ITEM1=ITEM1_$G(^PRC(443.6,PRCHPO,2,ITEM,1,LINE,0))
82 .Q
83 Q
Note: See TracBrowser for help on using the repository browser.