Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCHPAM5

PRCHPAM5.m

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