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

PRCHDSP6.m

Go to the documentation of this file.
  1. PRCHDSP6 ;WISC/DJM-PRINT AMENDMENT, ROUTINE #3 ;6/29/00 12:20
  1. V ;;5.1;IFCAP;**180**;Oct 20, 2000;Build 5
  1. ;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ;PRC*5.1*180 Add Amend to Delivery date display (98-7)
  1. ;
  1. E25 ;Edit MAIL INVOICE TO PRINT
  1. N CHANGE,OLD,MIT,LCNT,DATA,SITE
  1. S CHANGE=0 D LCNT^PRCHPAM5(.LCNT)
  1. F S CHANGE=$O(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",AMEND,.04,CHANGE)) Q:CHANGE'>0 D
  1. .S SITE=$P($G(^PRC(442,PRCHPO,23)),U,7) S SITE=$S($G(SITE)]"":SITE,1:$P($P(^PRC(442,PRCHPO,0),U),"-"))
  1. .S OLD=^PRC(442,PRCHPO,6,PRCHAM,3,CHANGE,1,1,0),OLD=$P($S($D(^PRC(411,SITE,4,OLD,0)):^(0),1:""),U)
  1. .S MIT=$P(^PRC(442,PRCHPO,12),U,6),MIT=$P($S($D(^PRC(411,SITE,4,MIT,0)):^(0),1:""),U)
  1. .D LINE^PRCHPAM5(.LCNT,2) S DATA="MAIL INVOICE to "_OLD_" has been **AMENDED** to become MAIL INVOICE to "_MIT
  1. .D DATA^PRCHPAM5(.LCNT,DATA),LCNT1^PRCHPAM5(LCNT)
  1. Q
  1. E26 ;Edit METHOD OF PAYMENT PRINT
  1. N CHANGE,MOP,OLD,LCNT,DATA
  1. S CHANGE=0 D LCNT^PRCHPAM5(.LCNT)
  1. F S CHANGE=$O(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",AMEND,.02,CHANGE)) Q:CHANGE'>0 D
  1. .S OLD=^PRC(442,PRCHPO,6,PRCHAM,3,CHANGE,1,1,0),OLD=$P(^PRCD(442.5,OLD,0),U)
  1. .S MOP=$P(^PRC(442,PRCHPO,0),U,2),MOP=$P(^PRCD(442.5,MOP,0),U)
  1. .D LINE^PRCHPAM5(.LCNT,2) S DATA="METHOD of PAYMENT of "_OLD D DATA^PRCHPAM5(.LCNT,DATA)
  1. .S DATA="has been changed to "_MOP D DATA^PRCHPAM5(.LCNT,DATA),LCNT1^PRCHPAM5(LCNT)
  1. Q
  1. E27 ;ADMINISTRATIVE CERTIFICATION Add PRINT
  1. N CHANGE,CHANGES,AC,VAL,LCNT,DATA
  1. S CHANGE=0 D LCNT^PRCHPAM5(.LCNT)
  1. F S CHANGE=$O(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",AMEND,.01,CHANGE)) Q:CHANGE'>0 D
  1. .S CHANGES=^PRC(442,PRCHPO,6,PRCHAM,3,CHANGE,0)
  1. .S AC=$P(CHANGES,U,4),VAL=$G(^PRC(442,PRCHPO,15,AC,0)) Q:VAL=""
  1. .S AC=$P(VAL,U),VAL=$P($G(^PRC(442.7,+VAL,0)),U,2)
  1. .D LINE^PRCHPAM5(.LCNT,2) S DATA="ADMINISTRATIVE CERTIFICATION "_AC_", "_VAL_", has been ADDED"
  1. .D DATA^PRCHPAM5(.LCNT,DATA),LCNT1^PRCHPAM5(LCNT)
  1. Q
  1. E28 ;ADMINISTRATIVE CERTIFICATION Delete PRINT
  1. N CHANGE,CHANGES,AC,OLD,LCNT,DATA
  1. S CHANGE=0 D LCNT^PRCHPAM5(.LCNT)
  1. F S CHANGE=$O(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",AMEND,.01,CHANGE)) Q:CHANGE'>0 D
  1. .S CHANGES=^PRC(442,PRCHPO,6,PRCHAM,3,CHANGE,0),OLD=^PRC(442,PRCHPO,6,PRCHAM,3,CHANGE,1,1,0)
  1. .S AC=$P(CHANGES,U,4),OLD=$S(OLD>0:$P($G(^PRC(442.7,+OLD,0)),U,2),1:""),OLD=$S(OLD]"":", "_OLD_",",1:"")
  1. .D LINE^PRCHPAM5(.LCNT,2) S DATA="ADMINISTRATIVE CERTIFICATION "_AC_OLD D DATA^PRCHPAM5(.LCNT,DATA)
  1. .S DATA="has been DELETED"
  1. .D DATA^PRCHPAM5(.LCNT,DATA),LCNT1^PRCHPAM5(LCNT)
  1. Q
  1. E29 ;EST. SHIPPING Edit PRINT
  1. N CHANGE,OLD,EST,LCNT,DATA,OBOC,OBOC1,FLAG
  1. S CHANGE=0 D LCNT^PRCHPAM5(.LCNT)
  1. F S CHANGE=$O(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",AMEND,13,CHANGE)) Q:CHANGE'>0 D
  1. .S OLD=^PRC(442,PRCHPO,6,PRCHAM,3,CHANGE,1,1,0),OLD=$FN(OLD,"-",2)
  1. .S EST=$P(^PRC(442,PRCHPO,0),U,13),EST=$FN(EST,"-",2)
  1. .S (OBOC1,FLAG)=0 K OBOC
  1. .F S OBOC1=$O(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",AMEND,13.05,OBOC1)) Q:OBOC1'>0 D Q:FLAG=1
  1. .D LINE^PRCHPAM5(.LCNT,2)
  1. .I OLD'>0 D
  1. ..S DATA="**ADDED THROUGH AMENDMENT**" D DATA^PRCHPAM5(.LCNT,DATA)
  1. ..S DATA="Estimated Shipping and/or Handling of $"_EST_" has been added" D DATA^PRCHPAM5(.LCNT,DATA)
  1. ..Q
  1. .I OLD>0 D
  1. ..S DATA="Estimated Shipping and/or Handling of $"_OLD_" has been changed" D DATA^PRCHPAM5(.LCNT,DATA) S DATA="to $"_EST D DATA^PRCHPAM5(.LCNT,DATA)
  1. ..Q
  1. .D LCNT1^PRCHPAM5(LCNT)
  1. .Q
  1. Q
  1. ;
  1. E98 ;
  1. ;Edit DELIVERY DATE ;PRC*5.1*180 Display of Delivery Date amend
  1. N CHANGE,DDATE,OLD,LCNT,DATA
  1. S CHANGE=0 D LCNT^PRCHPAM5(.LCNT)
  1. F S CHANGE=$O(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",AMEND,7,CHANGE)) Q:CHANGE'>0 D
  1. .S OLD=^PRC(442,PRCHPO,6,PRCHAM,3,CHANGE,1,1,0)
  1. .S DDATE=$P(^PRC(442,PRCHPO,0),U,10)
  1. .D LINE^PRCHPAM5(.LCNT,2) S DATA="DELIVERY DATE "_$$FMTE^XLFDT(OLD)_" has been changed to "_$$FMTE^XLFDT(DDATE) D DATA^PRCHPAM5(.LCNT,DATA),LCNT1^PRCHPAM5(LCNT)
  1. Q
  1. OLD ;GET ALL THE OLD DESCRIPTION FROM 'CHANGES' MULTIPLE AND SET INTO
  1. ;THE DISPLAY '^UTILITY($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^PRCHPAM5(.LCNT,DATA)
  1. .S DES=$E(DES,76,255) Q:$L(DES)'<75 Q:LINE'>0
  1. .S LINE=$O(^PRC(442,PRCHPO,6,PRCHAM,3,PRCHLN,1,LINE)) Q:LINE'>0
  1. .S DES=DES_$G(^PRC(442,PRCHPO,6,PRCHAM,3,PRCHLN,1,LINE,0))
  1. .Q
  1. Q
  1. ;
  1. NEW ;GET ALL THE DESCRIPTION FROM THE LINE ITEM MULTIPLE AND SET
  1. ;INTO THE DISPLAY '^UTILITY($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^PRCHPAM5(.LCNT,DATA)
  1. .S ITEM1=$E(ITEM1,76,255) Q:$L(ITEM1)'<75 Q:LINE'>0
  1. .S LINE=$O(^PRC(442,PRCHPO,2,ITEM,1,LINE)) Q:LINE'>0
  1. .S ITEM1=ITEM1_$G(^PRC(442,PRCHPO,2,ITEM,1,LINE,0))
  1. .Q
  1. Q