| [613] | 1 | PRCHDAM5 ;WISC/DJM-PRINT AMENDMENT,ROUTINE #5 ;6/29/00  12:18
 | 
|---|
 | 2 | V ;;5.1;IFCAP;;Oct 20, 2000
 | 
|---|
 | 3 |  ;Per VHA Directive 10-93-142, this routine should not be modified.
 | 
|---|
 | 4 |  ;
 | 
|---|
 | 5 | E33 ;PROMPT PAYMENT Edit PRINT
 | 
|---|
 | 6 |  N CHANGE,CHANGES,FIELD,OLD,PAY,LCNT,DATA,PCT,PCT1,PCT2,DAYS,DAYS1,DAYS2,TERMS,NPCT,NDAYS1
 | 
|---|
 | 7 |  S FIELD=0 K PAY D LCNT^PRCHDAM4(.LCNT)
 | 
|---|
 | 8 |  F  S FIELD=$O(^PRC(443.6,PRCHPO,6,PRCHAM,3,"AC",AMEND,FIELD)) Q:FIELD'>0  D
 | 
|---|
 | 9 |  .S CHANGE=0 F  S CHANGE=$O(^PRC(443.6,PRCHPO,6,PRCHAM,3,"AC",AMEND,FIELD,CHANGE)) Q:CHANGE'>0  D
 | 
|---|
 | 10 |  ..S CHANGES=^PRC(443.6,PRCHPO,6,PRCHAM,3,CHANGE,0),OLD=^PRC(443.6,PRCHPO,6,PRCHAM,3,CHANGE,1,1,0)
 | 
|---|
 | 11 |  ..S:FIELD=.01 PCT2=OLD S:FIELD=1 DAYS2=OLD
 | 
|---|
 | 12 |  ..S PAY=$P(CHANGES,U,4) Q:$D(PAY(PAY))  S PAY(PAY)=1
 | 
|---|
 | 13 |  ..I FIELD'=1 S DAYS=0 F  S DAYS=$O(^PRC(443.6,PRCHPO,6,PRCHAM,3,"AC",33,1,DAYS)) Q:DAYS'>0  S DAYS1=$P(^PRC(443.6,PRCHPO,6,PRCHAM,3,DAYS,0),U,4) I DAYS1=PAY D  Q
 | 
|---|
 | 14 |  ...S DAYS2=^PRC(443.6,PRCHPO,6,PRCHAM,3,DAYS,1,1,0) Q
 | 
|---|
 | 15 |  ..I FIELD'=.01 S PCT=0 F  S PCT=$O(^PRC(443.6,PRCHPO,6,PRCHAM,3,"AC",33,.01,PCT)) Q:PCT'>0  S PCT1=$P(^PRC(443.6,PRCHPO,6,PRCHAM,3,PCT,0),U,4) I PCT1=PAY D  Q
 | 
|---|
 | 16 |  ...S PCT2=^PRC(443.6,PRCHPO,6,PRCHAM,3,PCT,1,1,0) Q
 | 
|---|
 | 17 |  ..S TERMS=$G(^PRC(443.6,PRCHPO,5,PAY,0)) Q:TERMS=""
 | 
|---|
 | 18 |  ..S NPCT=$P(TERMS,U),NDAYS1=$P(TERMS,U,2)
 | 
|---|
 | 19 |  ..D LINE^PRCHDAM4(.LCNT,2)
 | 
|---|
 | 20 |  ..S DAYS2=$G(DAYS2),PCT2=$G(PCT2)
 | 
|---|
 | 21 |  ..I DAYS2'=0,PCT2'=0 S DATA="Prompt Payment "_PCT2_$S(PCT2=+PCT2:"%",1:"")_"/"_DAYS2_$S(DAYS2=+DAYS2:" days",1:"") D
 | 
|---|
 | 22 |  ...S DATA=DATA_" has been changed to "_NPCT_$S(NPCT=+NPCT:"%",1:"")_"/"_NDAYS1_$S(NDAYS1=+NDAYS1:" days",1:"")
 | 
|---|
 | 23 |  ...D DATA^PRCHDAM4(.LCNT,DATA) Q
 | 
|---|
 | 24 |  ..I DAYS2=0,PCT2=0 S DATA="  *ADDED THROUGH AMENDMENT*" D DATA^PRCHDAM4(.LCNT,DATA) D
 | 
|---|
 | 25 |  ...S DATA="Prompt Payment "_NPCT_$S(NPCT=+NPCT:"%",1:"")_"/"_NDAYS1_$S(NDAYS1=+NDAYS1:" days",1:"")_" has been added"
 | 
