source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHDAM4.m@ 836

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

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