PRCHDP8 ;WISC/DJM-PRINT AMENDMENT,ROUTINE #4 ;6/23/94 8:44 AM ;5/13/94 10:37 AM
V ;;5.1;IFCAP;**74**;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^PRCHDP9(.LCNT)
S CHANGE=$O(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",24,8,0)) Q:CHANGE'>0
S OLD=^PRC(442,PRCHPO,6,PRCHAM,3,CHANGE,1,1,0),OLD=$P(^PRCD(420.8,OLD,0),U)
S NEW=$P(^PRC(442,PRCHPO,1),U,7),NEW=$P(^PRCD(420.8,NEW,0),U)
D LINE^PRCHDP9(.LCNT,2) S DATA="Source Code was changed from "_OLD_" to "_NEW D DATA^PRCHDP9(.LCNT,DATA),LCNT1^PRCHDP9(LCNT)
Q
;
E30 ;F.C.P. Edit PRINT
N CHANGE,OLD,FCP,LCNT,DATA
S CHANGE=0 D LCNT^PRCHDP9(.LCNT)
F S CHANGE=$O(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",AMEND,1,CHANGE)) Q:CHANGE'>0 D
.S OLD=^PRC(442,PRCHPO,6,PRCHAM,3,CHANGE,1,1,0)
.S FCP=$P(^PRC(442,PRCHPO,0),U,3)
.D LINE^PRCHDP9(.LCNT,2) S DATA="The FUND CONTROL POINT of "_OLD D DATA^PRCHDP9(.LCNT,DATA)
.S DATA="has been changed to "_FCP
.D DATA^PRCHDP9(.LCNT,DATA),LCNT1^PRCHDP9(LCNT)
Q
;
E31 ;Change VENDOR PRINT
N CHANGE,OLD,VEN,LCNT,DATA,CNT,CNT1,CNT2,AA
S CHANGE=0,CNT=0,CNT2=0 D LCNT^PRCHDP9(.LCNT)
;
;Check for multiple vendor changes
F S CNT=$O(^PRC(442,PRCHPO,6,CNT)) Q:'CNT D
. S CNT1=0
. F S CNT1=$O(^PRC(442,PRCHPO,6,CNT,3,CNT1)) Q:'CNT1 D
. . S TYPE=$G(^PRC(442,PRCHPO,6,CNT,3,CNT1,0))
. . S TYPE=$P(TYPE,U,2) I TYPE'=31 Q
. . S VEN=$G(^PRC(442,PRCHPO,6,CNT,3,CNT1,1,1,0))
. . Q:VEN=""
. . S CNT2=CNT2+1,AA(CNT)=VEN ;Count/track vendor changes
;
F S CHANGE=$O(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",AMEND,5,CHANGE)) Q:CHANGE'>0 D
.;Print vendor amendments.
.I CNT2>1 D E31A Q
.S OLD=^PRC(442,PRCHPO,6,PRCHAM,3,CHANGE,1,1,0),OLD=$P(^PRC(440,OLD,0),U)
.S VEN=$P(^PRC(442,PRCHPO,1),U),VEN=$P(^PRC(440,VEN,0),U)
.D LINE^PRCHDP9(.LCNT,2) S DATA="Vendor "_OLD_" has been changed to "_VEN
.D DATA^PRCHDP9(.LCNT,DATA),LCNT1^PRCHDP9(LCNT)
Q
;
E31A ;Print multiple vendor changes.
S OLD=$P(^PRC(440,AA(PRCHAM),0),U)
S VEN=$O(AA(PRCHAM))
I VEN="" S VEN=$P(^PRC(442,PRCHPO,1),U)
E S VEN=AA(VEN)
S VEN=$P(^PRC(440,VEN,0),U)
;
D LINE^PRCHDP9(.LCNT,2)
S DATA="Vendor "_OLD_" has been changed to "_VEN
D DATA^PRCHDP9(.LCNT,DATA),LCNT1^PRCHDP9(LCNT)
Q
;
E32 ;REPLACE P.O. NUMBER PRINT
N CHANGE,NPO,OPO,LCNT,DATA
S CHANGE=0 D LCNT^PRCHDP9(.LCNT)
F S CHANGE=$O(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",AMEND,28,CHANGE)) Q:CHANGE'>0 D
.S NPO=$P(^PRC(442,PRCHPO,23),U,4),NPO=$P(^PRC(442,NPO,0),U)
.S OPO=$P(^PRC(442,PRCHPO,0),U)
.D LINE^PRCHDP9(.LCNT,2) S DATA="Purchase Order number "_OPO_" has been changed to "_NPO
.D DATA^PRCHDP9(.LCNT,DATA),LCNT1^PRCHDP9(LCNT)
Q
;
E33 ;PROMPT PAYMENT Edit PRINT
;N CHANGE,CHANGES,FIELD,OLD,PAY,LCNT,DATA,PCT,PCT1,PCT2,DAYS,DAYS1,DAYS2,TERMS,NPCT,NDAYS1
S FIELD=0 K PAY D LCNT^PRCHDP9(.LCNT)
F S FIELD=$O(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",AMEND,FIELD)) Q:FIELD'>0 D
.S CHANGE=0 F S CHANGE=$O(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",AMEND,FIELD,CHANGE)) Q:CHANGE'>0 D
..S CHANGES=^PRC(442,PRCHPO,6,PRCHAM,3,CHANGE,0),OLD=^PRC(442,PRCHPO,6,PRCHAM,3,CHANGE,1,1,0)
..S:FIELD=.01 PCT2=OLD S:FIELD=1 DAYS2=OLD
..S PAY=$P(CHANGES,U,4) Q:$D(PAY(PAY)) S PAY(PAY)=1
..I FIELD'=1 S DAYS=0 F S DAYS=$O(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",33,1,DAYS)) Q:DAYS'>0 S DAYS1=$P(^PRC(442,PRCHPO,6,PRCHAM,3,DAYS,0),U,4) I DAYS1=PAY D Q
...S DAYS2=^PRC(442,PRCHPO,6,PRCHAM,3,DAYS,1,1,0) Q
..I FIELD'=.01 S PCT=0 F S PCT=$O(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",33,.01,PCT)) Q:PCT'>0 S PCT1=$P(^PRC(442,PRCHPO,6,PRCHAM,3,PCT,0),U,4) I PCT1=PAY D Q
...S PCT2=^PRC(442,PRCHPO,6,PRCHAM,3,PCT,1,1,0) Q
..S TERMS=^PRC(442,PRCHPO,5,PAY,0),NPCT=$P(TERMS,U),NDAYS1=$P(TERMS,U,2)
..D LINE^PRCHDP9(.LCNT,2)
..S DAYS2=$G(DAYS2),PCT2=$G(PCT2)
..I DAYS2'=0,PCT2'=0 S DATA="Prompt Payment "_PCT2_$S(PCT2=+PCT2:"%",1:"")_"/"_DAYS2_$S(DAYS2=+DAYS2:" days",1:"") D
...S DATA=DATA_" has been changed to "_NPCT_$S(NPCT=+NPCT:"%",1:"")_"/"_NDAYS1_$S(NDAYS1=+NDAYS1:" days",1:"")
...D DATA^PRCHDP9(.LCNT,DATA) Q
..I DAYS2=0,PCT2=0 S DATA=" *ADDED THROUGH AMENDMENT*" D DATA^PRCHDP9(.LCNT,DATA) D
...S DATA="Prompt Payment "_NPCT_$S(NPCT=+NPCT:"%",1:"")_"/"_NDAYS1_$S(NDAYS1=+NDAYS1:" days",1:"")_" has been added"
...D DATA^PRCHDP9(.LCNT,DATA) Q
..Q
.Q
D LCNT1^PRCHDP9(LCNT)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHDP8 4355 printed Nov 22, 2024@17:16:54 Page 2
PRCHDP8 ;WISC/DJM-PRINT AMENDMENT,ROUTINE #4 ;6/23/94 8:44 AM ;5/13/94 10:37 AM
V ;;5.1;IFCAP;**74**;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 ;
E24 ;SOURCE CODE Edit PRINT
+1 NEW CHANGE,OLD,NEW,LCNT,DATA
+2 DO LCNT^PRCHDP9(.LCNT)
+3 SET CHANGE=$ORDER(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",24,8,0))
if CHANGE'>0
QUIT
+4 SET OLD=^PRC(442,PRCHPO,6,PRCHAM,3,CHANGE,1,1,0)
SET OLD=$PIECE(^PRCD(420.8,OLD,0),U)
+5 SET NEW=$PIECE(^PRC(442,PRCHPO,1),U,7)
SET NEW=$PIECE(^PRCD(420.8,NEW,0),U)
+6 DO LINE^PRCHDP9(.LCNT,2)
SET DATA="Source Code was changed from "_OLD_" to "_NEW
DO DATA^PRCHDP9(.LCNT,DATA)
DO LCNT1^PRCHDP9(LCNT)
+7 QUIT
+8 ;
E30 ;F.C.P. Edit PRINT
+1 NEW CHANGE,OLD,FCP,LCNT,DATA
+2 SET CHANGE=0
DO LCNT^PRCHDP9(.LCNT)
+3 FOR
SET CHANGE=$ORDER(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",AMEND,1,CHANGE))
if CHANGE'>0
QUIT
Begin DoDot:1
+4 SET OLD=^PRC(442,PRCHPO,6,PRCHAM,3,CHANGE,1,1,0)
+5 SET FCP=$PIECE(^PRC(442,PRCHPO,0),U,3)
+6 DO LINE^PRCHDP9(.LCNT,2)
SET DATA="The FUND CONTROL POINT of "_OLD
DO DATA^PRCHDP9(.LCNT,DATA)
+7 SET DATA="has been changed to "_FCP
+8 DO DATA^PRCHDP9(.LCNT,DATA)
DO LCNT1^PRCHDP9(LCNT)
End DoDot:1
+9 QUIT
+10 ;
E31 ;Change VENDOR PRINT
+1 NEW CHANGE,OLD,VEN,LCNT,DATA,CNT,CNT1,CNT2,AA
+2 SET CHANGE=0
SET CNT=0
SET CNT2=0
DO LCNT^PRCHDP9(.LCNT)
+3 ;
+4 ;Check for multiple vendor changes
+5 FOR
SET CNT=$ORDER(^PRC(442,PRCHPO,6,CNT))
if 'CNT
QUIT
Begin DoDot:1
+6 SET CNT1=0
+7 FOR
SET CNT1=$ORDER(^PRC(442,PRCHPO,6,CNT,3,CNT1))
if 'CNT1
QUIT
Begin DoDot:2
+8 SET TYPE=$GET(^PRC(442,PRCHPO,6,CNT,3,CNT1,0))
+9 SET TYPE=$PIECE(TYPE,U,2)
IF TYPE'=31
QUIT
+10 SET VEN=$GET(^PRC(442,PRCHPO,6,CNT,3,CNT1,1,1,0))
+11 if VEN=""
QUIT
+12 ;Count/track vendor changes
SET CNT2=CNT2+1
SET AA(CNT)=VEN
End DoDot:2
End DoDot:1
+13 ;
+14 FOR
SET CHANGE=$ORDER(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",AMEND,5,CHANGE))
if CHANGE'>0
QUIT
Begin DoDot:1
+15 ;Print vendor amendments.
+16 IF CNT2>1
DO E31A
QUIT
+17 SET OLD=^PRC(442,PRCHPO,6,PRCHAM,3,CHANGE,1,1,0)
SET OLD=$PIECE(^PRC(440,OLD,0),U)
+18 SET VEN=$PIECE(^PRC(442,PRCHPO,1),U)
SET VEN=$PIECE(^PRC(440,VEN,0),U)
+19 DO LINE^PRCHDP9(.LCNT,2)
SET DATA="Vendor "_OLD_" has been changed to "_VEN
+20 DO DATA^PRCHDP9(.LCNT,DATA)
DO LCNT1^PRCHDP9(LCNT)
End DoDot:1
+21 QUIT
+22 ;
E31A ;Print multiple vendor changes.
+1 SET OLD=$PIECE(^PRC(440,AA(PRCHAM),0),U)
+2 SET VEN=$ORDER(AA(PRCHAM))
+3 IF VEN=""
SET VEN=$PIECE(^PRC(442,PRCHPO,1),U)
+4 IF '$TEST
SET VEN=AA(VEN)
+5 SET VEN=$PIECE(^PRC(440,VEN,0),U)
+6 ;
+7 DO LINE^PRCHDP9(.LCNT,2)
+8 SET DATA="Vendor "_OLD_" has been changed to "_VEN
+9 DO DATA^PRCHDP9(.LCNT,DATA)
DO LCNT1^PRCHDP9(LCNT)
+10 QUIT
+11 ;
E32 ;REPLACE P.O. NUMBER PRINT
+1 NEW CHANGE,NPO,OPO,LCNT,DATA
+2 SET CHANGE=0
DO LCNT^PRCHDP9(.LCNT)
+3 FOR
SET CHANGE=$ORDER(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",AMEND,28,CHANGE))
if CHANGE'>0
QUIT
Begin DoDot:1
+4 SET NPO=$PIECE(^PRC(442,PRCHPO,23),U,4)
SET NPO=$PIECE(^PRC(442,NPO,0),U)
+5 SET OPO=$PIECE(^PRC(442,PRCHPO,0),U)
+6 DO LINE^PRCHDP9(.LCNT,2)
SET DATA="Purchase Order number "_OPO_" has been changed to "_NPO
+7 DO DATA^PRCHDP9(.LCNT,DATA)
DO LCNT1^PRCHDP9(LCNT)
End DoDot:1
+8 QUIT
+9 ;
E33 ;PROMPT PAYMENT Edit PRINT
+1 ;N CHANGE,CHANGES,FIELD,OLD,PAY,LCNT,DATA,PCT,PCT1,PCT2,DAYS,DAYS1,DAYS2,TERMS,NPCT,NDAYS1
+2 SET FIELD=0
KILL PAY
DO LCNT^PRCHDP9(.LCNT)
+3 FOR
SET FIELD=$ORDER(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",AMEND,FIELD))
if FIELD'>0
QUIT
Begin DoDot:1
+4 SET CHANGE=0
FOR
SET CHANGE=$ORDER(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",AMEND,FIELD,CHANGE))
if CHANGE'>0
QUIT
Begin DoDot:2
+5 SET CHANGES=^PRC(442,PRCHPO,6,PRCHAM,3,CHANGE,0)
SET OLD=^PRC(442,PRCHPO,6,PRCHAM,3,CHANGE,1,1,0)
+6 if FIELD=.01
SET PCT2=OLD
if FIELD=1
SET DAYS2=OLD
+7 SET PAY=$PIECE(CHANGES,U,4)
if $DATA(PAY(PAY))
QUIT
SET PAY(PAY)=1
+8 IF FIELD'=1
SET DAYS=0
FOR
SET DAYS=$ORDER(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",33,1,DAYS))
if DAYS'>0
QUIT
SET DAYS1=$PIECE(^PRC(442,PRCHPO,6,PRCHAM,3,DAYS,0),U,4)
IF DAYS1=PAY
Begin DoDot:3
+9 SET DAYS2=^PRC(442,PRCHPO,6,PRCHAM,3,DAYS,1,1,0)
QUIT
End DoDot:3
QUIT
+10 IF FIELD'=.01
SET PCT=0
FOR
SET PCT=$ORDER(^PRC(442,PRCHPO,6,PRCHAM,3,"AC",33,.01,PCT))
if PCT'>0
QUIT
SET PCT1=$PIECE(^PRC(442,PRCHPO,6,PRCHAM,3,PCT,0),U,4)
IF PCT1=PAY
Begin DoDot:3
+11 SET PCT2=^PRC(442,PRCHPO,6,PRCHAM,3,PCT,1,1,0)
QUIT
End DoDot:3
QUIT
+12 SET TERMS=^PRC(442,PRCHPO,5,PAY,0)
SET NPCT=$PIECE(TERMS,U)
SET NDAYS1=$PIECE(TERMS,U,2)
+13 DO LINE^PRCHDP9(.LCNT,2)
+14 SET DAYS2=$GET(DAYS2)
SET PCT2=$GET(PCT2)
+15 IF DAYS2'=0
IF PCT2'=0
SET DATA="Prompt Payment "_PCT2_$SELECT(PCT2=+PCT2:"%",1:"")_"/"_DAYS2_$SELECT(DAYS2=+DAYS2:" days",1:"")
Begin DoDot:3
+16 SET DATA=DATA_" has been changed to "_NPCT_$SELECT(NPCT=+NPCT:"%",1:"")_"/"_NDAYS1_$SELECT(NDAYS1=+NDAYS1:" days",1:"")
+17 DO DATA^PRCHDP9(.LCNT,DATA)
QUIT
End DoDot:3
+18 IF DAYS2=0
IF PCT2=0
SET DATA=" *ADDED THROUGH AMENDMENT*"
DO DATA^PRCHDP9(.LCNT,DATA)
Begin DoDot:3
+19 SET DATA="Prompt Payment "_NPCT_$SELECT(NPCT=+NPCT:"%",1:"")_"/"_NDAYS1_$SELECT(NDAYS1=+NDAYS1:" days",1:"")_" has been added"
+20 DO DATA^PRCHDP9(.LCNT,DATA)
QUIT
End DoDot:3
+21 QUIT
End DoDot:2
+22 QUIT
End DoDot:1
+23 DO LCNT1^PRCHDP9(LCNT)
+24 QUIT
