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

PRCHPAM5 ;WISC/DJM-PRINT AMENDMENT,ROUTINE #4 ;11/14/94  3:52 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^PRCHPAM5(.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^PRCHPAM5(.LCNT,2) S DATA="Source Code was changed from "_OLD_" to "_NEW D DATA^PRCHPAM5(.LCNT,DATA),LCNT1^PRCHPAM5(LCNT)
 Q
 ;
E30 ;F.C.P. Edit PRINT
 N CHANGE,OLD,FCP,LCNT,DATA
 S CHANGE=0 D LCNT^PRCHPAM5(.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^PRCHPAM5(.LCNT,2) S DATA="The FUND CONTROL POINT of "_OLD D DATA^PRCHPAM5(.LCNT,DATA)
 .S DATA="has been changed to "_FCP
 .D DATA^PRCHPAM5(.LCNT,DATA),LCNT1^PRCHPAM5(LCNT)
 Q
 ;
E31 ;Change VENDOR PRINT
 N CHANGE,OLD,VEN,LCNT,DATA
 S CHANGE=0 D LCNT^PRCHPAM5(.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^PRCHPAM5(.LCNT,2) S DATA="Vendor "_OLD_" has been changed to "_VEN
 .D DATA^PRCHPAM5(.LCNT,DATA),LCNT1^PRCHPAM5(LCNT)
 Q
 ;
E32 ;REPLACE P.O. NUMBER PRINT
 N CHANGE,NPO,OPO,LCNT,DATA
 S CHANGE=0 D LCNT^PRCHPAM5(.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) Q:NPO'>0  S NPO=$P(^PRC(443.6,NPO,0),U)
 .S OPO=$P(^PRC(443.6,PRCHPO,0),U)
 .D LINE^PRCHPAM5(.LCNT,2) S DATA="Purchase Order number "_OPO_" has been changed to "_NPO
 .D DATA^PRCHPAM5(.LCNT,DATA),LCNT1^PRCHPAM5(LCNT)
 Q
 ;
LCNT(LCNT) ;FETCH THE CURRENT LINE COUNT FROM "AMD" ARRAY
 S LCNT=+$G(^TMP($J,"AMD",1))
 Q
 ;
LINE(LCNT,LINES) ;ADDS A NUMBER OF BLANK "LINES" INTO "AMD" ARRAY
 N I
 F I=1:1:LINES S LCNT=LCNT+1,^TMP($J,"AMD",1,LCNT,0)="     "
 Q
 ;
DATA(LCNT,DATA) ;PLACES THE AMENDMENT LINE OF TEXT INTO THE "AMD" ARRAY
 S LCNT=LCNT+1,^TMP($J,"AMD",1,LCNT,0)=DATA
 Q
 ;
LCNT1(LCNT) ;PUT BACK LCNT INTO "AMD" ARRAY
 S ^TMP($J,"AMD",1)=LCNT
 Q
OLD ;GET ALL THE OLD DESCRIPTION FROM 'CHANGES' MULTIPLE AND SET INTO
 ;THE DESPLAY '^TMP($J,"AMD"' 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 '^TMP($J,"AMD"' 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