|---|
 | 26 |  ...D DATA^PRCHDAM4(.LCNT,DATA) Q
 | 
|---|
 | 27 |  ..Q
 | 
|---|
 | 28 |  .Q
 | 
|---|
 | 29 |  D LCNT1^PRCHDAM4(LCNT)
 | 
|---|
 | 30 |  Q
 | 
|---|
 | 31 |  ;
 | 
|---|
 | 32 | E34 ;AUTHORITY Edit PRINT
 | 
|---|
 | 33 |  N CHANGE,CHANGES,OLD,NEW,LCNT,DATA,DT2,I
 | 
|---|
 | 34 |  S CHANGE=0 D LCNT^PRCHDAM4(.LCNT)
 | 
|---|
 | 35 |  F  S CHANGE=$O(^PRC(443.6,PRCHPO,6,PRCHAM,3,"AC",AMEND,3,CHANGE)) Q:CHANGE'>0  D
 | 
|---|
 | 36 |  .S CHANGES=^PRC(443.6,PRCHPO,6,PRCHAM,3,CHANGE,0),OLD=^PRC(443.6,PRCHPO,6,PRCHAM,3,CHANGE,1,1,0)
 | 
|---|
 | 37 |  .S NEW=$P(^PRC(443.6,PRCHPO,6,PRCHAM,0),U,4)
 | 
|---|
 | 38 |  .D LINE^PRCHDAM4(.LCNT,2)
 | 
|---|
 | 39 |  .I OLD=0 S DATA=" *ADDED THROUGH AMENDMENT*" D DATA^PRCHDAM4(.LCNT,DATA) D
 | 
|---|
 | 40 |  ..S DATA="Authority Edit is",DT2=$P(^PRCD(442.2,NEW,0),U,2) D  D DATA^PRCHDAM4(.LCNT,DATA) Q
 | 
|---|
 | 41 |  ...I $L(DATA)+$L(DT2)>239 S DATA=DATA_":" D DATA^PRCHDAM4(.LCNT,DATA) S DATA=DT2 Q
 | 
|---|
 | 42 |  ...S DATA=DATA_" "_DT2
 | 
|---|
 | 43 |  .I OLD>0 S DATA="Authority Edit " D  D DATA^PRCHDAM4(.LCNT,DATA)
 | 
|---|
 | 44 |  ..F I=1:1:3 S DT2=$S(I=1:$P(^PRCD(442.2,OLD,0),U,2),I=2:" has been changed to ",I=3:$P(^PRCD(442.2,NEW,0),U,2)) D CHK(.DATA,DT2)
 | 
|---|
 | 45 |  .D LCNT1^PRCHDAM4(LCNT)
 | 
|---|
 | 46 |  .Q
 | 
|---|
 | 47 |  Q
 | 
|---|
 | 48 | CHK(DATA,DT2) ;
 | 
|---|
 | 49 |  I $L(DATA)+$L(DT2)<241 S DATA=DATA_DT2 Q
 | 
|---|
 | 50 |  D DATA^PRCHDAM4(.LCNT,DATA) S DATA=DT2
 | 
|---|
 | 51 |  Q
 | 
|---|
 | 52 |  ;
 | 
|---|
 | 53 | E35 ;F.O.B. Point PRINT
 | 
|---|
 | 54 |  N CHANGE,OLD,NEW,LCNT,DATA
 | 
|---|
 | 55 |  S CHANGE=0 D LCNT^PRCHDAM4(.LCNT)
 | 
|---|
 | 56 |  F  S CHANGE=$O(^PRC(443.6,PRCHPO,6,PRCHAM,3,"AC",AMEND,6.4,CHANGE)) Q:CHANGE'>0  D
 | 
|---|
 | 57 |  .S OLD=^PRC(443.6,PRCHPO,6,PRCHAM,3,CHANGE,1,1,0),NEW=$P($G(^PRC(443.6,PRCHPO,1)),U,6)
 | 
|---|
 | 58 |  .D LINE^PRCHDAM4(.LCNT,2)
 | 
|---|
 | 59 |  .S DATA="F.O.B. Point "_OLD_" has been changed to "_NEW D DATA^PRCHDAM4(.LCNT,DATA)
 | 
|---|
 | 60 |  .D LCNT1^PRCHDAM4(LCNT)
 | 
|---|
 | 61 |  .Q
 | 
|---|
 | 62 |  Q
 | 
|---|