PRCHDAM4 ;WISC/DJM-PRINT AMENDMENT,ROUTINE #4 ;11/14/94 2:57 PM V ;;5.1;IFCAP;;Oct 20, 2000 ;Per VHA Directive 10-93-142, this routine should not be modified. ; E24 ;SOURCE CODE Edit PRINT N CHANGE,OLD,NEW,LCNT,DATA D LCNT^PRCHDAM4(.LCNT) S CHANGE=$O(^PRC(443.6,PRCHPO,6,PRCHAM,3,"AC",24,8,0)) Q:CHANGE'>0 S OLD=^PRC(443.6,PRCHPO,6,PRCHAM,3,CHANGE,1,1,0),OLD=$P(^PRCD(420.8,OLD,0),U) S NEW=$P(^PRC(443.6,PRCHPO,1),U,7),NEW=$P(^PRCD(420.8,NEW,0),U) D LINE^PRCHDAM4(.LCNT,2) S DATA="Source Code was changed from "_OLD_" to "_NEW D DATA^PRCHDAM4(.LCNT,DATA),LCNT1^PRCHDAM4(LCNT) Q ; E30 ;F.C.P. Edit PRINT N CHANGE,OLD,FCP,LCNT,DATA S CHANGE=0 D LCNT^PRCHDAM4(.LCNT) F S CHANGE=$O(^PRC(443.6,PRCHPO,6,PRCHAM,3,"AC",AMEND,1,CHANGE)) Q:CHANGE'>0 D .S OLD=^PRC(443.6,PRCHPO,6,PRCHAM,3,CHANGE,1,1,0) .S FCP=$P(^PRC(443.6,PRCHPO,0),U,3) .D LINE^PRCHDAM4(.LCNT,2) S DATA="The FUND CONTROL POINT of "_OLD D DATA^PRCHDAM4(.LCNT,DATA) .S DATA="has been changed to "_FCP .D DATA^PRCHDAM4(.LCNT,DATA),LCNT1^PRCHDAM4(LCNT) Q ; E31 ;Change VENDOR PRINT N CHANGE,OLD,VEN,LCNT,DATA S CHANGE=0 D LCNT^PRCHDAM4(.LCNT) F S CHANGE=$O(^PRC(443.6,PRCHPO,6,PRCHAM,3,"AC",AMEND,5,CHANGE)) Q:CHANGE'>0 D .S OLD=^PRC(443.6,PRCHPO,6,PRCHAM,3,CHANGE,1,1,0),OLD=$P(^PRC(440,OLD,0),U) .S VEN=$P(^PRC(443.6,PRCHPO,1),U),VEN=$P(^PRC(440,VEN,0),U) .D LINE^PRCHDAM4(.LCNT,2) S DATA="Vendor "_OLD_" has been changed to "_VEN .D DATA^PRCHDAM4(.LCNT,DATA),LCNT1^PRCHDAM4(LCNT) Q ; E32 ;REPLACE P.O. NUMBER PRINT N CHANGE,NPO,OPO,LCNT,DATA S CHANGE=0 D LCNT^PRCHDAM4(.LCNT) F S CHANGE=$O(^PRC(443.6,PRCHPO,6,PRCHAM,3,"AC",AMEND,28,CHANGE)) Q:CHANGE'>0 D .S NPO=$P(^PRC(443.6,PRCHPO,23),U,4),NPO=$P(^PRC(443.6,NPO,0),U) .S OPO=$P(^PRC(443.6,PRCHPO,0),U) .D LINE^PRCHDAM4(.LCNT,2) S DATA="Purchase Order number "_OPO_" has been changed to "_NPO .D DATA^PRCHDAM4(.LCNT,DATA),LCNT1^PRCHDAM4(LCNT) Q ; LCNT(LCNT) ;FETCH THE CURRENT LINE COUNT FROM "W" ARRAY S LCNT=+$G(^UTILITY($J,"W",1)) Q ; LINE(LCNT,LINES) ;ADDS A NUMBER OF BLANK "LINES" INTO "W" ARRAY N I F I=1:1:LINES S LCNT=LCNT+1,^UTILITY($J,"W",1,LCNT,0)=" " Q ; DATA(LCNT,DATA) ;PLACES THE AMENDMENT LINE OF TEXT INTO THE "W" ARRAY S LCNT=LCNT+1,^UTILITY($J,"W",1,LCNT,0)=DATA Q ; LCNT1(LCNT) ;PUT BACK LCNT INTO "W" ARRAY S ^UTILITY($J,"W",1)=LCNT Q ; OLD ;GET ALL THE OLD DESCRIPTION FROM 'CHANGES' MULTIPLE AND SET INTO ;THE DISPLAY '^UTILITY($J,"W"' ARRAY. N LINE,DATA S LINE=1 F D:DES]"" Q:DES="" .S DATA=$E(DES,1,75) D DATA(.LCNT,DATA) .S DES=$E(DES,76,255) Q:$L(DES)'<75 Q:LINE'>0 .S LINE=$O(^PRC(443.6,PRCHPO,6,PRCHAM,3,PRCHLN,1,LINE)) Q:LINE'>0 .S DES=DES_$G(^PRC(443.6,PRCHPO,6,PRCHAM,3,PRCHLN,1,LINE,0)) .Q Q ; NEW ;GET ALL THE NEW DESCRIPTION FROM THE LINE ITEM MULTIPLE AND SET ;INTO THE DISPLAY '^UTILITY($J,"W"' ARRAY. N LINE,DATA S LINE=1 F D:ITEM1]"" Q:ITEM1="" .S DATA=$E(ITEM1,1,75) D DATA(.LCNT,DATA) .S ITEM1=$E(ITEM1,76,255) Q:$L(ITEM1)'<75 Q:LINE'>0 .S LINE=$O(^PRC(443.6,PRCHPO,2,ITEM,1,LINE)) Q:LINE'>0 .S ITEM1=ITEM1_$G(^PRC(443.6,PRCHPO,2,ITEM,1,LINE,0)) .Q Q