| 1 | PRCHDAM4 ;WISC/DJM-PRINT AMENDMENT,ROUTINE #4 ;11/14/94 2:57 PM
|
---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
| 4 | ;
|
---|
| 5 | E24 ;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 | ;
|
---|
| 14 | E30 ;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 | ;
|
---|
| 25 | E31 ;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 | ;
|
---|
| 35 | E32 ;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 | ;
|
---|
| 45 | LCNT(LCNT) ;FETCH THE CURRENT LINE COUNT FROM "W" ARRAY
|
---|
| 46 | S LCNT=+$G(^UTILITY($J,"W",1))
|
---|
| 47 | Q
|
---|
| 48 | ;
|
---|
| 49 | LINE(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 | ;
|
---|
| 54 | DATA(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 | ;
|
---|
| 58 | LCNT1(LCNT) ;PUT BACK LCNT INTO "W" ARRAY
|
---|
| 59 | S ^UTILITY($J,"W",1)=LCNT
|
---|
| 60 | Q
|
---|
| 61 | ;
|
---|
| 62 | OLD ;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 | ;
|
---|
| 74 | NEW ;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
|
---|